changeset 110234:28ca316fcaea

Merge whitespace.el from trunk
author Chong Yidong <cyd@stupidchicken.com>
date Mon, 06 Sep 2010 12:24:32 -0400
parents 9b0c446f8952
children 0a214cbe7bf3
files lisp/ChangeLog lisp/whitespace.el
diffstat 2 files changed, 150 insertions(+), 54 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Mon Sep 06 00:03:56 2010 +0200
+++ b/lisp/ChangeLog	Mon Sep 06 12:24:32 2010 -0400
@@ -1,3 +1,22 @@
+2010-09-06  Vinicius Jose Latorre  <viniciusjl@ig.com.br>
+
+	* whitespace.el: Allow cleaning up blanks without blank
+	visualization (Bug#6651).  Adjust help window for
+	whitespace-toggle-options (Bug#6479).  Allow to use fill-column
+	instead of whitespace-line-column (from EmacsWiki).  New version
+	13.1.
+	(whitespace-style): Added new value 'face.  Adjust docstring.
+	(whitespace-space, whitespace-hspace, whitespace-tab): Adjust
+	foreground property face.
+	(whitespace-line-column): Adjust docstring and type declaration.
+	(whitespace-style-value-list, whitespace-toggle-option-alist)
+	(whitespace-help-text): Adjust const initialization.
+	(whitespace-toggle-options, global-whitespace-toggle-options):
+	Adjust docstring.
+	(whitespace-display-window, whitespace-interactive-char)
+	(whitespace-style-face-p, whitespace-color-on): Adjust code.
+	(whitespace-help-scroll): New fun.
+
 2010-09-05  Alexander Klimov  <alserkli@inbox.ru>  (tiny change)
 
 	* files.el (directory-abbrev-alist): Use \` as default regexp.
--- a/lisp/whitespace.el	Mon Sep 06 00:03:56 2010 +0200
+++ b/lisp/whitespace.el	Mon Sep 06 12:24:32 2010 -0400
@@ -6,7 +6,7 @@
 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;; Keywords: data, wp
-;; Version: 13.0
+;; Version: 13.1
 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
 
 ;; This file is part of GNU Emacs.
@@ -378,24 +378,32 @@
   "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
   :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el")
   :version "23.1"
-  :group 'wp
-  :group 'data)
+  :group 'convenience)
 
 
 (defcustom whitespace-style
-  '(tabs spaces trailing lines space-before-tab newline
-	 indentation empty space-after-tab
-	 space-mark tab-mark newline-mark)
+  '(face
+    tabs spaces trailing lines space-before-tab newline
+    indentation empty space-after-tab
+    space-mark tab-mark newline-mark)
   "Specify which kind of blank is visualized.
 
 It's a list containing some or all of the following values:
 
+   face			enable all visualization via faces (see below).
+
    trailing		trailing blanks are visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    tabs			TABs are visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    spaces		SPACEs and HARD SPACEs are visualized via
 			faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    lines		lines which have columns beyond
 			`whitespace-line-column' are highlighted via
@@ -403,6 +411,8 @@
 			Whole line is highlighted.
 			It has precedence over `lines-tail' (see
 			below).
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    lines-tail		lines which have columns beyond
 			`whitespace-line-column' are highlighted via
@@ -410,45 +420,69 @@
 			But only the part of line which goes
 			beyond `whitespace-line-column' column.
 			It has effect only if `lines' (see above)
-			is not present in `whitespace-style'.
+			is not present in `whitespace-style'
+			and if `face' (see above) is present in
+			`whitespace-style'.
 
    newline		NEWLINEs are visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    empty		empty lines at beginning and/or end of buffer
 			are visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    indentation::tab	8 or more SPACEs at beginning of line are
 			visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    indentation::space	TABs at beginning of line are visualized via
 			faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    indentation		8 or more SPACEs at beginning of line are
 			visualized, if `indent-tabs-mode' (which see)
 			is non-nil; otherwise, TABs at beginning of
 			line are visualized via faces.
+			It has effect only if `face' (see above)
+			is present in `whitespace-style'.
 
    space-after-tab::tab		8 or more SPACEs after a TAB are
 				visualized via faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-after-tab::space	TABs are visualized when 8 or more
 				SPACEs occur after a TAB, via faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-after-tab		8 or more SPACEs after a TAB are
 				visualized, if `indent-tabs-mode'
 				(which see) is non-nil; otherwise,
 				the TABs are visualized via faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-before-tab::tab	SPACEs before TAB are visualized via
 				faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-before-tab::space	TABs are visualized when SPACEs occur
 				before TAB, via faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-before-tab		SPACEs before TAB are visualized, if
 				`indent-tabs-mode' (which see) is
 				non-nil; otherwise, the TABs are
 				visualized via faces.
+				It has effect only if `face' (see above)
+				is present in `whitespace-style'.
 
    space-mark		SPACEs and HARD SPACEs are visualized via
 			display table.
@@ -487,9 +521,16 @@
 included in `whitespace-style' list, the indentation value is
 evaluated instead of indentation::space value.
 
+One reason for not visualize spaces via faces (if `face' is not
+included in `whitespace-style') is to use exclusively for
+cleanning up a buffer.  See `whitespace-cleanup' and
+`whitespace-cleanup-region' for documentation.
+
 See also `whitespace-display-mappings' for documentation."
   :type '(repeat :tag "Kind of Blank"
 		 (choice :tag "Kind of Blank Face"
+			 (const :tag "(Face) Face visualization"
+				face)
 			 (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
 				trailing)
 			 (const :tag "(Face) SPACEs and HARD SPACEs"
@@ -522,9 +563,9 @@
 
 (defface whitespace-space
   '((((class color) (background dark))
-     (:background "grey20"      :foreground "aquamarine3"))
+     (:background "grey20"      :foreground "darkgray"))
     (((class color) (background light))
-     (:background "LightYellow" :foreground "aquamarine3"))
+     (:background "LightYellow" :foreground "lightgray"))
     (t (:inverse-video t)))
   "Face used to visualize SPACE."
   :group 'whitespace)
@@ -540,9 +581,9 @@
 
 (defface whitespace-hspace		; 'nobreak-space
   '((((class color) (background dark))
-     (:background "grey24"        :foreground "aquamarine3"))
+     (:background "grey24"        :foreground "darkgray"))
     (((class color) (background light))
-     (:background "LemonChiffon3" :foreground "aquamarine3"))
+     (:background "LemonChiffon3" :foreground "lightgray"))
     (t (:inverse-video t)))
   "Face used to visualize HARD SPACE."
   :group 'whitespace)
@@ -558,9 +599,9 @@
 
 (defface whitespace-tab
   '((((class color) (background dark))
-     (:background "grey22" :foreground "aquamarine3"))
+     (:background "grey22" :foreground "darkgray"))
     (((class color) (background light))
-     (:background "beige"  :foreground "aquamarine3"))
+     (:background "beige"  :foreground "lightgray"))
     (t (:inverse-video t)))
   "Face used to visualize TAB."
   :group 'whitespace)
@@ -867,8 +908,13 @@
 (defcustom whitespace-line-column 80
   "Specify column beyond which the line is highlighted.
 
+It must be an integer or nil.  If nil, the `fill-column' variable value is
+used.
+
 Used when `whitespace-style' includes `lines' or `lines-tail'."
-  :type '(integer :tag "Line Length")
+  :type '(choice :tag "Line Length Limit"
+		 (integer :tag "Line Length")
+		 (const :tag "Use fill-column" nil))
   :group 'whitespace)
 
 
@@ -1152,7 +1198,8 @@
 
 
 (defconst whitespace-style-value-list
-  '(tabs
+  '(face
+    tabs
     spaces
     trailing
     lines
@@ -1177,7 +1224,8 @@
 
 
 (defconst whitespace-toggle-option-alist
-  '((?t    . tabs)
+  '((?f    . face)
+    (?t    . tabs)
     (?s    . spaces)
     (?r    . trailing)
     (?l    . lines)
@@ -1257,6 +1305,7 @@
 
   CHAR	MEANING
   (VIA FACES)
+   f	toggle face visualization
    t	toggle TAB visualization
    s	toggle SPACE and HARD SPACE visualization
    r	toggle trailing blanks visualization
@@ -1285,6 +1334,7 @@
 Non-interactively, ARG should be a symbol or a list of symbols.
 The valid symbols are:
 
+   face			toggle face visualization
    tabs			toggle TAB visualization
    spaces		toggle SPACE and HARD SPACE visualization
    trailing		toggle trailing blanks visualization
@@ -1334,6 +1384,7 @@
 
   CHAR	MEANING
   (VIA FACES)
+   f	toggle face visualization
    t	toggle TAB visualization
    s	toggle SPACE and HARD SPACE visualization
    r	toggle trailing blanks visualization
@@ -1362,6 +1413,7 @@
 Non-interactively, ARG should be a symbol or a list of symbols.
 The valid symbols are:
 
+   face			toggle face visualization
    tabs			toggle TAB visualization
    spaces		toggle SPACE and HARD SPACE visualization
    trailing		toggle trailing blanks visualization
@@ -1891,9 +1943,10 @@
 
 (defconst whitespace-help-text
   "\
- Whitespace Toggle Options
-
- FACES
+ Whitespace Toggle Options                  | scroll up  :  SPC   or > |
+                                            | scroll down:  M-SPC or < |
+ FACES                                      \\__________________________/
+ []  f   - toggle face visualization
  []  t   - toggle TAB visualization
  []  s   - toggle SPACE and HARD SPACE visualization
  []  r   - toggle trailing blanks visualization
@@ -1967,15 +2020,13 @@
   "Display BUFFER in a new window."
   (goto-char (point-min))
   (set-buffer-modified-p nil)
-  (let ((size (- (window-height)
-		 (max window-min-height
-		      (1+ (count-lines (point-min)
-				       (point-max)))))))
-    (when (<= size 0)
-      (kill-buffer buffer)
-      (error "Frame height is too small; \
+  (when (< (window-height) (* 2 window-min-height))
+    (kill-buffer buffer)
+    (error "Window height is too small; \
 can't split window to display whitespace toggle options"))
-    (set-window-buffer (split-window nil size) buffer)))
+  (let ((win (split-window)))
+    (set-window-buffer win buffer)
+    (shrink-window-if-larger-than-buffer win)))
 
 
 (defun whitespace-kill-buffer (buffer-name)
@@ -1991,6 +2042,24 @@
   (whitespace-kill-buffer whitespace-help-buffer-name))
 
 
+(defun whitespace-help-scroll (&optional up)
+  "Scroll help window, if it exists.
+
+If UP is non-nil, scroll up; otherwise, scroll down."
+  (condition-case data-help
+      (let ((buffer (get-buffer whitespace-help-buffer-name)))
+	(if buffer
+	    (with-selected-window (get-buffer-window buffer)
+	      (if up
+		  (scroll-up 3)
+		(scroll-down 3)))
+	  (ding)))
+    ;; handler
+    ((error)
+     ;; just ignore error
+     )))
+
+
 (defun whitespace-interactive-char (local-p)
   "Interactive function to read a char and return a symbol.
 
@@ -2001,6 +2070,7 @@
 
   CHAR	MEANING
   (VIA FACES)
+   f	toggle face visualization
    t	toggle TAB visualization
    s	toggle SPACE and HARD SPACE visualization
    r	toggle trailing blanks visualization
@@ -2050,9 +2120,13 @@
 			 (cdr
 			  (assq ch whitespace-toggle-option-alist)))))
 	      ;; while body
-	      (if (eq ch ?\?)
-		  (whitespace-help-on style)
-		(ding)))
+	      (cond
+	       ((eq ch ?\?)   (whitespace-help-on style))
+	       ((eq ch ?\ )   (whitespace-help-scroll t))
+	       ((eq ch ?\M- ) (whitespace-help-scroll))
+	       ((eq ch ?>)    (whitespace-help-scroll t))
+	       ((eq ch ?<)    (whitespace-help-scroll))
+	       (t             (ding))))
 	    (whitespace-help-off)
 	    (message " "))		; clean echo area
 	;; handler
