Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421
[bpt/emacs.git] / lisp / whitespace.el
index e8c4dd4..a119793 100644 (file)
@@ -1,11 +1,10 @@
 ;;; whitespace.el --- warn about and clean bogus whitespaces in the file
 
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2005 Free Software Foundation, Inc.
 
 ;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
 ;; Keywords: convenience
 
-;; $Id: whitespace.el,v 1.18 2001/08/20 20:56:08 rv Exp $
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
-
-;; Whitespace.el URL: http://www.dsmit.com/lisp/
-
+;;
+;; URL: http://www.dsmit.com/lisp/
+;;
+;; The whitespace library is intended to find and help fix five different types
+;; of whitespace problems that commonly exist in source code.
+;;
+;; 1. Leading space (empty lines at the top of a file).
+;; 2. Trailing space (empty lines at the end of a file).
+;; 3. Indentation space (8 or more spaces at beginning of line, that should be
+;;                   replaced with TABS).
+;; 4. Spaces followed by a TAB.  (Almost always, we never want that).
+;; 5. Spaces or TABS at the end of a line.
+;;
+;; Whitespace errors are reported in a buffer, and on the modeline.
+;;
+;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace,
+;; where `x' and `y' can be one (or more) of:
+;;
+;; e - End-of-Line whitespace.
+;; i - Indentation whitespace.
+;; l - Leading whitespace.
+;; s - Space followed by Tab.
+;; t - Trailing whitespace.
+;;
+;; If any of the whitespace checks is turned off, the modeline will display a
+;; !<y>.
+;;
+;;     (since (3) is the most controversial one, here is the rationale: Most
+;;     terminal drivers and printer drivers have TAB configured or even
+;;     hardcoded to be 8 spaces.  (Some of them allow configuration, but almost
+;;     always they default to 8.)
+;;
+;;     Changing `tab-width' to other than 8 and editing will cause your code to
+;;     look different from within Emacs, and say, if you cat it or more it, or
+;;     even print it.
+;;
+;;     Almost all the popular programming modes let you define an offset (like
+;;     c-basic-offset or perl-indent-level) to configure the offset, so you
+;;     should never have to set your `tab-width' to be other than 8 in all
+;;     these modes.  In fact, with an indent level of say, 4, 2 TABS will cause
+;;     Emacs to replace your 8 spaces with one \t (try it).  If vi users in
+;;     your office complain, tell them to use vim, which distinguishes between
+;;     tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
+;;     to set smarttab.)
+;;
+;; All the above have caused (and will cause) unwanted codeline integration and
+;; merge problems.
+;;
+;; whitespace.el will complain if it detects whitespaces on opening a file, and
+;; warn you on closing a file also (in case you had inserted any
+;; whitespaces during the process of your editing).
+;;
 ;; Exported functions:
-
+;;
 ;; `whitespace-buffer' - To check the current buffer for whitespace problems.
 ;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
 ;; `whitespace-region' - To check between point and mark for whitespace
 ;;                       problems.
 ;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
 ;;                               and mark in the current buffer.
-;; `whitespace-describe' - A simple introduction to the library.
 
 ;;; Code:
 
-(defvar whitespace-version "3.2" "Version of the whitespace library.")
+(defvar whitespace-version "3.5" "Version of the whitespace library.")
 
 (defvar whitespace-all-buffer-files nil
   "An associated list of buffers and files checked for whitespace cleanliness.
@@ -124,10 +171,12 @@ don't define defcustom"
   "Check for and fix five different types of whitespaces in source code."
   ;; Since XEmacs doesn't have a 'convenience group, use the next best group
   ;; which is 'editing?
+  :link '(emacs-commentary-link "whitespace.el")
   :group 'editing)
 (defgroup whitespace nil
   "Check for and fix five different types of whitespaces in source code."
   :version "21.1"
+  :link '(emacs-commentary-link "whitespace.el")
   :group 'convenience))
 
 (defcustom whitespace-check-leading-whitespace t
@@ -186,6 +235,12 @@ It can be overriden by setting a buffer local variable
   :type 'string
   :group 'whitespace)
 
+(defcustom whitespace-clean-msg "clean."
+  "If non-nil, this message will be displayed after a whitespace check
+determines a file to be clean."
+  :type 'string
+  :group 'whitespace)
+
 (defcustom whitespace-abort-on-error nil
   "While writing a file, abort if the file is unclean. If
 `whitespace-auto-cleanup' is set, that takes precedence over this
