Merge whitespace.el from trunk

1 files changed, 131 insertions, 54 deletions

diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 9f4b033e75f..4b8b9a61173 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -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 @@ It's a list containing some or all of the following values:
 			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 @@ It's a list containing some or all of the following values:
 			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 @@ So, for example, if indentation and indentation::space are
 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 @@ Used when `whitespace-style' includes the value `spaces'."
 
 (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 @@ Used when `whitespace-style' includes the value `spaces'."
 
 (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 @@ Used when `whitespace-style' includes the value `tabs'."
 
 (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 @@ Used when `whitespace-style' includes `space-after-tab',
 (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 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
 
 
 (defconst whitespace-style-value-list
-  '(tabs
+  '(face
+    tabs
     spaces
     trailing
     lines
@@ -1177,7 +1224,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
 
 
 (defconst whitespace-toggle-option-alist
-  '((?t    . tabs)
+  '((?f    . face)
+    (?t    . tabs)
     (?s    . spaces)
     (?r    . trailing)
     (?l    . lines)
@@ -1257,6 +1305,7 @@ Interactively, it reads one of the following chars:
 
   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 @@ Interactively, it reads one of the following chars:
 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 @@ Interactively, it accepts one of the following chars:
 
   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 @@ Interactively, it accepts one of the following chars:
 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 @@ cleaning up these problems."
 
 (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 @@ cleaning up these problems."
   "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 @@ can't split window to display whitespace toggle options"))
   (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 @@ It accepts one of the following chars:
 
   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 @@ See also `whitespace-toggle-option-alist'."
 			 (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 @@ resultant list will be returned."
 
 (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 @@ resultant list will be returned."
        (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