@@ -2131,22 +2205,23 @@
 
 (defun whitespace-style-face-p ()
   "Return t if there is some visualization via face."
-  (or (memq 'tabs                    whitespace-active-style)
-      (memq 'spaces                  whitespace-active-style)
-      (memq 'trailing                whitespace-active-style)
-      (memq 'lines                   whitespace-active-style)
-      (memq 'lines-tail              whitespace-active-style)
-      (memq 'newline                 whitespace-active-style)
-      (memq 'empty                   whitespace-active-style)
-      (memq 'indentation             whitespace-active-style)
-      (memq 'indentation::tab        whitespace-active-style)
-      (memq 'indentation::space      whitespace-active-style)
-      (memq 'space-after-tab         whitespace-active-style)
-      (memq 'space-after-tab::tab    whitespace-active-style)
-      (memq 'space-after-tab::space  whitespace-active-style)
-      (memq 'space-before-tab        whitespace-active-style)
-      (memq 'space-before-tab::tab   whitespace-active-style)
-      (memq 'space-before-tab::space whitespace-active-style)))
+  (and (memq 'face whitespace-active-style)
+       (or (memq 'tabs                    whitespace-active-style)
+	   (memq 'spaces                  whitespace-active-style)
+	   (memq 'trailing                whitespace-active-style)
+	   (memq 'lines                   whitespace-active-style)
+	   (memq 'lines-tail              whitespace-active-style)
+	   (memq 'newline                 whitespace-active-style)
+	   (memq 'empty                   whitespace-active-style)
+	   (memq 'indentation             whitespace-active-style)
+	   (memq 'indentation::tab        whitespace-active-style)
+	   (memq 'indentation::space      whitespace-active-style)
+	   (memq 'space-after-tab         whitespace-active-style)
+	   (memq 'space-after-tab::tab    whitespace-active-style)
+	   (memq 'space-after-tab::space  whitespace-active-style)
+	   (memq 'space-before-tab        whitespace-active-style)
+	   (memq 'space-before-tab::tab   whitespace-active-style)
+	   (memq 'space-before-tab::space whitespace-active-style))))
 
 
 (defun whitespace-color-on ()
@@ -2204,14 +2279,16 @@
        (list
 	;; Show "long" lines
 	(list
-	 (format
-	  "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
-	  whitespace-tab-width (1- whitespace-tab-width)
-	  (/ whitespace-line-column whitespace-tab-width)
-	  (let ((rem (% whitespace-line-column whitespace-tab-width)))
-	    (if (zerop rem)
-		""
-	      (format ".\\{%d\\}" rem))))
+	 (let ((line-column (or whitespace-line-column fill-column)))
+	   (format
+	    "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+	    whitespace-tab-width
+	    (1- whitespace-tab-width)
+	    (/ line-column whitespace-tab-width)
+	    (let ((rem (% line-column whitespace-tab-width)))
+	      (if (zerop rem)
+		  ""
+		(format ".\\{%d\\}" rem)))))
 	 (if (memq 'lines whitespace-active-style)
 	     0				; whole line
 	   2)				; line tail