]> code.delx.au - gnu-emacs/blobdiff - lisp/whitespace.el
(widget-button-click): Wrap with save-excursion
[gnu-emacs] / lisp / whitespace.el
index 4d417983e4d430f7155f87b135377eda450317b8..2b1385bf439d02b3a4167e14b8b17a57006a7e07 100644 (file)
@@ -42,7 +42,7 @@
 (add-hook 'find-file-hooks 'whitespace-buffer)
 (add-hook 'kill-buffer-hook 'whitespace-buffer)
 
-(defvar whitespace-version "2.3" "Version of the whitespace library.")
+(defvar whitespace-version "2.8" "Version of the whitespace library.")
 ;; Find out what type of Emacs we are running in.
 (defvar whitespace-running-emacs (if (string-match "XEmacs\\|Lucid"
                                                   emacs-version) nil t)
@@ -59,17 +59,29 @@ visited by the buffers.")
 (defvar whitespace-rescan-timer nil
   "Timer object used to rescan the files in buffers that have been modified.")
 
-;; For users of Emacs 19.x, defgroup and defcustom are not defined.
+;; Tell Emacs about this new kind of minor mode
+(defvar whitespace-mode nil
+  "Non-nil when Whitespace mode (a minor mode) is enabled.")
+(make-variable-buffer-local 'whitespace-mode)
+(put 'whitespace-mode 'permanent-local nil)
+
+(defvar whitespace-mode-line nil
+  "String to display in the mode line for Whitespace mode.")
+(make-variable-buffer-local 'whitespace-mode-line)
+(put 'whitespace-mode-line 'permanent-local nil)
 
+;; For flavors of Emacs which don't define `defgroup' and `defcustom'.
 (eval-when-compile
-  (if (< (string-to-int emacs-version) 20)
-      (progn
-       (defmacro defgroup (sym memb doc &rest args)
-         "Null macro for defgroup in all versions of Emacs < 20.x"
-         t)
-       (defmacro defcustom (sym val doc &rest args)
-         "Macro to alias defcustom to defvar in all versions of Emacs < 20.x"
-         `(defvar ,sym ,val ,doc)))))
+  (if (not (fboundp 'defgroup))
+      (defmacro defgroup (sym memb doc &rest args)
+       "Null macro for defgroup in all versions of Emacs that don't define
+defgroup"
+       t))
+  (if (not (fboundp 'defcustom))
+      (defmacro defcustom (sym val doc &rest args)
+       "Macro to alias defcustom to defvar in all versions of Emacs that
+don't define defcustom"
+       `(defvar ,sym ,val ,doc))))
 
 (defgroup whitespace nil
   "Check for and fix five different types of whitespaces in source code."
@@ -77,16 +89,41 @@ visited by the buffers.")
   ;; which is 'editing?
   :group (if whitespace-running-emacs 'convenience 'editing))
 
+(defcustom whitespace-check-leading-whitespace t
+  "Flag to check leading whitespace."
+  :type 'boolean
+  :group 'whitespace)
+
+(defcustom whitespace-check-trailing-whitespace t
+  "Flag to check trailing whitespace."
+  :type 'boolean
+  :group 'whitespace)
+
+(defcustom whitespace-check-spacetab-whitespace t
+  "Flag to check space followed by a TAB."
+  :type 'boolean
+  :group 'whitespace)
+
 (defcustom whitespace-spacetab-regexp " \t"
-  "Regexp to match a TAB followed by a space."
+  "Regexp to match a space followed by a TAB."
   :type 'string
   :group 'whitespace)
 
+(defcustom whitespace-check-indent-whitespace t
+  "Flag to check indentation whitespace."
+  :type 'boolean
+  :group 'whitespace)
+
 (defcustom whitespace-indent-regexp (concat "^\\(\t*\\)    " "    ")
   "Regexp to match (any TABS followed by) 8/more whitespaces at start of line."
   :type 'string
   :group 'whitespace)
 
+(defcustom whitespace-check-ateol-whitespace t
+  "Flag to check end-of-line whitespace."
+  :type 'boolean
+  :group 'whitespace)
+
 (defcustom whitespace-ateol-regexp "[ \t]$"
   "Regexp to match a TAB or a space at the EOL."
   :type 'string
@@ -112,7 +149,8 @@ Errors*' buffer before opening (or closing) another file."
   :group 'whitespace)
 
 (defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
-                                      c-mode c++-mode cc-mode cperl-mode
+                                      c-mode c++-mode cc-mode
+                                      change-log-mode cperl-mode
                                       electric-nroff-mode emacs-lisp-mode
                                       f90-mode fortran-mode html-mode
                                       html3-mode java-mode jde-mode
@@ -121,9 +159,9 @@ Errors*' buffer before opening (or closing) another file."
                                       modula-2-mode nroff-mode objc-mode
                                       pascal-mode perl-mode prolog-mode
                                       python-mode scheme-mode sgml-mode
-                                      sh-mode shell-script-mode
-                                      simula-mode tcl-mode tex-mode
-                                      texinfo-mode vrml-mode xml-mode)
+                                      sh-mode shell-script-mode simula-mode
+                                      tcl-mode tex-mode texinfo-mode
+                                      vrml-mode xml-mode)
 
   "Major Modes in which we turn on whitespace checking.
 
@@ -142,18 +180,16 @@ Or, alternately, you can use the Emacs `customize' command to set this."
 
 This is the period after which the timer will fire causing
 `whitespace-rescan-files-in-buffers' to check for whitespace creep in
-modified buffers."
+modified buffers.
+
+To disable timer scans, set this to zero."
   :type 'integer
   :group 'whitespace)
 
-;; Tell Emacs about this new kind of minor mode
-(make-variable-buffer-local 'whitespace-mode)
-(put 'whitespace-mode 'permanent-local nil)
-(set-default 'whitespace-mode nil)
-
-(make-variable-buffer-local 'whitespace-mode-line)
-(put 'whitespace-mode-line 'permanent-local nil)
-(set-default 'whitespace-mode-line nil)
+(defcustom whitespace-display-in-modeline t
+  "Display whitespace errors on the modeline."
+  :type 'boolean
+  :group 'whitespace)
 
 (if (not (assoc 'whitespace-mode minor-mode-alist))
     (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
@@ -182,76 +218,94 @@ and:
 1. the major mode is one of the whitespace-modes, or
 2. `whitespace-buffer' was explicitly called with a prefix argument."
   (interactive)
-  (whitespace-check-whitespace-mode current-prefix-arg)
-  (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
-      (progn
-       (whitespace-check-buffer-list (buffer-name) buffer-file-name)
-       (whitespace-tickle-timer)
-       (if whitespace-auto-cleanup
-           (if (and (not quiet) buffer-read-only)
-               (message "Can't Cleanup: %s is read-only." (buffer-name))
-             (whitespace-cleanup))
-         (let ((whitespace-leading (whitespace-buffer-leading))
-               (whitespace-trailing (whitespace-buffer-trailing))
-               (whitespace-indent (whitespace-buffer-search
-                                   whitespace-indent-regexp))
-               (whitespace-spacetab (whitespace-buffer-search
-                                     whitespace-spacetab-regexp))
-               (whitespace-ateol (whitespace-buffer-search
-                                  whitespace-ateol-regexp))
-               (whitespace-errmsg nil)
-               (whitespace-error nil)
-               (whitespace-filename buffer-file-name)
-               (whitespace-this-modeline ""))
-
-           ;; Now let's complain if we found any of the above.
-           (setq whitespace-error (or whitespace-leading whitespace-indent
-                                      whitespace-spacetab whitespace-ateol
-                                      whitespace-trailing))
-
-           (if whitespace-error
-               (progn
-                 (setq whitespace-errmsg
-                       (concat whitespace-filename " contains:\n"
-                               (if whitespace-leading "Leading whitespace\n")
-                               (if whitespace-indent
-                                   (concat "Indentation whitespace"
-                                           whitespace-indent "\n"))
-                               (if whitespace-spacetab
-                                   (concat "Space followed by Tab"
-                                           whitespace-spacetab "\n"))
-                               (if whitespace-ateol
-                                   (concat "End-of-line whitespace"
-                                           whitespace-ateol "\n"))
-                               (if whitespace-trailing
-                                   "Trailing whitespace.\n")
-                               "\ntype "
-                               "`whitespace-cleanup' to cleanup the file."))
-                 (setq whitespace-this-modeline
-                       (concat (if whitespace-ateol "e")
-                               (if whitespace-indent "i")
-                               (if whitespace-leading "l")
-                               (if whitespace-spacetab "s")
-                               (if whitespace-trailing "t")))
-                 (setq whitespace-mode-line
-                       (concat " W:" whitespace-this-modeline))
-                 (whitespace-force-mode-line-update)))
-           (save-excursion
-             (get-buffer-create whitespace-errbuf)
-             (kill-buffer whitespace-errbuf)
-             (get-buffer-create whitespace-errbuf)
-             (set-buffer whitespace-errbuf)
-             (if whitespace-errmsg
+  (let ((whitespace-error nil))
+    (whitespace-check-whitespace-mode current-prefix-arg)
+    (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
+       (progn
+         (whitespace-check-buffer-list (buffer-name) buffer-file-name)
+         (whitespace-tickle-timer)
+         (if whitespace-auto-cleanup
+             (if buffer-read-only
+                 (if (not quiet)
+                     (message "Can't cleanup: %s is read-only" (buffer-name)))
+               (whitespace-cleanup))
+           (let ((whitespace-leading (if whitespace-check-leading-whitespace
+                                         (whitespace-buffer-leading)
+                                       nil))
+                 (whitespace-trailing (if whitespace-check-trailing-whitespace
+                                          (whitespace-buffer-trailing)
+                                        nil))
+                 (whitespace-indent (if whitespace-check-indent-whitespace
+                                        (whitespace-buffer-search
+                                         whitespace-indent-regexp)
+                                      nil))
+                 (whitespace-spacetab (if whitespace-check-spacetab-whitespace
+                                          (whitespace-buffer-search
+                                           whitespace-spacetab-regexp)
+                                        nil))
+                 (whitespace-ateol (if whitespace-check-ateol-whitespace
+                                       (whitespace-buffer-search
+                                        whitespace-ateol-regexp)
+                                     nil))
+                 (whitespace-errmsg nil)
+                 (whitespace-filename buffer-file-name)
+                 (whitespace-this-modeline ""))
+
+             ;; Now let's complain if we found any of the above.
+             (setq whitespace-error (or whitespace-leading whitespace-indent
+                                        whitespace-spacetab whitespace-ateol
+                                        whitespace-trailing))
+
+             (if whitespace-error
                  (progn
-                   (insert whitespace-errmsg)
-                   (if (not (or quiet whitespace-silent))
-                       (display-buffer whitespace-errbuf t))
-                   (if (not quiet)
-                       (message "Whitespaces: [%s] in %s"
-                                whitespace-this-modeline
-                                whitespace-filename)))
-               (if (not quiet)
-                   (message "%s clean" whitespace-filename)))))))))
+                   (setq whitespace-errmsg
+                         (concat whitespace-filename " contains:\n"
+                                 (if whitespace-leading
+                                     "Leading whitespace\n")
+                                 (if whitespace-indent
+                                     (concat "Indentation whitespace"
+                                             whitespace-indent "\n"))
+                                 (if whitespace-spacetab
+                                     (concat "Space followed by Tab"
+                                             whitespace-spacetab "\n"))
+                                 (if whitespace-ateol
+                                     (concat "End-of-line whitespace"
+                                             whitespace-ateol "\n"))
+                                 (if whitespace-trailing
+                                     "Trailing whitespace\n")
+                                 "\ntype `M-x whitespace-cleanup' to "
+                                 "cleanup the file."))
+                   (setq whitespace-this-modeline
+                         (concat (if whitespace-ateol "e")
+                                 (if whitespace-indent "i")
+                                 (if whitespace-leading "l")
+                                 (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 whitespace-errmsg
+                   (progn
+                     (insert whitespace-errmsg)
+                     (if (not (or quiet whitespace-silent))
+                         (display-buffer whitespace-errbuf t))
+                     (if (not quiet)
+                         (message "Whitespaces: [%s%s] in %s"
+                                  whitespace-this-modeline
+                                  (let ((whitespace-unchecked
+                                         (whitespace-unchecked-whitespaces)))
+                                    (if whitespace-unchecked
+                                        (concat "!" whitespace-unchecked)
+                                      ""))
+                                  whitespace-filename)))
+                 (if (not quiet)
+                     (message "%s clean" whitespace-filename))))))))
+    (if whitespace-error
+       t
+      nil)))
 
 ;;;###autoload
 (defun whitespace-region (s e)
@@ -280,37 +334,42 @@ whitespace problems."
        ;; they are displayed.
        (setq tab-width whitespace-tabwith)
 
-       (if (whitespace-buffer-leading)
+       (if (and whitespace-check-leading-whitespace
+                (whitespace-buffer-leading))
            (progn
              (whitespace-buffer-leading-cleanup)
              (setq whitespace-any t)))
 
-       (if (whitespace-buffer-trailing)
+       (if (and whitespace-check-trailing-whitespace
+                (whitespace-buffer-trailing))
            (progn
              (whitespace-buffer-trailing-cleanup)
              (setq whitespace-any t)))
 
-       (if (whitespace-buffer-search whitespace-indent-regexp)
+       (if (and whitespace-check-indent-whitespace
+                (whitespace-buffer-search whitespace-indent-regexp))
            (progn
              (whitespace-indent-cleanup)
              (setq whitespace-any t)))
 
-       (if (whitespace-buffer-search whitespace-spacetab-regexp)
+       (if (and whitespace-check-spacetab-whitespace
+                (whitespace-buffer-search whitespace-spacetab-regexp))
            (progn
              (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
              (setq whitespace-any t)))
 
-       (if (whitespace-buffer-search whitespace-ateol-regexp)
+       (if (and whitespace-check-ateol-whitespace
+                (whitespace-buffer-search whitespace-ateol-regexp))
            (progn
              (whitespace-buffer-cleanup whitespace-ateol-regexp "")
              (setq whitespace-any t)))
 
        ;; Call this recursively till everything is taken care of
-       (if whitespace-any (whitespace-cleanup)
+       (if whitespace-any
+           (whitespace-cleanup)
          (progn
            (message "%s clean" buffer-file-name)
-           (setq whitespace-mode-line nil)
-           (whitespace-force-mode-line-update)))
+           (whitespace-update-modeline)))
        (setq tab-width whitespace-tabwith-saved))))
 
 ;;;###autoload
@@ -427,6 +486,38 @@ whitespace problems."
        (delete-region (match-beginning 0) (point))
        (indent-to column)))))
 
+(defun whitespace-unchecked-whitespaces ()
+  "Return the list of whitespaces whose testing has been suppressed."
+  (let ((whitespace-this-modeline
+        (concat (if (not whitespace-check-ateol-whitespace) "e")
+                (if (not whitespace-check-indent-whitespace) "i")
+                (if (not whitespace-check-leading-whitespace) "l")
+                (if (not whitespace-check-spacetab-whitespace) "s")
+                (if (not whitespace-check-trailing-whitespace) "t"))))
+    (if (not (equal whitespace-this-modeline ""))
+       whitespace-this-modeline
+      nil)))
+
+(defun whitespace-update-modeline (&optional whitespace-err)
+  "Update modeline with whitespace errors and whitespaces whose testing has
+been turned off."
+  (if whitespace-display-in-modeline
+      (progn
+       (setq whitespace-mode-line nil)
+       ;; Whitespace errors
+       (if (and whitespace-err (not (equal whitespace-err "")))
+           (setq whitespace-mode-line whitespace-err))
+       ;; Whitespace suppressed errors
+       (let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
+         (if whitespace-unchecked
+             (setq whitespace-mode-line
+                   (concat whitespace-mode-line "!" whitespace-unchecked))))
+       ;; Add the whitespace modeline prefix
+       (setq whitespace-mode-line (if whitespace-mode-line
+                                      (concat " W:" whitespace-mode-line)
+                                    nil))
+       (whitespace-force-mode-line-update))))
+
 ;; Force mode line updation for different Emacs versions
 (defun whitespace-force-mode-line-update ()
   "Force the mode line update for different flavors of Emacs."
@@ -449,7 +540,7 @@ periodically for whitespace."
 If timer is not set, then set it to scan the files in
 `whitespace-all-buffer-files' periodically (defined by
 `whitespace-rescan-timer-time') for whitespace creep."
-  (if (not whitespace-rescan-timer)
+  (if (and whitespace-rescan-timer-time (not whitespace-rescan-timer))
       (setq whitespace-rescan-timer
            (if whitespace-running-emacs
                (run-at-time nil whitespace-rescan-timer-time
@@ -523,8 +614,8 @@ of whitespace problems that commonly exist in source code.
 
 Whitespace errors are reported in a buffer, and on the modeline.
 
-Modeline will show a W:<x> to denote a particular type of whitespace, where
-`x' can be one (or more) of:
+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.
@@ -532,6 +623,9 @@ 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