diff options
| -rw-r--r-- | lisp/obsolete/whitespace.el | 814 |
1 files changed, 814 insertions, 0 deletions
diff --git a/lisp/obsolete/whitespace.el b/lisp/obsolete/whitespace.el new file mode 100644 index 00000000000..b2ef06c9584 --- /dev/null +++ b/lisp/obsolete/whitespace.el | |||
| @@ -0,0 +1,814 @@ | |||
| 1 | ;;; whitespace.el --- warn about and clean bogus whitespaces in the file | ||
| 2 | |||
| 3 | ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Rajesh Vaidheeswarran <rv@gnu.org> | ||
| 7 | ;; Keywords: convenience | ||
| 8 | |||
| 9 | ;; This file is part of GNU Emacs. | ||
| 10 | |||
| 11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 12 | ;; it under the terms of the GNU General Public License as published by | ||
| 13 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 14 | ;; any later version. | ||
| 15 | |||
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 19 | ;; GNU General Public License for more details. | ||
| 20 | |||
| 21 | ;; You should have received a copy of the GNU General Public License | ||
| 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 24 | ;; Boston, MA 02110-1301, USA. | ||
| 25 | |||
| 26 | ;;; Commentary: | ||
| 27 | ;; | ||
| 28 | ;; URL: http://www.dsmit.com/lisp/ | ||
| 29 | ;; | ||
| 30 | ;; The whitespace library is intended to find and help fix five different types | ||
| 31 | ;; of whitespace problems that commonly exist in source code. | ||
| 32 | ;; | ||
| 33 | ;; 1. Leading space (empty lines at the top of a file). | ||
| 34 | ;; 2. Trailing space (empty lines at the end of a file). | ||
| 35 | ;; 3. Indentation space (8 or more spaces at beginning of line, that should be | ||
| 36 | ;; replaced with TABS). | ||
| 37 | ;; 4. Spaces followed by a TAB. (Almost always, we never want that). | ||
| 38 | ;; 5. Spaces or TABS at the end of a line. | ||
| 39 | ;; | ||
| 40 | ;; Whitespace errors are reported in a buffer, and on the modeline. | ||
| 41 | ;; | ||
| 42 | ;; Modeline will show a W:<x>!<y> to denote a particular type of whitespace, | ||
| 43 | ;; where `x' and `y' can be one (or more) of: | ||
| 44 | ;; | ||
| 45 | ;; e - End-of-Line whitespace. | ||
| 46 | ;; i - Indentation whitespace. | ||
| 47 | ;; l - Leading whitespace. | ||
| 48 | ;; s - Space followed by Tab. | ||
| 49 | ;; t - Trailing whitespace. | ||
| 50 | ;; | ||
| 51 | ;; If any of the whitespace checks is turned off, the modeline will display a | ||
| 52 | ;; !<y>. | ||
| 53 | ;; | ||
| 54 | ;; (since (3) is the most controversial one, here is the rationale: Most | ||
| 55 | ;; terminal drivers and printer drivers have TAB configured or even | ||
| 56 | ;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost | ||
| 57 | ;; always they default to 8.) | ||
| 58 | ;; | ||
| 59 | ;; Changing `tab-width' to other than 8 and editing will cause your code to | ||
| 60 | ;; look different from within Emacs, and say, if you cat it or more it, or | ||
| 61 | ;; even print it. | ||
| 62 | ;; | ||
| 63 | ;; Almost all the popular programming modes let you define an offset (like | ||
| 64 | ;; c-basic-offset or perl-indent-level) to configure the offset, so you | ||
| 65 | ;; should never have to set your `tab-width' to be other than 8 in all | ||
| 66 | ;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause | ||
| 67 | ;; Emacs to replace your 8 spaces with one \t (try it). If vi users in | ||
| 68 | ;; your office complain, tell them to use vim, which distinguishes between | ||
| 69 | ;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them | ||
| 70 | ;; to set smarttab.) | ||
| 71 | ;; | ||
| 72 | ;; All the above have caused (and will cause) unwanted codeline integration and | ||
| 73 | ;; merge problems. | ||
| 74 | ;; | ||
| 75 | ;; whitespace.el will complain if it detects whitespaces on opening a file, and | ||
| 76 | ;; warn you on closing a file also (in case you had inserted any | ||
| 77 | ;; whitespaces during the process of your editing). | ||
| 78 | ;; | ||
| 79 | ;; Exported functions: | ||
| 80 | ;; | ||
| 81 | ;; `whitespace-buffer' - To check the current buffer for whitespace problems. | ||
| 82 | ;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer. | ||
| 83 | ;; `whitespace-region' - To check between point and mark for whitespace | ||
| 84 | ;; problems. | ||
| 85 | ;; `whitespace-cleanup-region' - To cleanup all whitespaces between point | ||
| 86 | ;; and mark in the current buffer. | ||
| 87 | |||
| 88 | ;;; Code: | ||
| 89 | |||
| 90 | (defvar whitespace-version "3.5" "Version of the whitespace library.") | ||
| 91 | |||
| 92 | (defvar whitespace-all-buffer-files nil | ||
| 93 | "An associated list of buffers and files checked for whitespace cleanliness. | ||
| 94 | |||
| 95 | This is to enable periodic checking of whitespace cleanliness in the files | ||
| 96 | visited by the buffers.") | ||
| 97 | |||
| 98 | (defvar whitespace-rescan-timer nil | ||
| 99 | "Timer object used to rescan the files in buffers that have been modified.") | ||
| 100 | |||
| 101 | ;; Tell Emacs about this new kind of minor mode | ||
| 102 | (defvar whitespace-mode nil | ||
| 103 | "Non-nil when Whitespace mode (a minor mode) is enabled.") | ||
| 104 | (make-variable-buffer-local 'whitespace-mode) | ||
| 105 | |||
| 106 | (defvar whitespace-mode-line nil | ||
| 107 | "String to display in the mode line for Whitespace mode.") | ||
| 108 | (make-variable-buffer-local 'whitespace-mode-line) | ||
| 109 | |||
| 110 | (defvar whitespace-check-buffer-leading nil | ||
| 111 | "Test leading whitespace for file in current buffer if t.") | ||
| 112 | (make-variable-buffer-local 'whitespace-check-buffer-leading) | ||
| 113 | ;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable 'booleanp) | ||
| 114 | |||
| 115 | (defvar whitespace-check-buffer-trailing nil | ||
| 116 | "Test trailing whitespace for file in current buffer if t.") | ||
| 117 | (make-variable-buffer-local 'whitespace-check-buffer-trailing) | ||
| 118 | ;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable 'booleanp) | ||
| 119 | |||
| 120 | (defvar whitespace-check-buffer-indent nil | ||
| 121 | "Test indentation whitespace for file in current buffer if t.") | ||
| 122 | (make-variable-buffer-local 'whitespace-check-buffer-indent) | ||
| 123 | ;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable 'booleanp) | ||
| 124 | |||
| 125 | (defvar whitespace-check-buffer-spacetab nil | ||
| 126 | "Test Space-followed-by-TABS whitespace for file in current buffer if t.") | ||
| 127 | (make-variable-buffer-local 'whitespace-check-buffer-spacetab) | ||
| 128 | ;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable 'booleanp) | ||
| 129 | |||
| 130 | (defvar whitespace-check-buffer-ateol nil | ||
| 131 | "Test end-of-line whitespace for file in current buffer if t.") | ||
| 132 | (make-variable-buffer-local 'whitespace-check-buffer-ateol) | ||
| 133 | ;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable 'booleanp) | ||
| 134 | |||
| 135 | (defvar whitespace-highlighted-space nil | ||
| 136 | "The variable to store the extent to highlight.") | ||
| 137 | (make-variable-buffer-local 'whitespace-highlighted-space) | ||
| 138 | |||
| 139 | (defalias 'whitespace-make-overlay | ||
| 140 | (if (featurep 'xemacs) 'make-extent 'make-overlay)) | ||
| 141 | (defalias 'whitespace-overlay-put | ||
| 142 | (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) | ||
| 143 | (defalias 'whitespace-delete-overlay | ||
| 144 | (if (featurep 'xemacs) 'delete-extent 'delete-overlay)) | ||
| 145 | (defalias 'whitespace-overlay-start | ||
| 146 | (if (featurep 'xemacs) 'extent-start 'overlay-start)) | ||
| 147 | (defalias 'whitespace-overlay-end | ||
| 148 | (if (featurep 'xemacs) 'extent-end 'overlay-end)) | ||
| 149 | (defalias 'whitespace-mode-line-update | ||
| 150 | (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update)) | ||
| 151 | |||
| 152 | (defgroup whitespace nil | ||
| 153 | "Check for and fix five different types of whitespaces in source code." | ||
| 154 | :version "21.1" | ||
| 155 | :link '(emacs-commentary-link "whitespace.el") | ||
| 156 | ;; Since XEmacs doesn't have a 'convenience group, use the next best group | ||
| 157 | ;; which is 'editing? | ||
| 158 | :group (if (featurep 'xemacs) 'editing 'convenience)) | ||
| 159 | |||
| 160 | (defcustom whitespace-check-leading-whitespace t | ||
| 161 | "Flag to check leading whitespace. This is the global for the system. | ||
| 162 | It can be overridden by setting a buffer local variable | ||
| 163 | `whitespace-check-buffer-leading'." | ||
| 164 | :type 'boolean | ||
| 165 | :group 'whitespace) | ||
| 166 | |||
| 167 | (defcustom whitespace-check-trailing-whitespace t | ||
| 168 | "Flag to check trailing whitespace. This is the global for the system. | ||
| 169 | It can be overridden by setting a buffer local variable | ||
| 170 | `whitespace-check-buffer-trailing'." | ||
| 171 | :type 'boolean | ||
| 172 | :group 'whitespace) | ||
| 173 | |||
| 174 | (defcustom whitespace-check-spacetab-whitespace t | ||
| 175 | "Flag to check space followed by a TAB. This is the global for the system. | ||
| 176 | It can be overridden by setting a buffer local variable | ||
| 177 | `whitespace-check-buffer-spacetab'." | ||
| 178 | :type 'boolean | ||
| 179 | :group 'whitespace) | ||
| 180 | |||
| 181 | (defcustom whitespace-spacetab-regexp "[ ]+\t" | ||
| 182 | "Regexp to match one or more spaces followed by a TAB." | ||
| 183 | :type 'regexp | ||
| 184 | :group 'whitespace) | ||
| 185 | |||
| 186 | (defcustom whitespace-check-indent-whitespace indent-tabs-mode | ||
| 187 | "Flag to check indentation whitespace. This is the global for the system. | ||
| 188 | It can be overridden by setting a buffer local variable | ||
| 189 | `whitespace-check-buffer-indent'." | ||
| 190 | :type 'boolean | ||
| 191 | :group 'whitespace) | ||
| 192 | |||
| 193 | (defcustom whitespace-indent-regexp "^\t*\\( \\)+" | ||
| 194 | "Regexp to match multiples of eight spaces near line beginnings. | ||
| 195 | The default value ignores leading TABs." | ||
| 196 | :type 'regexp | ||
| 197 | :group 'whitespace) | ||
| 198 | |||
| 199 | (defcustom whitespace-check-ateol-whitespace t | ||
| 200 | "Flag to check end-of-line whitespace. This is the global for the system. | ||
| 201 | It can be overridden by setting a buffer local variable | ||
| 202 | `whitespace-check-buffer-ateol'." | ||
| 203 | :type 'boolean | ||
| 204 | :group 'whitespace) | ||
| 205 | |||
| 206 | (defcustom whitespace-ateol-regexp "[ \t]+$" | ||
| 207 | "Regexp to match one or more TABs or spaces at line ends." | ||
| 208 | :type 'regexp | ||
| 209 | :group 'whitespace) | ||
| 210 | |||
| 211 | (defcustom whitespace-errbuf "*Whitespace Errors*" | ||
| 212 | "The name of the buffer where whitespace related messages will be logged." | ||
| 213 | :type 'string | ||
| 214 | :group 'whitespace) | ||
| 215 | |||
| 216 | (defcustom whitespace-clean-msg "clean." | ||
| 217 | "If non-nil, this message will be displayed after a whitespace check | ||
| 218 | determines a file to be clean." | ||
| 219 | :type 'string | ||
| 220 | :group 'whitespace) | ||
| 221 | |||
| 222 | (defcustom whitespace-abort-on-error nil | ||
| 223 | "While writing a file, abort if the file is unclean. | ||
| 224 | If `whitespace-auto-cleanup' is set, that takes precedence over | ||
| 225 | this variable." | ||
| 226 | :type 'boolean | ||
| 227 | :group 'whitespace) | ||
| 228 | |||
| 229 | (defcustom whitespace-auto-cleanup nil | ||
| 230 | "Cleanup a buffer automatically on finding it whitespace unclean." | ||
| 231 | :type 'boolean | ||
| 232 | :group 'whitespace) | ||
| 233 | |||
| 234 | (defcustom whitespace-silent nil | ||
| 235 | "All whitespace errors will be shown only in the modeline when t. | ||
| 236 | |||
| 237 | Note that setting this may cause all whitespaces introduced in a file to go | ||
| 238 | unnoticed when the buffer is killed, unless the user visits the `*Whitespace | ||
| 239 | Errors*' buffer before opening (or closing) another file." | ||
| 240 | :type 'boolean | ||
| 241 | :group 'whitespace) | ||
| 242 | |||
| 243 | (defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode | ||
| 244 | c-mode c++-mode cc-mode | ||
| 245 | change-log-mode cperl-mode | ||
| 246 | electric-nroff-mode emacs-lisp-mode | ||
| 247 | f90-mode fortran-mode html-mode | ||
| 248 | html3-mode java-mode jde-mode | ||
| 249 | ksh-mode latex-mode LaTeX-mode | ||
| 250 | lisp-mode m4-mode makefile-mode | ||
| 251 | modula-2-mode nroff-mode objc-mode | ||
| 252 | pascal-mode perl-mode prolog-mode | ||
| 253 | python-mode scheme-mode sgml-mode | ||
| 254 | sh-mode shell-script-mode simula-mode | ||
| 255 | tcl-mode tex-mode texinfo-mode | ||
| 256 | vrml-mode xml-mode) | ||
| 257 | |||
| 258 | "Major modes in which we turn on whitespace checking. | ||
| 259 | |||
| 260 | These are mostly programming and documentation modes. But you may add other | ||
| 261 | modes that you want whitespaces checked in by adding something like the | ||
| 262 | following to your `.emacs': | ||
| 263 | |||
| 264 | \(setq whitespace-modes (cons 'my-mode (cons 'my-other-mode | ||
| 265 | whitespace-modes))\) | ||
| 266 | |||
| 267 | Or, alternately, you can use the Emacs `customize' command to set this." | ||
| 268 | :type '(repeat symbol) | ||
| 269 | :group 'whitespace) | ||
| 270 | |||
| 271 | (defcustom whitespace-rescan-timer-time 600 | ||
| 272 | "Period in seconds to rescan modified buffers for whitespace creep. | ||
| 273 | |||
| 274 | This is the period after which the timer will fire causing | ||
| 275 | `whitespace-rescan-files-in-buffers' to check for whitespace creep in | ||
| 276 | modified buffers. | ||
| 277 | |||
| 278 | To disable timer scans, set this to zero." | ||
| 279 | :type 'integer | ||
| 280 | :group 'whitespace) | ||
| 281 | |||
| 282 | (defcustom whitespace-display-in-modeline t | ||
| 283 | "Display whitespace errors on the modeline." | ||
| 284 | :type 'boolean | ||
| 285 | :group 'whitespace) | ||
| 286 | |||
| 287 | (defcustom whitespace-display-spaces-in-color t | ||
| 288 | "Display the bogus whitespaces by coloring them with the face | ||
| 289 | `whitespace-highlight'." | ||
| 290 | :type 'boolean | ||
| 291 | :group 'whitespace) | ||
| 292 | |||
| 293 | (defgroup whitespace-faces nil | ||
| 294 | "Faces used in whitespace." | ||
| 295 | :prefix "whitespace-" | ||
| 296 | :group 'whitespace | ||
| 297 | :group 'faces) | ||
| 298 | |||
| 299 | (defface whitespace-highlight '((((class color) (background light)) | ||
| 300 | (:background "green1")) | ||
| 301 | (((class color) (background dark)) | ||
| 302 | (:background "sea green")) | ||
| 303 | (((class grayscale mono) | ||
| 304 | (background light)) | ||
| 305 | (:background "black")) | ||
| 306 | (((class grayscale mono) | ||
| 307 | (background dark)) | ||
| 308 | (:background "white"))) | ||
| 309 | "Face used for highlighting the bogus whitespaces that exist in the buffer." | ||
| 310 | :group 'whitespace-faces) | ||
| 311 | ;; backward-compatibility alias | ||
| 312 | (put 'whitespace-highlight-face 'face-alias 'whitespace-highlight) | ||
| 313 | |||
| 314 | (if (not (assoc 'whitespace-mode minor-mode-alist)) | ||
| 315 | (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) | ||
| 316 | minor-mode-alist))) | ||
| 317 | |||
| 318 | (set-default 'whitespace-check-buffer-leading | ||
| 319 | whitespace-check-leading-whitespace) | ||
| 320 | (set-default 'whitespace-check-buffer-trailing | ||
| 321 | whitespace-check-trailing-whitespace) | ||
| 322 | (set-default 'whitespace-check-buffer-indent | ||
| 323 | whitespace-check-indent-whitespace) | ||
| 324 | (set-default 'whitespace-check-buffer-spacetab | ||
| 325 | whitespace-check-spacetab-whitespace) | ||
| 326 | (set-default 'whitespace-check-buffer-ateol | ||
| 327 | whitespace-check-ateol-whitespace) | ||
| 328 | |||
| 329 | (defun whitespace-check-whitespace-mode (&optional arg) | ||
| 330 | "Test and set the whitespace-mode in qualifying buffers." | ||
| 331 | (if (null whitespace-mode) | ||
| 332 | (setq whitespace-mode | ||
| 333 | (if (or arg (member major-mode whitespace-modes)) | ||
| 334 | t | ||
| 335 | nil)))) | ||
| 336 | |||
| 337 | ;;;###autoload | ||
| 338 | (defun whitespace-toggle-leading-check () | ||
| 339 | "Toggle the check for leading space in the local buffer." | ||
| 340 | (interactive) | ||
| 341 | (let ((current-val whitespace-check-buffer-leading)) | ||
| 342 | (setq whitespace-check-buffer-leading (not current-val)) | ||
| 343 | (message "Will%s check for leading space in buffer." | ||
| 344 | (if whitespace-check-buffer-leading "" " not")) | ||
| 345 | (if whitespace-check-buffer-leading (whitespace-buffer-leading)))) | ||
| 346 | |||
| 347 | ;;;###autoload | ||
| 348 | (defun whitespace-toggle-trailing-check () | ||
| 349 | "Toggle the check for trailing space in the local buffer." | ||
| 350 | (interactive) | ||
| 351 | (let ((current-val whitespace-check-buffer-trailing)) | ||
| 352 | (setq whitespace-check-buffer-trailing (not current-val)) | ||
| 353 | (message "Will%s check for trailing space in buffer." | ||
| 354 | (if whitespace-check-buffer-trailing "" " not")) | ||
| 355 | (if whitespace-check-buffer-trailing (whitespace-buffer-trailing)))) | ||
| 356 | |||
| 357 | ;;;###autoload | ||
| 358 | (defun whitespace-toggle-indent-check () | ||
| 359 | "Toggle the check for indentation space in the local buffer." | ||
| 360 | (interactive) | ||
| 361 | (let ((current-val whitespace-check-buffer-indent)) | ||
| 362 | (setq whitespace-check-buffer-indent (not current-val)) | ||
| 363 | (message "Will%s check for indentation space in buffer." | ||
| 364 | (if whitespace-check-buffer-indent "" " not")) | ||
| 365 | (if whitespace-check-buffer-indent | ||
| 366 | (whitespace-buffer-search whitespace-indent-regexp)))) | ||
| 367 | |||
| 368 | ;;;###autoload | ||
| 369 | (defun whitespace-toggle-spacetab-check () | ||
| 370 | "Toggle the check for space-followed-by-TABs in the local buffer." | ||
| 371 | (interactive) | ||
| 372 | (let ((current-val whitespace-check-buffer-spacetab)) | ||
| 373 | (setq whitespace-check-buffer-spacetab (not current-val)) | ||
| 374 | (message "Will%s check for space-followed-by-TABs in buffer." | ||
| 375 | (if whitespace-check-buffer-spacetab "" " not")) | ||
| 376 | (if whitespace-check-buffer-spacetab | ||
| 377 | (whitespace-buffer-search whitespace-spacetab-regexp)))) | ||
| 378 | |||
| 379 | |||
| 380 | ;;;###autoload | ||
| 381 | (defun whitespace-toggle-ateol-check () | ||
| 382 | "Toggle the check for end-of-line space in the local buffer." | ||
| 383 | (interactive) | ||
| 384 | (let ((current-val whitespace-check-buffer-ateol)) | ||
| 385 | (setq whitespace-check-buffer-ateol (not current-val)) | ||
| 386 | (message "Will%s check for end-of-line space in buffer." | ||
| 387 | (if whitespace-check-buffer-ateol "" " not")) | ||
| 388 | (if whitespace-check-buffer-ateol | ||
| 389 | (whitespace-buffer-search whitespace-ateol-regexp)))) | ||
| 390 | |||
| 391 | |||
| 392 | ;;;###autoload | ||
| 393 | (defun whitespace-buffer (&optional quiet) | ||
| 394 | "Find five different types of white spaces in buffer. | ||
| 395 | These are: | ||
| 396 | 1. Leading space \(empty lines at the top of a file\). | ||
| 397 | 2. Trailing space \(empty lines at the end of a file\). | ||
| 398 | 3. Indentation space \(8 or more spaces, that should be replaced with TABS\). | ||
| 399 | 4. Spaces followed by a TAB. \(Almost always, we never want that\). | ||
| 400 | 5. Spaces or TABS at the end of a line. | ||
| 401 | |||
| 402 | Check for whitespace only if this buffer really contains a non-empty file | ||
| 403 | and: | ||
| 404 | 1. the major mode is one of the whitespace-modes, or | ||
| 405 | 2. `whitespace-buffer' was explicitly called with a prefix argument." | ||
| 406 | (interactive) | ||
| 407 | (let ((whitespace-error nil)) | ||
| 408 | (whitespace-check-whitespace-mode current-prefix-arg) | ||
| 409 | (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode) | ||
| 410 | (progn | ||
| 411 | (whitespace-check-buffer-list (buffer-name) buffer-file-name) | ||
| 412 | (whitespace-tickle-timer) | ||
| 413 | (overlay-recenter (point-max)) | ||
| 414 | (remove-overlays nil nil 'face 'whitespace-highlight) | ||
| 415 | (if whitespace-auto-cleanup | ||
| 416 | (if buffer-read-only | ||
| 417 | (if (not quiet) | ||
| 418 | (message "Can't cleanup: %s is read-only" (buffer-name))) | ||
| 419 | (whitespace-cleanup-internal)) | ||
| 420 | (let ((whitespace-leading (if whitespace-check-buffer-leading | ||
| 421 | (whitespace-buffer-leading) | ||
| 422 | nil)) | ||
| 423 | (whitespace-trailing (if whitespace-check-buffer-trailing | ||
| 424 | (whitespace-buffer-trailing) | ||
| 425 | nil)) | ||
| 426 | (whitespace-indent (if whitespace-check-buffer-indent | ||
| 427 | (whitespace-buffer-search | ||
| 428 | whitespace-indent-regexp) | ||
| 429 | nil)) | ||
| 430 | (whitespace-spacetab (if whitespace-check-buffer-spacetab | ||
| 431 | (whitespace-buffer-search | ||
| 432 | whitespace-spacetab-regexp) | ||
| 433 | nil)) | ||
| 434 | (whitespace-ateol (if whitespace-check-buffer-ateol | ||
| 435 | (whitespace-buffer-search | ||
| 436 | whitespace-ateol-regexp) | ||
| 437 | nil)) | ||
| 438 | (whitespace-errmsg nil) | ||
| 439 | (whitespace-filename buffer-file-name) | ||
| 440 | (whitespace-this-modeline "")) | ||
| 441 | |||
| 442 | ;; Now let's complain if we found any of the above. | ||
| 443 | (setq whitespace-error (or whitespace-leading whitespace-indent | ||
| 444 | whitespace-spacetab whitespace-ateol | ||
| 445 | whitespace-trailing)) | ||
| 446 | |||
| 447 | (if whitespace-error | ||
| 448 | (progn | ||
| 449 | (setq whitespace-errmsg | ||
| 450 | (concat whitespace-filename " contains:\n" | ||
| 451 | (if whitespace-leading | ||
| 452 | "Leading whitespace\n") | ||
| 453 | (if whitespace-indent | ||
| 454 | (concat "Indentation whitespace" | ||
| 455 | whitespace-indent "\n")) | ||
| 456 | (if whitespace-spacetab | ||
| 457 | (concat "Space followed by Tab" | ||
| 458 | whitespace-spacetab "\n")) | ||
| 459 | (if whitespace-ateol | ||
| 460 | (concat "End-of-line whitespace" | ||
| 461 | whitespace-ateol "\n")) | ||
| 462 | (if whitespace-trailing | ||
| 463 | "Trailing whitespace\n") | ||
| 464 | "\ntype `M-x whitespace-cleanup' to " | ||
| 465 | "cleanup the file.")) | ||
| 466 | (setq whitespace-this-modeline | ||
| 467 | (concat (if whitespace-ateol "e") | ||
| 468 | (if whitespace-indent "i") | ||
| 469 | (if whitespace-leading "l") | ||
| 470 | (if whitespace-spacetab "s") | ||
| 471 | (if whitespace-trailing "t"))))) | ||
| 472 | (whitespace-update-modeline whitespace-this-modeline) | ||
| 473 | (if (get-buffer whitespace-errbuf) | ||
| 474 | (kill-buffer whitespace-errbuf)) | ||
| 475 | (with-current-buffer (get-buffer-create whitespace-errbuf) | ||
| 476 | (if whitespace-errmsg | ||
| 477 | (progn | ||
| 478 | (insert whitespace-errmsg) | ||
| 479 | (if (not (or quiet whitespace-silent)) | ||
| 480 | (display-buffer (current-buffer) t)) | ||
| 481 | (if (not quiet) | ||
| 482 | (message "Whitespaces: [%s%s] in %s" | ||
| 483 | whitespace-this-modeline | ||
| 484 | (let ((whitespace-unchecked | ||
| 485 | (whitespace-unchecked-whitespaces))) | ||
| 486 | (if whitespace-unchecked | ||
| 487 | (concat "!" whitespace-unchecked) | ||
| 488 | "")) | ||
| 489 | whitespace-filename))) | ||
| 490 | (if (and (not quiet) (not (equal whitespace-clean-msg ""))) | ||
| 491 | (message "%s %s" whitespace-filename | ||
| 492 | whitespace-clean-msg)))))))) | ||
| 493 | whitespace-error)) | ||
| 494 | |||
| 495 | ;;;###autoload | ||
| 496 | (defun whitespace-region (s e) | ||
| 497 | "Check the region for whitespace errors." | ||
| 498 | (interactive "r") | ||
| 499 | (save-excursion | ||
| 500 | (save-restriction | ||
| 501 | (narrow-to-region s e) | ||
| 502 | (whitespace-buffer)))) | ||
| 503 | |||
| 504 | ;;;###autoload | ||
| 505 | (defun whitespace-cleanup () | ||
| 506 | "Cleanup the five different kinds of whitespace problems. | ||
| 507 | It normally applies to the whole buffer, but in Transient Mark mode | ||
| 508 | when the mark is active it applies to the region. | ||
| 509 | See `whitespace-buffer' docstring for a summary of the problems." | ||
| 510 | (interactive) | ||
| 511 | (if (and transient-mark-mode mark-active) | ||
| 512 | (whitespace-cleanup-region (region-beginning) (region-end)) | ||
| 513 | (whitespace-cleanup-internal))) | ||
| 514 | |||
| 515 | (defun whitespace-cleanup-internal (&optional region-only) | ||
| 516 | ;; If this buffer really contains a file, then run, else quit. | ||
| 517 | (whitespace-check-whitespace-mode current-prefix-arg) | ||
| 518 | (if (and buffer-file-name whitespace-mode) | ||
| 519 | (let ((whitespace-any nil) | ||
| 520 | (whitespace-tabwith 8) | ||
| 521 | (whitespace-tabwith-saved tab-width)) | ||
| 522 | |||
| 523 | ;; since all printable TABS should be 8, irrespective of how | ||
| 524 | ;; they are displayed. | ||
| 525 | (setq tab-width whitespace-tabwith) | ||
| 526 | |||
| 527 | (if (and whitespace-check-buffer-leading | ||
| 528 | (whitespace-buffer-leading)) | ||
| 529 | (progn | ||
| 530 | (whitespace-buffer-leading-cleanup) | ||
| 531 | (setq whitespace-any t))) | ||
| 532 | |||
| 533 | (if (and whitespace-check-buffer-trailing | ||
| 534 | (whitespace-buffer-trailing)) | ||
| 535 | (progn | ||
| 536 | (whitespace-buffer-trailing-cleanup) | ||
| 537 | (setq whitespace-any t))) | ||
| 538 | |||
| 539 | (if (and whitespace-check-buffer-indent | ||
| 540 | (whitespace-buffer-search whitespace-indent-regexp)) | ||
| 541 | (progn | ||
| 542 | (whitespace-indent-cleanup) | ||
| 543 | (setq whitespace-any t))) | ||
| 544 | |||
| 545 | (if (and whitespace-check-buffer-spacetab | ||
| 546 | (whitespace-buffer-search whitespace-spacetab-regexp)) | ||
| 547 | (progn | ||
| 548 | (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t") | ||
| 549 | (setq whitespace-any t))) | ||
| 550 | |||
| 551 | (if (and whitespace-check-buffer-ateol | ||
| 552 | (whitespace-buffer-search whitespace-ateol-regexp)) | ||
| 553 | (progn | ||
| 554 | (whitespace-buffer-cleanup whitespace-ateol-regexp "") | ||
| 555 | (setq whitespace-any t))) | ||
| 556 | |||
| 557 | ;; Call this recursively till everything is taken care of | ||
| 558 | (if whitespace-any | ||
| 559 | (whitespace-cleanup-internal region-only) | ||
| 560 | ;; if we are done, talk to the user | ||
| 561 | (progn | ||
| 562 | (unless whitespace-silent | ||
| 563 | (if region-only | ||
| 564 | (message "The region is now clean") | ||
| 565 | (message "%s is now clean" buffer-file-name))) | ||
| 566 | (whitespace-update-modeline))) | ||
| 567 | (setq tab-width whitespace-tabwith-saved)))) | ||
| 568 | |||
| 569 | ;;;###autoload | ||
| 570 | (defun whitespace-cleanup-region (s e) | ||
| 571 | "Whitespace cleanup on the region." | ||
| 572 | (interactive "r") | ||
| 573 | (save-excursion | ||
| 574 | (save-restriction | ||
| 575 | (narrow-to-region s e) | ||
| 576 | (whitespace-cleanup-internal t)) | ||
| 577 | (whitespace-buffer t))) | ||
| 578 | |||
| 579 | (defun whitespace-buffer-leading () | ||
| 580 | "Return t if the current buffer has leading newline characters. | ||
| 581 | If highlighting is enabled, highlight these characters." | ||
| 582 | (save-excursion | ||
| 583 | (goto-char (point-min)) | ||
| 584 | (skip-chars-forward "\n") | ||
| 585 | (unless (bobp) | ||
| 586 | (whitespace-highlight-the-space (point-min) (point)) | ||
| 587 | t))) | ||
| 588 | |||
| 589 | (defun whitespace-buffer-leading-cleanup () | ||
| 590 | "Remove any leading newline characters from current buffer." | ||
| 591 | (save-excursion | ||
| 592 | (goto-char (point-min)) | ||
| 593 | (skip-chars-forward "\n") | ||
| 594 | (delete-region (point-min) (point)))) | ||
| 595 | |||
| 596 | (defun whitespace-buffer-trailing () | ||
| 597 | "Return t if the current buffer has extra trailing newline characters. | ||
| 598 | If highlighting is enabled, highlight these characters." | ||
| 599 | (save-excursion | ||
| 600 | (goto-char (point-max)) | ||
| 601 | (skip-chars-backward "\n") | ||
| 602 | (forward-line) | ||
| 603 | (unless (eobp) | ||
| 604 | (whitespace-highlight-the-space (point) (point-max)) | ||
| 605 | t))) | ||
| 606 | |||
| 607 | (defun whitespace-buffer-trailing-cleanup () | ||
| 608 | "Remove extra trailing newline characters from current buffer." | ||
| 609 | (save-excursion | ||
| 610 | (goto-char (point-max)) | ||
| 611 | (skip-chars-backward "\n") | ||
| 612 | (unless (eobp) | ||
| 613 | (forward-line) | ||
| 614 | (delete-region (point) (point-max))))) | ||
| 615 | |||
| 616 | (defun whitespace-buffer-search (regexp) | ||
| 617 | "Search for any given whitespace REGEXP." | ||
| 618 | (with-local-quit | ||
| 619 | (let (whitespace-retval) | ||
| 620 | (save-excursion | ||
| 621 | (goto-char (point-min)) | ||
| 622 | (while (re-search-forward regexp nil t) | ||
| 623 | (whitespace-highlight-the-space (match-beginning 0) (match-end 0)) | ||
| 624 | (push (match-beginning 0) whitespace-retval))) | ||
| 625 | (when whitespace-retval | ||
| 626 | (format " %s" (nreverse whitespace-retval)))))) | ||
| 627 | |||
| 628 | (defun whitespace-buffer-cleanup (regexp newregexp) | ||
| 629 | "Search for any given whitespace REGEXP and replace it with the NEWREGEXP." | ||
| 630 | (save-excursion | ||
| 631 | (goto-char (point-min)) | ||
| 632 | (while (re-search-forward regexp nil t) | ||
| 633 | (replace-match newregexp)))) | ||
| 634 | |||
| 635 | (defun whitespace-indent-cleanup () | ||
| 636 | "Search for 8/more spaces at the start of a line and replace it with tabs." | ||
| 637 | (save-excursion | ||
| 638 | (goto-char (point-min)) | ||
| 639 | (while (re-search-forward whitespace-indent-regexp nil t) | ||
| 640 | (let ((column (current-column)) | ||
| 641 | (indent-tabs-mode t)) | ||
| 642 | (delete-region (match-beginning 0) (point)) | ||
| 643 | (indent-to column))))) | ||
| 644 | |||
| 645 | (defun whitespace-unchecked-whitespaces () | ||
| 646 | "Return the list of whitespaces whose testing has been suppressed." | ||
| 647 | (let ((unchecked-spaces | ||
| 648 | (concat (if (not whitespace-check-buffer-ateol) "e") | ||
| 649 | (if (not whitespace-check-buffer-indent) "i") | ||
| 650 | (if (not whitespace-check-buffer-leading) "l") | ||
| 651 | (if (not whitespace-check-buffer-spacetab) "s") | ||
| 652 | (if (not whitespace-check-buffer-trailing) "t")))) | ||
| 653 | (if (not (equal unchecked-spaces "")) | ||
| 654 | unchecked-spaces | ||
| 655 | nil))) | ||
| 656 | |||
| 657 | (defun whitespace-update-modeline (&optional whitespace-err) | ||
| 658 | "Update modeline with whitespace errors. | ||
| 659 | Also with whitespaces whose testing has been turned off." | ||
| 660 | (if whitespace-display-in-modeline | ||
| 661 | (progn | ||
| 662 | (setq whitespace-mode-line nil) | ||
| 663 | ;; Whitespace errors | ||
| 664 | (if (and whitespace-err (not (equal whitespace-err ""))) | ||
| 665 | (setq whitespace-mode-line whitespace-err)) | ||
| 666 | ;; Whitespace suppressed errors | ||
| 667 | (let ((whitespace-unchecked (whitespace-unchecked-whitespaces))) | ||
| 668 | (if whitespace-unchecked | ||
| 669 | (setq whitespace-mode-line | ||
| 670 | (concat whitespace-mode-line "!" whitespace-unchecked)))) | ||
| 671 | ;; Add the whitespace modeline prefix | ||
| 672 | (setq whitespace-mode-line (if whitespace-mode-line | ||
| 673 | (concat " W:" whitespace-mode-line) | ||
| 674 | nil)) | ||
| 675 | (whitespace-mode-line-update)))) | ||
| 676 | |||
| 677 | (defun whitespace-highlight-the-space (b e) | ||
| 678 | "Highlight the current line, unhighlighting a previously jumped to line." | ||
| 679 | (if whitespace-display-spaces-in-color | ||
| 680 | (let ((ol (whitespace-make-overlay b e))) | ||
| 681 | (whitespace-overlay-put ol 'face 'whitespace-highlight)))) | ||
| 682 | |||
| 683 | (defun whitespace-unhighlight-the-space() | ||
| 684 | "Unhighlight the currently highlight line." | ||
| 685 | (if (and whitespace-display-spaces-in-color whitespace-highlighted-space) | ||
| 686 | (progn | ||
| 687 | (mapc 'whitespace-delete-overlay whitespace-highlighted-space) | ||
| 688 | (setq whitespace-highlighted-space nil)))) | ||
| 689 | |||
| 690 | (defun whitespace-check-buffer-list (buf-name buf-file) | ||
| 691 | "Add a buffer and its file to the whitespace monitor list. | ||
| 692 | |||
| 693 | The buffer named BUF-NAME and its associated file BUF-FILE are now monitored | ||
| 694 | periodically for whitespace." | ||
| 695 | (if (and whitespace-mode (not (member (list buf-file buf-name) | ||
| 696 | whitespace-all-buffer-files))) | ||
| 697 | (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name)))) | ||
| 698 | |||
| 699 | (defun whitespace-tickle-timer () | ||
| 700 | "Tickle timer to periodically to scan qualifying files for whitespace creep. | ||
| 701 | |||
| 702 | If timer is not set, then set it to scan the files in | ||
| 703 | `whitespace-all-buffer-files' periodically (defined by | ||
| 704 | `whitespace-rescan-timer-time') for whitespace creep." | ||
| 705 | (if (and whitespace-rescan-timer-time | ||
| 706 | (/= whitespace-rescan-timer-time 0) | ||
| 707 | (not whitespace-rescan-timer)) | ||
| 708 | (setq whitespace-rescan-timer | ||
| 709 | (add-timeout whitespace-rescan-timer-time | ||
| 710 | 'whitespace-rescan-files-in-buffers nil | ||
| 711 | whitespace-rescan-timer-time)))) | ||
| 712 | |||
| 713 | (defun whitespace-rescan-files-in-buffers (&optional arg) | ||
| 714 | "Check monitored files for whitespace creep since last scan." | ||
| 715 | (let ((whitespace-all-my-files whitespace-all-buffer-files) | ||
| 716 | buffile bufname thiselt buf) | ||
| 717 | (if (not whitespace-all-my-files) | ||
| 718 | (progn | ||
| 719 | (disable-timeout whitespace-rescan-timer) | ||
| 720 | (setq whitespace-rescan-timer nil)) | ||
| 721 | (while whitespace-all-my-files | ||
| 722 | (setq thiselt (car whitespace-all-my-files)) | ||
| 723 | (setq whitespace-all-my-files (cdr whitespace-all-my-files)) | ||
| 724 | (setq buffile (car thiselt)) | ||
| 725 | (setq bufname (cadr thiselt)) | ||
| 726 | (setq buf (get-buffer bufname)) | ||
| 727 | (if (buffer-live-p buf) | ||
| 728 | (save-excursion | ||
| 729 | ;;(message "buffer %s live" bufname) | ||
| 730 | (set-buffer bufname) | ||
| 731 | (if whitespace-mode | ||
| 732 | (progn | ||
| 733 | ;;(message "checking for whitespace in %s" bufname) | ||
| 734 | (if whitespace-auto-cleanup | ||
| 735 | (progn | ||
| 736 | ;;(message "cleaning up whitespace in %s" bufname) | ||
| 737 | (whitespace-cleanup-internal)) | ||
| 738 | (progn | ||
| 739 | ;;(message "whitespace-buffer %s." (buffer-name)) | ||
| 740 | (whitespace-buffer t)))) | ||
| 741 | ;;(message "Removing %s from refresh list" bufname) | ||
| 742 | (whitespace-refresh-rescan-list buffile bufname))) | ||
| 743 | ;;(message "Removing %s from refresh list" bufname) | ||
| 744 | (whitespace-refresh-rescan-list buffile bufname)))))) | ||
| 745 | |||
| 746 | (defun whitespace-refresh-rescan-list (buffile bufname) | ||
| 747 | "Refresh the list of files to be rescanned for whitespace creep." | ||
| 748 | (if whitespace-all-buffer-files | ||
| 749 | (setq whitespace-all-buffer-files | ||
| 750 | (delete (list buffile bufname) whitespace-all-buffer-files)) | ||
| 751 | (when whitespace-rescan-timer | ||
| 752 | (disable-timeout whitespace-rescan-timer) | ||
| 753 | (setq whitespace-rescan-timer nil)))) | ||
| 754 | |||
| 755 | ;;;###autoload | ||
| 756 | (defalias 'global-whitespace-mode 'whitespace-global-mode) | ||
| 757 | |||
| 758 | ;;;###autoload | ||
| 759 | (define-minor-mode whitespace-global-mode | ||
| 760 | "Toggle using Whitespace mode in new buffers. | ||
| 761 | With ARG, turn the mode on if ARG is positive, otherwise turn it off. | ||
| 762 | |||
| 763 | When this mode is active, `whitespace-buffer' is added to | ||
| 764 | `find-file-hook' and `kill-buffer-hook'." | ||
| 765 | :global t | ||
| 766 | :group 'whitespace | ||
| 767 | (if whitespace-global-mode | ||
| 768 | (progn | ||
| 769 | (add-hook 'find-file-hook 'whitespace-buffer) | ||
| 770 | (add-hook 'write-file-functions 'whitespace-write-file-hook nil t) | ||
| 771 | (add-hook 'kill-buffer-hook 'whitespace-buffer)) | ||
| 772 | (remove-hook 'find-file-hook 'whitespace-buffer) | ||
| 773 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) | ||
| 774 | (remove-hook 'kill-buffer-hook 'whitespace-buffer))) | ||
| 775 | |||
| 776 | ;;;###autoload | ||
| 777 | (defun whitespace-write-file-hook () | ||
| 778 | "Hook function to be called on the buffer when whitespace check is enabled. | ||
| 779 | This is meant to be added buffer-locally to `write-file-functions'." | ||
| 780 | (let ((werr nil)) | ||
| 781 | (if whitespace-auto-cleanup | ||
| 782 | (whitespace-cleanup-internal) | ||
| 783 | (setq werr (whitespace-buffer))) | ||
| 784 | (if (and whitespace-abort-on-error werr) | ||
| 785 | (error "Abort write due to whitespaces in %s" | ||
| 786 | buffer-file-name))) | ||
| 787 | nil) | ||
| 788 | |||
| 789 | (defun whitespace-unload-function () | ||
| 790 | "Unload the whitespace library." | ||
| 791 | (if (unintern "whitespace-unload-hook") | ||
| 792 | ;; if whitespace-unload-hook is defined, let's get rid of it | ||
| 793 | ;; and recursively call `unload-feature' | ||
| 794 | (progn (unload-feature 'whitespace) t) | ||
| 795 | ;; this only happens in the recursive call | ||
| 796 | (whitespace-global-mode -1) | ||
| 797 | (save-current-buffer | ||
| 798 | (dolist (buf (buffer-list)) | ||
| 799 | (set-buffer buf) | ||
| 800 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t))) | ||
| 801 | ;; continue standard unloading | ||
| 802 | nil)) | ||
| 803 | |||
| 804 | (defun whitespace-unload-hook () | ||
| 805 | (remove-hook 'find-file-hook 'whitespace-buffer) | ||
| 806 | (remove-hook 'write-file-functions 'whitespace-write-file-hook t) | ||
| 807 | (remove-hook 'kill-buffer-hook 'whitespace-buffer)) | ||
| 808 | |||
| 809 | (add-hook 'whitespace-unload-hook 'whitespace-unload-hook) | ||
| 810 | |||
| 811 | (provide 'whitespace) | ||
| 812 | |||
| 813 | ;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c | ||
| 814 | ;;; whitespace.el ends here | ||