@@ -252,8 +307,8 @@ To disable timer scans, set this to zero."
   :group 'whitespace)
 
 (defcustom whitespace-display-spaces-in-color t
-  "Display the bogus whitespaces by coloring them with
-`whitespace-highlight-face'."
+  "Display the bogus whitespaces by coloring them with the face
+`whitespace-highlight'."
   :type 'boolean
   :group 'whitespace)
 
@@ -263,18 +318,20 @@ To disable timer scans, set this to zero."
   :group 'whitespace
   :group 'faces)
 
-(defface whitespace-highlight-face '((((class color) (background light))
-                                   (:background "green"))
-                                  (((class color) (background dark))
-                                   (:background "sea green"))
-                                  (((class grayscale monochrome)
-                                    (background light))
-                                   (:background "black"))
-                                  (((class grayscale monochrome)
-                                    (background dark))
-                                   (:background "white")))
+(defface whitespace-highlight '((((class color) (background light))
+                                (:background "green1"))
+                               (((class color) (background dark))
+                                (:background "sea green"))
+                               (((class grayscale mono)
+                                 (background light))
+                                (:background "black"))
+                               (((class grayscale mono)
+                                 (background dark))
+                                (:background "white")))
   "Face used for highlighting the bogus whitespaces that exist in the buffer."
   :group 'whitespace-faces)
+;; backward-compatibility alias
+(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight)
 
 (if (not (assoc 'whitespace-mode minor-mode-alist))
     (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
@@ -434,16 +491,14 @@ and:
                                  (if whitespace-spacetab "s")
                                  (if whitespace-trailing "t")))))
              (whitespace-update-modeline whitespace-this-modeline)
-             (save-excursion
-               (get-buffer-create whitespace-errbuf)
-               (kill-buffer whitespace-errbuf)
-               (get-buffer-create whitespace-errbuf)
-               (set-buffer whitespace-errbuf)
+             (if (get-buffer whitespace-errbuf)
+                 (kill-buffer whitespace-errbuf))
+             (with-current-buffer (get-buffer-create whitespace-errbuf)
                (if whitespace-errmsg
                    (progn
                      (insert whitespace-errmsg)
                      (if (not (or quiet whitespace-silent))
-                         (display-buffer whitespace-errbuf t))
+                         (display-buffer (current-buffer) t))
                      (if (not quiet)
                          (message "Whitespaces: [%s%s] in %s"
                                   whitespace-this-modeline
@@ -453,11 +508,10 @@ and:
                                         (concat "!" whitespace-unchecked)
                                       ""))
                                   whitespace-filename)))
-                 (if (not quiet)
-                     (message "%s clean" whitespace-filename))))))))
-    (if whitespace-error
-       t
-      nil)))
+                 (if (and (not quiet) (not (equal whitespace-clean-msg "")))
+                     (message "%s %s" whitespace-filename
+                              whitespace-clean-msg))))))))
+    whitespace-error))
 
 ;;;###autoload
 (defun whitespace-region (s e)
@@ -520,7 +574,8 @@ whitespace problems."
        (if whitespace-any
            (whitespace-cleanup)
          (progn
-           (message "%s clean" buffer-file-name)
+           (if (not whitespace-silent)
+               (message "%s clean" buffer-file-name))
            (whitespace-update-modeline)))
        (setq tab-width whitespace-tabwith-saved))))
 
@@ -546,7 +601,7 @@ whitespace problems."
       (setq pmax (point))
       (if (equal pmin pmax)
          (progn
-           (whitespace-highlight-the-space pmin pmax)
+           (whitespace-highlight-the-space pmin (1+ pmax))
            t)
        nil))))
 
@@ -584,7 +639,7 @@ whitespace problems."
            (setq pmax (point))
            (if (equal pmin pmax)
                (progn
-                 (whitespace-highlight-the-space pmin pmax)
+                 (whitespace-highlight-the-space (- pmin 1) pmax)
                  t)
              nil))
        nil))))
@@ -679,23 +734,16 @@ Also with whitespaces whose testing has been turned off."
 (defun whitespace-highlight-the-space (b e)
   "Highlight the current line, unhighlighting a previously jumped to line."
   (if whitespace-display-spaces-in-color
-      (progn
-       (whitespace-unhighlight-the-space)
-       (add-to-list 'whitespace-highlighted-space
-                    (whitespace-make-overlay b e))
-       (whitespace-overlay-put (whitespace-make-overlay b e) 'face
-                               'whitespace-highlight-face))))
+      (let ((ol (whitespace-make-overlay b e)))
+       (push ol whitespace-highlighted-space)
+       (whitespace-overlay-put ol 'face 'whitespace-highlight))))
 ;;  (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space))
 
-(defun whitespace-unhighlight-the-space ()
+(defun whitespace-unhighlight-the-space()
   "Unhighlight the currently highlight line."
   (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
-      (let ((whitespace-this-space nil))
-       (while whitespace-highlighted-space
-         (setq whitespace-this-space (car whitespace-highlighted-space))
-         (setq whitespace-highlighted-space
-               (cdr whitespace-highlighted-space))
-         (whitespace-delete-overlay whitespace-this-space))
+      (progn
+       (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
        (setq whitespace-highlighted-space nil))
     (remove-hook 'pre-command-hook 'whitespace-unhighlight-the-space)))
 
@@ -763,43 +811,30 @@ If timer is not set, then set it to scan the files in
       (setq whitespace-rescan-timer nil))))
 
 ;;;###autoload
-(defcustom whitespace-global-mode nil
-  "Toggle global Whitespace mode.
-
-Setting this variable directly does not take effect;
-use either \\[customize] or the function `whitespace-global-mode'
-\(which see)."
-  :set (lambda (sym val)
-        (whitespace-global-mode (or val 0)))
-  :initialize 'custom-initialize-default
-  :type 'boolean
-  :group 'whitespace
-  :require 'whitespace)
+(defalias 'global-whitespace-mode 'whitespace-global-mode)
 
 ;;;###autoload
-(defun whitespace-global-mode (&optional arg)
+(define-minor-mode whitespace-global-mode
   "Toggle using Whitespace mode in new buffers.
-With ARG, turn the mode on if and only iff ARG is positive.
+With ARG, turn the mode on iff ARG is positive.
 
 When this mode is active, `whitespace-buffer' is added to
-`find-file-hooks' and `kill-buffer-hook'."
-  (interactive "P")
-  (setq arg (if arg
-               (> (prefix-numeric-value arg) 0)
-             (not whitespace-global-mode)))
-  (if arg
+`find-file-hook' and `kill-buffer-hook'."
+  :global t
+  :group 'whitespace
+  (if whitespace-global-mode
       (progn
-       (add-hook 'find-file-hooks 'whitespace-buffer)
-       (add-hook 'local-write-file-hooks 'whitespace-write-file-hook)
+       (add-hook 'find-file-hook 'whitespace-buffer)
+       (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
        (add-hook 'kill-buffer-hook 'whitespace-buffer))
-    (remove-hook 'find-file-hooks 'whitespace-buffer)
-    (remove-hook 'local-write-file-hooks 'whitespace-write-file-hook)
+    (remove-hook 'find-file-hook 'whitespace-buffer)
+    (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
     (remove-hook 'kill-buffer-hook 'whitespace-buffer)))
 
 ;;;###autoload
 (defun whitespace-write-file-hook ()
-  "The local-write-file-hook to be called on the buffer when
-whitespace check is enabled."
+  "Hook function to be called on the buffer when whitespace check is enabled.
+This is meant to be added buffer-locally to `write-file-functions'."
   (interactive)
   (let ((werr nil))
     (if whitespace-auto-cleanup
@@ -810,66 +845,14 @@ whitespace check is enabled."
                       buffer-file-name))))
   nil)
 
-;;;###autoload
-(defun whitespace-describe ()
-  "A summary of whitespaces and what this library can do about them.
-
-The whitespace library is intended to find and help fix five different types
-of whitespace problems that commonly exist in source code.
-
-1. Leading space (empty lines at the top of a file).
-2. Trailing space (empty lines at the end of a file).
-3. Indentation space (8 or more spaces at beginning of line, that should be
-                     replaced with TABS).
-4. Spaces followed by a TAB.  (Almost always, we never want that).
-5. Spaces or TABS at the end of a line.
-
-Whitespace errors are reported in a buffer, and on the modeline.
-
-Modeline will show a W:<x>!<y> to denote a particular type of whitespace,
-where `x' and `y' can be one (or more) of:
-
-e - End-of-Line whitespace.
-i - Indentation whitespace.
-l - Leading whitespace.
-s - Space followed by Tab.
-t - Trailing whitespace.
-
-If any of the whitespace checks is turned off, the modeline will display a
-!<y>.
-
-    (since (3) is the most controversial one, here is the rationale: Most
-    terminal drivers and printer drivers have TAB configured or even
-    hardcoded to be 8 spaces.  (Some of them allow configuration, but almost
-    always they default to 8.)
-
-    Changing `tab-width' to other than 8 and editing will cause your code to
-    look different from within Emacs, and say, if you cat it or more it, or
-    even print it.
-
-    Almost all the popular programming modes let you define an offset (like
-    c-basic-offset or perl-indent-level) to configure the offset, so you
-    should never have to set your `tab-width' to be other than 8 in all these
-    modes.  In fact, with an indent level of say, 4, 2 TABS will cause Emacs
-    to replace your 8 spaces with one \t (try it).  If vi users in your
-    office complain, tell them to use vim, which distinguishes between
-    tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
-    to set smarttab.)
-
-All the above have caused (and will cause) unwanted codeline integration and
-merge problems.
-
-whitespace.el will complain if it detects whitespaces on opening a file, and
-warn you on closing a file also (in case you had inserted any
-whitespaces during the process of your editing)."
-  (interactive)
-  (message "Use C-h f whitespace-describe to read about whitespace.el v%s."
-          whitespace-version))
-
 (defun whitespace-unload-hook ()
-  (remove-hook 'find-file-hooks 'whitespace-buffer)
-  (remove-hook 'local-write-file-hooks 'whitespace-write-file-hook)
+  (remove-hook 'find-file-hook 'whitespace-buffer)
+  (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
   (remove-hook 'kill-buffer-hook 'whitespace-buffer))
 
+(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
+
 (provide 'whitespace)
+
+;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c
 ;;; whitespace.el ends here