lisp/whitespace.el

   1 ;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
   2
   3 ;; Copyright (C) 2000-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   6 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   7 ;; Keywords: data, wp
   8 ;; Version: 13.2.2
   9 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; Introduction
  31 ;; ------------
  32 ;;
  33 ;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE
  34 ;; and NEWLINE).
  35 ;;
  36 ;; whitespace uses two ways to visualize blanks: faces and display
  37 ;; table.
  38 ;;
  39 ;; * Faces are used to highlight the background with a color.
  40 ;;   whitespace uses font-lock to highlight blank characters.
  41 ;;
  42 ;; * Display table changes the way a character is displayed, that is,
  43 ;;   it provides a visual mark for characters, for example, at the end
  44 ;;   of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB).
  45 ;;
  46 ;; The `whitespace-style' variable selects which way blanks are
  47 ;; visualized.
  48 ;;
  49 ;; Note that when whitespace is turned on, whitespace saves the
  50 ;; font-lock state, that is, if font-lock is on or off.  And
  51 ;; whitespace restores the font-lock state when it is turned off.  So,
  52 ;; if whitespace is turned on and font-lock is off, whitespace also
  53 ;; turns on the font-lock to highlight blanks, but the font-lock will
  54 ;; be turned off when whitespace is turned off.  Thus, turn on
  55 ;; font-lock before whitespace is on, if you want that font-lock
  56 ;; continues on after whitespace is turned off.
  57 ;;
  58 ;; When whitespace is on, it takes care of highlighting some special
  59 ;; characters over the default mechanism of `nobreak-char-display'
  60 ;; (which see) and `show-trailing-whitespace' (which see).
  61 ;;
  62 ;; The trailing spaces are not highlighted while point is at end of line.
  63 ;; Also the spaces at beginning of buffer are not highlighted while point is at
  64 ;; beginning of buffer; and the spaces at end of buffer are not highlighted
  65 ;; while point is at end of buffer.
  66 ;;
  67 ;; There are two ways of using whitespace: local and global.
  68 ;;
  69 ;; * Local whitespace affects only the current buffer.
  70 ;;
  71 ;; * Global whitespace affects all current and future buffers.  That
  72 ;;   is, if you turn on global whitespace and then create a new
  73 ;;   buffer, the new buffer will also have whitespace on.  The
  74 ;;   `whitespace-global-modes' variable controls which major-mode will
  75 ;;   be automagically turned on.
  76 ;;
  77 ;; You can mix the local and global usage without any conflict.  But
  78 ;; local whitespace has priority over global whitespace.  Whitespace
  79 ;; mode is active in a buffer if you have enabled it in that buffer or
  80 ;; if you have enabled it globally.
  81 ;;
  82 ;; When global and local whitespace are on:
  83 ;;
  84 ;; * if local whitespace is turned off, whitespace is turned off for
  85 ;;   the current buffer only.
  86 ;;
  87 ;; * if global whitespace is turned off, whitespace continues on only
  88 ;;   in the buffers in which local whitespace is on.
  89 ;;
  90 ;; To use whitespace, insert in your ~/.emacs:
  91 ;;
  92 ;;    (require 'whitespace)
  93 ;;
  94 ;; Or autoload at least one of the commands`whitespace-mode',
  95 ;; `whitespace-toggle-options', `global-whitespace-mode' or
  96 ;; `global-whitespace-toggle-options'.  For example:
  97 ;;
  98 ;;    (autoload 'whitespace-mode           "whitespace"
  99 ;;      "Toggle whitespace visualization."        t)
 100 ;;    (autoload 'whitespace-toggle-options "whitespace"
 101 ;;      "Toggle local `whitespace-mode' options." t)
 102 ;;
 103 ;; whitespace was inspired by:
 104 ;;
 105 ;;    whitespace.el            Rajesh Vaidheeswarran <rv@gnu.org>
 106 ;;      Warn about and clean bogus whitespaces in the file
 107 ;;      (inspired the idea to warn and clean some blanks)
 108 ;;      This was the original `whitespace.el' which was replaced by
 109 ;;      `blank-mode.el'.  And later `blank-mode.el' was renamed to
 110 ;;      `whitespace.el'.
 111 ;;
 112 ;;    show-whitespace-mode.el  Aurelien Tisne <aurelien.tisne@free.fr>
 113 ;;       Simple mode to highlight whitespaces
 114 ;;       (inspired the idea to use font-lock)
 115 ;;
 116 ;;    whitespace-mode.el       Lawrence Mitchell <wence@gmx.li>
 117 ;;       Major mode for editing Whitespace
 118 ;;       (inspired the idea to use display table)
 119 ;;
 120 ;;    visws.el                 Miles Bader <miles@gnu.org>
 121 ;;       Make whitespace visible
 122 ;;       (handle display table, his code was modified, but the main
 123 ;;       idea was kept)
 124 ;;
 125 ;;
 126 ;; Using whitespace
 127 ;; ----------------
 128 ;;
 129 ;; There is no problem if you mix local and global minor mode usage.
 130 ;;
 131 ;; * LOCAL whitespace:
 132 ;;    + To toggle whitespace options locally, type:
 133 ;;
 134 ;;         M-x whitespace-toggle-options RET
 135 ;;
 136 ;;    + To activate whitespace locally, type:
 137 ;;
 138 ;;         C-u 1 M-x whitespace-mode RET
 139 ;;
 140 ;;    + To deactivate whitespace locally, type:
 141 ;;
 142 ;;         C-u 0 M-x whitespace-mode RET
 143 ;;
 144 ;;    + To toggle whitespace locally, type:
 145 ;;
 146 ;;         M-x whitespace-mode RET
 147 ;;
 148 ;; * GLOBAL whitespace:
 149 ;;    + To toggle whitespace options globally, type:
 150 ;;
 151 ;;         M-x global-whitespace-toggle-options RET
 152 ;;
 153 ;;    + To activate whitespace globally, type:
 154 ;;
 155 ;;         C-u 1 M-x global-whitespace-mode RET
 156 ;;
 157 ;;    + To deactivate whitespace globally, type:
 158 ;;
 159 ;;         C-u 0 M-x global-whitespace-mode RET
 160 ;;
 161 ;;    + To toggle whitespace globally, type:
 162 ;;
 163 ;;         M-x global-whitespace-mode RET
 164 ;;
 165 ;; There are also the following useful commands:
 166 ;;
 167 ;; `whitespace-newline-mode'
 168 ;;    Toggle NEWLINE minor mode visualization ("nl" on mode line).
 169 ;;
 170 ;; `global-whitespace-newline-mode'
 171 ;;    Toggle NEWLINE global minor mode visualization ("NL" on mode line).
 172 ;;
 173 ;; `whitespace-report'
 174 ;;    Report some blank problems in buffer.
 175 ;;
 176 ;; `whitespace-report-region'
 177 ;;    Report some blank problems in a region.
 178 ;;
 179 ;; `whitespace-cleanup'
 180 ;;    Cleanup some blank problems in all buffer or at region.
 181 ;;    See the function's docstring for more information.
 182 ;;
 183 ;; `whitespace-cleanup-region'
 184 ;;    Cleanup some blank problems at region.
 185 ;;
 186 ;;
 187 ;; Options
 188 ;; -------
 189 ;;
 190 ;; Whitespace's behavior can be changed with `M-x customize-group
 191 ;; whitespace', which see for the full list of options.
 192 ;;
 193 ;;
 194 ;; Hooks
 195 ;; -----
 196 ;;
 197 ;; whitespace has the following hook variables:
 198 ;;
 199 ;; `whitespace-mode-hook'
 200 ;;    It is evaluated always when whitespace is turned on locally.
 201 ;;
 202 ;; `global-whitespace-mode-hook'
 203 ;;    It is evaluated always when whitespace is turned on globally.
 204 ;;
 205 ;; `whitespace-load-hook'
 206 ;;    It is evaluated after whitespace package is loaded.
 207 ;;
 208 ;;
 209 ;; Acknowledgments
 210 ;; ---------------
 211 ;;
 212 ;; Thanks to felix (EmacsWiki) for keeping highlight when switching between
 213 ;; major modes on a file.
 214 ;;
 215 ;; Thanks to David Reitter <david.reitter@gmail.com> for suggesting a
 216 ;; `whitespace-newline' initialization with low contrast relative to
 217 ;; the background color.
 218 ;;
 219 ;; Thanks to Stephen Deasey <sdeasey@gmail.com> for the
 220 ;; `indent-tabs-mode' usage suggestion.
 221 ;;
 222 ;; Thanks to Eric Cooper <ecc@cmu.edu> for the suggestion to have hook
 223 ;; actions when buffer is written as the original whitespace package
 224 ;; had.
 225 ;;
 226 ;; Thanks to nschum (EmacsWiki) for the idea about highlight "long"
 227 ;; lines tail.  See EightyColumnRule (EmacsWiki).
 228 ;;
 229 ;; Thanks to Juri Linkov <juri@jurta.org> for suggesting:
 230 ;;    * `define-minor-mode'.
 231 ;;    * `global-whitespace-*' name for global commands.
 232 ;;
 233 ;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing.
 234 ;;
 235 ;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands
 236 ;; suggestion.
 237 ;;
 238 ;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for
 239 ;; helping to fix `find-file-hooks' reference.
 240 ;;
 241 ;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for
 242 ;; indicating defface byte-compilation warnings.
 243 ;;
 244 ;; Thanks to Tim O'Callaghan (EmacsWiki) for the idea about highlight
 245 ;; "long" lines.  See EightyColumnRule (EmacsWiki).
 246 ;;
 247 ;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new
 248 ;; NEWLINE character mapping.
 249 ;;
 250 ;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating
 251 ;; whitespace-mode.el on XEmacs.
 252 ;;
 253 ;; Thanks to Miles Bader <miles@gnu.org> for handling display table via
 254 ;; visws.el (his code was modified, but the main idea was kept).
 255 ;;
 256 ;; Thanks to:
 257 ;;    Rajesh Vaidheeswarran <rv@gnu.org>        (original) whitespace.el
 258 ;;    Aurelien Tisne <aurelien.tisne@free.fr>   show-whitespace-mode.el
 259 ;;    Lawrence Mitchell <wence@gmx.li>          whitespace-mode.el
 260 ;;    Miles Bader <miles@gnu.org>               visws.el
 261 ;; And to all people who contributed with them.
 262 ;;
 263 ;;
 264 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 265
 266 ;;; code:
 267
 268 \f
 269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 270 ;;;; User Variables:
 271
 272
 273 ;;; Interface to the command system
 274
 275
 276 (defgroup whitespace nil
 277   "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
 278   :link '(emacs-library-link :tag "Source Lisp File" "whitespace.el")
 279   :version "23.1"
 280   :group 'convenience)
 281
 282
 283 (defcustom whitespace-style
 284   '(face
 285     tabs spaces trailing lines space-before-tab newline
 286     indentation empty space-after-tab
 287     space-mark tab-mark newline-mark)
 288   "Specify which kind of blank is visualized.
 289
 290 It's a list containing some or all of the following values:
 291
 292    face                 enable all visualization via faces (see below).
 293
 294    trailing             trailing blanks are visualized via faces.
 295                         It has effect only if `face' (see above)
 296                         is present in `whitespace-style'.
 297
 298    tabs                 TABs are visualized via faces.
 299                         It has effect only if `face' (see above)
 300                         is present in `whitespace-style'.
 301
 302    spaces               SPACEs and HARD SPACEs are visualized via
 303                         faces.
 304                         It has effect only if `face' (see above)
 305                         is present in `whitespace-style'.
 306
 307    lines                lines which have columns beyond
 308                         `whitespace-line-column' are highlighted via
 309                         faces.
 310                         Whole line is highlighted.
 311                         It has precedence over `lines-tail' (see
 312                         below).
 313                         It has effect only if `face' (see above)
 314                         is present in `whitespace-style'.
 315
 316    lines-tail           lines which have columns beyond
 317                         `whitespace-line-column' are highlighted via
 318                         faces.
 319                         But only the part of line which goes
 320                         beyond `whitespace-line-column' column.
 321                         It has effect only if `lines' (see above)
 322                         is not present in `whitespace-style'
 323                         and if `face' (see above) is present in
 324                         `whitespace-style'.
 325
 326    newline              NEWLINEs are visualized via faces.
 327                         It has effect only if `face' (see above)
 328                         is present in `whitespace-style'.
 329
 330    empty                empty lines at beginning and/or end of buffer
 331                         are visualized via faces.
 332                         It has effect only if `face' (see above)
 333                         is present in `whitespace-style'.
 334
 335    indentation::tab     `tab-width' or more SPACEs at beginning of line
 336                         are visualized via faces.
 337                         It has effect only if `face' (see above)
 338                         is present in `whitespace-style'.
 339
 340    indentation::space   TABs at beginning of line are visualized via
 341                         faces.
 342                         It has effect only if `face' (see above)
 343                         is present in `whitespace-style'.
 344
 345    indentation          `tab-width' or more SPACEs at beginning of line
 346                         are visualized, if `indent-tabs-mode' (which
 347                         see) is non-nil; otherwise, TABs at beginning
 348                         of line are visualized via faces.
 349                         It has effect only if `face' (see above)
 350                         is present in `whitespace-style'.
 351
 352    big-indent           Big indentations are visualized via faces.
 353                         It has effect only if `face' (see above)
 354                         is present in `whitespace-style'.
 355
 356    space-after-tab::tab         `tab-width' or more SPACEs after a TAB
 357                                 are visualized via faces.
 358                                 It has effect only if `face' (see above)
 359                                 is present in `whitespace-style'.
 360
 361    space-after-tab::space       TABs are visualized when `tab-width' or
 362                                 more SPACEs occur after a TAB, via
 363                                 faces.
 364                                 It has effect only if `face' (see above)
 365                                 is present in `whitespace-style'.
 366
 367    space-after-tab              `tab-width' or more SPACEs after a TAB
 368                                 are visualized, if `indent-tabs-mode'
 369                                 (which see) is non-nil; otherwise,
 370                                 the TABs are visualized via faces.
 371                                 It has effect only if `face' (see above)
 372                                 is present in `whitespace-style'.
 373
 374    space-before-tab::tab        SPACEs before TAB are visualized via
 375                                 faces.
 376                                 It has effect only if `face' (see above)
 377                                 is present in `whitespace-style'.
 378
 379    space-before-tab::space      TABs are visualized when SPACEs occur
 380                                 before TAB, via faces.
 381                                 It has effect only if `face' (see above)
 382                                 is present in `whitespace-style'.
 383
 384    space-before-tab             SPACEs before TAB are visualized, if
 385                                 `indent-tabs-mode' (which see) is
 386                                 non-nil; otherwise, the TABs are
 387                                 visualized via faces.
 388                                 It has effect only if `face' (see above)
 389                                 is present in `whitespace-style'.
 390
 391    space-mark           SPACEs and HARD SPACEs are visualized via
 392                         display table.
 393
 394    tab-mark             TABs are visualized via display table.
 395
 396    newline-mark         NEWLINEs are visualized via display table.
 397
 398 Any other value is ignored.
 399
 400 If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs via faces and
 401 via display table.
 402
 403 There is an evaluation order for some values, if they are
 404 included in `whitespace-style' list.  For example, if
 405 indentation, indentation::tab and/or indentation::space are
 406 included in `whitespace-style' list.  The evaluation order for
 407 these values is:
 408
 409  * For indentation:
 410    1. indentation
 411    2. indentation::tab
 412    3. indentation::space
 413
 414  * For SPACEs after TABs:
 415    1. space-after-tab
 416    2. space-after-tab::tab
 417    3. space-after-tab::space
 418
 419  * For SPACEs before TABs:
 420    1. space-before-tab
 421    2. space-before-tab::tab
 422    3. space-before-tab::space
 423
 424 For example, if `indentation' and `indentation::space' are
 425 included in `whitespace-style', the `indentation' value is used
 426 instead of the `indentation::space' value.
 427
 428 One reason to not use faces to visualize spaces (i.e., not
 429 include `face' in `whitespace-style') is to use `whitespace-mode'
 430 only for cleaning up a buffer.  See `whitespace-cleanup' and
 431 `whitespace-cleanup-region'.
 432
 433 See also `whitespace-display-mappings' for documentation."
 434   :type '(set :tag "Kind of Blank"
 435               (const :tag "(Face) Face visualization" face)
 436               (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
 437                      trailing)
 438               (const :tag "(Face) TABs" tabs)
 439               (const :tag "(Face) SPACEs and HARD SPACEs" spaces)
 440               (const :tag "(Face) Lines" lines)
 441               (const :tag "(Face) Lines, only overlong part" lines-tail)
 442               (const :tag "(Face) NEWLINEs" newline)
 443               (const :tag "(Face) Empty Lines At BOB And/Or EOB" empty)
 444               (const :tag "(Face) Indentation SPACEs" indentation::tab)
 445               (const :tag "(Face) Indentation TABs"
 446                      indentation::space)
 447               (const :tag "(Face) Indentation TABs or SPACEs" indentation)
 448               (const :tag "(Face) Too much line indentation" big-indent)
 449               (const :tag "(Face) SPACEs after TAB: SPACEs"
 450                      space-after-tab::tab)
 451               (const :tag "(Face) SPACEs after TAB: TABs"
 452                      space-after-tab::space)
 453               (const :tag "(Face) SPACEs after TAB" space-after-tab)
 454               (const :tag "(Face) SPACEs before TAB: SPACEs"
 455                      space-before-tab::tab)
 456               (const :tag "(Face) SPACEs before TAB: TABs"
 457                      space-before-tab::space)
 458               (const :tag "(Face) SPACEs before TAB" space-before-tab)
 459               (const :tag "(Mark) SPACEs and HARD SPACEs" space-mark)
 460               (const :tag "(Mark) TABs" tab-mark)
 461               (const :tag "(Mark) NEWLINEs" newline-mark))
 462   :group 'whitespace)
 463
 464 (defvar whitespace-space 'whitespace-space
 465   "Symbol face used to visualize SPACE.
 466 Used when `whitespace-style' includes the value `spaces'.")
 467 (make-obsolete-variable 'whitespace-space "use the face instead." "24.4")
 468
 469
 470 (defface whitespace-space
 471   '((((class color) (background dark))
 472      :background "grey20"      :foreground "darkgray")
 473     (((class color) (background light))
 474      :background "LightYellow" :foreground "lightgray")
 475     (t :inverse-video t))
 476   "Face used to visualize SPACE."
 477   :group 'whitespace)
 478
 479
 480 (defvar whitespace-hspace 'whitespace-hspace
 481   "Symbol face used to visualize HARD SPACE.
 482 Used when `whitespace-style' includes the value `spaces'.")
 483 (make-obsolete-variable 'whitespace-hspace "use the face instead." "24.4")
 484
 485 (defface whitespace-hspace              ; 'nobreak-space
 486   '((((class color) (background dark))
 487      :background "grey24"        :foreground "darkgray")
 488     (((class color) (background light))
 489      :background "LemonChiffon3" :foreground "lightgray")
 490     (t :inverse-video t))
 491   "Face used to visualize HARD SPACE."
 492   :group 'whitespace)
 493
 494
 495 (defvar whitespace-tab 'whitespace-tab
 496   "Symbol face used to visualize TAB.
 497 Used when `whitespace-style' includes the value `tabs'.")
 498 (make-obsolete-variable 'whitespace-tab "use the face instead." "24.4")
 499
 500 (defface whitespace-tab
 501   '((((class color) (background dark))
 502      :background "grey22" :foreground "darkgray")
 503     (((class color) (background light))
 504      :background "beige"  :foreground "lightgray")
 505     (t :inverse-video t))
 506   "Face used to visualize TAB."
 507   :group 'whitespace)
 508
 509
 510 (defvar whitespace-newline 'whitespace-newline
 511   "Symbol face used to visualize NEWLINE char mapping.
 512 See `whitespace-display-mappings'.
 513 Used when `whitespace-style' includes the values `newline-mark'
 514 and `newline'.")
 515 (make-obsolete-variable 'whitespace-newline "use the face instead." "24.4")
 516
 517 (defface whitespace-newline
 518   '((default :weight normal)
 519     (((class color) (background dark)) :foreground "darkgray")
 520     (((class color) (min-colors 88) (background light)) :foreground "lightgray")
 521     ;; Displays with 16 colors use lightgray as background, so using a
 522     ;; lightgray foreground makes the newline mark invisible.
 523     (((class color) (background light)) :foreground "brown")
 524     (t :underline t))
 525   "Face used to visualize NEWLINE char mapping.
 526
 527 See `whitespace-display-mappings'."
 528   :group 'whitespace)
 529
 530
 531 (defvar whitespace-trailing 'whitespace-trailing
 532   "Symbol face used to visualize trailing blanks.
 533 Used when `whitespace-style' includes the value `trailing'.")
 534 (make-obsolete-variable 'whitespace-trailing "use the face instead." "24.4")
 535
 536 (defface whitespace-trailing            ; 'trailing-whitespace
 537   '((default :weight bold)
 538     (((class mono)) :inverse-video t :underline t)
 539     (t :background "red1" :foreground "yellow"))
 540   "Face used to visualize trailing blanks."
 541   :group 'whitespace)
 542
 543
 544 (defvar whitespace-line 'whitespace-line
 545   "Symbol face used to visualize \"long\" lines.
 546 See `whitespace-line-column'.
 547 Used when `whitespace-style' includes the value `line'.")
 548 (make-obsolete-variable 'whitespace-line "use the face instead." "24.4")
 549
 550 (defface whitespace-line
 551   '((((class mono)) :inverse-video t :weight bold :underline t)
 552     (t :background "gray20" :foreground "violet"))
 553   "Face used to visualize \"long\" lines.
 554
 555 See `whitespace-line-column'."
 556   :group 'whitespace)
 557
 558
 559 (defvar whitespace-space-before-tab 'whitespace-space-before-tab
 560   "Symbol face used to visualize SPACEs before TAB.
 561 Used when `whitespace-style' includes the value `space-before-tab'.")
 562 (make-obsolete-variable 'whitespace-space-before-tab
 563                         "use the face instead." "24.4")
 564
 565 (defface whitespace-space-before-tab
 566   '((((class mono)) :inverse-video t :weight bold :underline t)
 567     (t :background "DarkOrange" :foreground "firebrick"))
 568   "Face used to visualize SPACEs before TAB."
 569   :group 'whitespace)
 570
 571
 572 (defvar whitespace-indentation 'whitespace-indentation
 573   "Symbol face used to visualize `tab-width' or more SPACEs at beginning of
 574 line.  Used when `whitespace-style' includes the value `indentation'.")
 575 (make-obsolete-variable 'whitespace-indentation "use the face instead." "24.4")
 576
 577 (defface whitespace-indentation
 578   '((((class mono)) :inverse-video t :weight bold :underline t)
 579     (t :background "yellow" :foreground "firebrick"))
 580   "Face used to visualize `tab-width' or more SPACEs at beginning of line."
 581   :group 'whitespace)
 582
 583 (defface whitespace-big-indent
 584   '((((class mono)) :inverse-video t :weight bold :underline t)
 585     (t :background "red" :foreground "firebrick"))
 586   "Face used to visualize big indentation."
 587   :group 'whitespace)
 588
 589
 590 (defvar whitespace-empty 'whitespace-empty
 591   "Symbol face used to visualize empty lines at beginning and/or end of buffer.
 592 Used when `whitespace-style' includes the value `empty'.")
 593 (make-obsolete-variable 'whitespace-empty "use the face instead." "24.4")
 594
 595 (defface whitespace-empty
 596   '((((class mono)) :inverse-video t :weight bold :underline t)
 597     (t :background "yellow" :foreground "firebrick"))
 598   "Face used to visualize empty lines at beginning and/or end of buffer."
 599   :group 'whitespace)
 600
 601
 602 (defvar whitespace-space-after-tab 'whitespace-space-after-tab
 603   "Symbol face used to visualize `tab-width' or more SPACEs after TAB.
 604 Used when `whitespace-style' includes the value `space-after-tab'.")
 605 (make-obsolete-variable 'whitespace-space-after-tab
 606                         "use the face instead." "24.4")
 607
 608 (defface whitespace-space-after-tab
 609   '((((class mono)) :inverse-video t :weight bold :underline t)
 610     (t :background "yellow" :foreground "firebrick"))
 611   "Face used to visualize `tab-width' or more SPACEs after TAB."
 612   :group 'whitespace)
 613
 614
 615 (defcustom whitespace-hspace-regexp
 616   "\\(\u00A0+\\)"
 617   "Specify HARD SPACE characters regexp.
 618
 619 Here are some examples:
 620
 621    \"\\\\(^\\xA0+\\\\)\"                \
 622 visualize only leading HARD SPACEs.
 623    \"\\\\(\\xA0+$\\\\)\"                \
 624 visualize only trailing HARD SPACEs.
 625    \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\"    \
 626 visualize leading and/or trailing HARD SPACEs.
 627    \"\\t\\\\(\\xA0+\\\\)\\t\"           \
 628 visualize only HARD SPACEs between TABs.
 629
 630 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 631       Use exactly one pair of enclosing \\\\( and \\\\).
 632
 633 Used when `whitespace-style' includes `spaces'."
 634   :type '(regexp :tag "HARD SPACE Chars")
 635   :group 'whitespace)
 636
 637
 638 (defcustom whitespace-space-regexp "\\( +\\)"
 639   "Specify SPACE characters regexp.
 640
 641 If you're using `mule' package, there may be other characters
 642 besides \" \" that should be considered SPACE.
 643
 644 Here are some examples:
 645
 646    \"\\\\(^ +\\\\)\"            visualize only leading SPACEs.
 647    \"\\\\( +$\\\\)\"            visualize only trailing SPACEs.
 648    \"\\\\(^ +\\\\| +$\\\\)\"    \
 649 visualize leading and/or trailing SPACEs.
 650    \"\\t\\\\( +\\\\)\\t\"       visualize only SPACEs between TABs.
 651
 652 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 653       Use exactly one pair of enclosing \\\\( and \\\\).
 654
 655 Used when `whitespace-style' includes `spaces'."
 656   :type '(regexp :tag "SPACE Chars")
 657   :group 'whitespace)
 658
 659
 660 (defcustom whitespace-tab-regexp "\\(\t+\\)"
 661   "Specify TAB characters regexp.
 662
 663 If you're using `mule' package, there may be other characters
 664 besides \"\\t\" that should be considered TAB.
 665
 666 Here are some examples:
 667
 668    \"\\\\(^\\t+\\\\)\"          visualize only leading TABs.
 669    \"\\\\(\\t+$\\\\)\"          visualize only trailing TABs.
 670    \"\\\\(^\\t+\\\\|\\t+$\\\\)\"        \
 671 visualize leading and/or trailing TABs.
 672    \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
 673
 674 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 675       Use exactly one pair of enclosing \\\\( and \\\\).
 676
 677 Used when `whitespace-style' includes `tabs'."
 678   :type '(regexp :tag "TAB Chars")
 679   :group 'whitespace)
 680
 681
 682 (defcustom whitespace-trailing-regexp
 683   "\\([\t \u00A0]+\\)$"
 684   "Specify trailing characters regexp.
 685
 686 There may be other characters besides:
 687
 688    \" \"  \"\\t\"  \"\\u00A0\"
 689
 690 that should be considered blank.
 691
 692 NOTE: Enclose always by \"\\\\(\" and \"\\\\)$\" the elements to highlight.
 693       Use exactly one pair of enclosing elements above.
 694
 695 Used when `whitespace-style' includes `trailing'."
 696   :type '(regexp :tag "Trailing Chars")
 697   :group 'whitespace)
 698
 699
 700 (defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)"
 701   "Specify SPACEs before TAB regexp.
 702
 703 Used when `whitespace-style' includes `space-before-tab',
 704 `space-before-tab::tab' or  `space-before-tab::space'."
 705   :type '(regexp :tag "SPACEs Before TAB")
 706   :group 'whitespace)
 707
 708
 709 (defcustom whitespace-indentation-regexp
 710   '("^\t*\\(\\( \\{%d\\}\\)+\\)[^\n\t]"
 711     . "^ *\\(\t+\\)[^\n]")
 712   "Specify regexp for `tab-width' or more SPACEs at beginning of line.
 713
 714 It is a cons where the cons car is used for SPACEs visualization
 715 and the cons cdr is used for TABs visualization.
 716
 717 Used when `whitespace-style' includes `indentation',
 718 `indentation::tab' or  `indentation::space'."
 719   :type '(cons (string :tag "Indentation SPACEs")
 720                (string :tag "Indentation TABs"))
 721   :group 'whitespace)
 722
 723
 724 (defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
 725   "Specify regexp for empty lines at beginning of buffer.
 726
 727 Used when `whitespace-style' includes `empty'."
 728   :type '(regexp :tag "Empty Lines At Beginning Of Buffer")
 729   :group 'whitespace)
 730
 731
 732 (defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]*\\(\n\\{2,\\}\\|[ \t]+\\)\\)\\'"
 733   "Specify regexp for empty lines at end of buffer.
 734
 735 Used when `whitespace-style' includes `empty'."
 736   :type '(regexp :tag "Empty Lines At End Of Buffer")
 737   :group 'whitespace)
 738
 739
 740 (defcustom whitespace-space-after-tab-regexp
 741   '("\t+\\(\\( \\{%d,\\}\\)+\\)"
 742     . "\\(\t+\\) \\{%d,\\}")
 743   "Specify regexp for `tab-width' or more SPACEs after TAB.
 744
 745 It is a cons where the cons car is used for SPACEs visualization
 746 and the cons cdr is used for TABs visualization.
 747
 748 Used when `whitespace-style' includes `space-after-tab',
 749 `space-after-tab::tab' or `space-after-tab::space'."
 750   :type '(cons (string :tag "SPACEs After TAB")
 751                string)
 752   :group 'whitespace)
 753
 754 (defcustom whitespace-big-indent-regexp
 755   "^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)"
 756   "Specify big indentation regexp.
 757
 758 If you're using `mule' package, there may be other characters
 759 besides \"\\t\" that should be considered TAB.
 760
 761 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 762       Use exactly one pair of enclosing \\\\( and \\\\).
 763
 764 Used when `whitespace-style' includes `big-indent'."
 765   :version "25.1"
 766   :type '(regexp :tag "Detect too much indentation at the beginning of a line")
 767   :group 'whitespace)
 768
 769
 770 (defcustom whitespace-line-column 80
 771   "Specify column beyond which the line is highlighted.
 772
 773 It must be an integer or nil.  If nil, the `fill-column' variable value is
 774 used.
 775
 776 Used when `whitespace-style' includes `lines' or `lines-tail'."
 777   :type '(choice :tag "Line Length Limit"
 778                  (integer :tag "Line Length")
 779                  (const :tag "Use fill-column" nil))
 780   :safe  'integerp
 781   :group 'whitespace)
 782
 783
 784 ;; Hacked from `visible-whitespace-mappings' in visws.el
 785 (defcustom whitespace-display-mappings
 786   '(
 787     (space-mark   ?\     [?·]     [?.])                ; space - middle dot
 788     (space-mark   ?\xA0  [?¤]     [?_])                ; hard space - currency sign
 789     ;; NEWLINE is displayed using the face `whitespace-newline'
 790     (newline-mark ?\n    [?$ ?\n])                      ; eol - dollar sign
 791     ;; (newline-mark ?\n    [?↵ ?\n] [?$ ?\n])        ; eol - downwards arrow
 792     ;; (newline-mark ?\n    [?¶ ?\n] [?$ ?\n]) ; eol - pilcrow
 793     ;; (newline-mark ?\n    [?¯ ?\n]  [?$ ?\n])        ; eol - overscore
 794     ;; (newline-mark ?\n    [?¬ ?\n]  [?$ ?\n])        ; eol - negation
 795     ;; (newline-mark ?\n    [?° ?\n]  [?$ ?\n])        ; eol - degrees
 796     ;;
 797     ;; WARNING: the mapping below has a problem.
 798     ;; When a TAB occupies exactly one column, it will display the
 799     ;; character ?\xBB at that column followed by a TAB which goes to
 800     ;; the next TAB column.
 801     ;; If this is a problem for you, please, comment the line below.
 802     (tab-mark     ?\t    [?» ?\t] [?\\ ?\t])   ; tab - right guillemet
 803     )
 804   "Specify an alist of mappings for displaying characters.
 805
 806 Each element has the following form:
 807
 808    (KIND CHAR VECTOR...)
 809
 810 Where:
 811
 812 KIND    is the kind of character.
 813         It can be one of the following symbols:
 814
 815         tab-mark        for TAB character
 816
 817         space-mark      for SPACE or HARD SPACE character
 818
 819         newline-mark    for NEWLINE character
 820
 821 CHAR    is the character to be mapped.
 822
 823 VECTOR  is a vector of characters to be displayed in place of CHAR.
 824         The first display vector that can be displayed is used;
 825         if no display vector for a mapping can be displayed, then
 826         that character is displayed unmodified.
 827
 828 The NEWLINE character is displayed using the face given by
 829 `whitespace-newline' variable.
 830
 831 Used when `whitespace-style' includes `tab-mark', `space-mark' or
 832 `newline-mark'."
 833   :type '(repeat
 834           (list :tag "Character Mapping"
 835                 (choice :tag "Char Kind"
 836                         (const :tag "Tab" tab-mark)
 837                         (const :tag "Space" space-mark)
 838                         (const :tag "Newline" newline-mark))
 839                 (character :tag "Char")
 840                 (repeat :inline t :tag "Vector List"
 841                         (vector :tag ""
 842                                 (repeat :inline t
 843                                         :tag "Vector Characters"
 844                                         (character :tag "Char"))))))
 845   :group 'whitespace)
 846
 847
 848 (defcustom whitespace-global-modes t
 849   "Modes for which global `whitespace-mode' is automagically turned on.
 850
 851 Global `whitespace-mode' is controlled by the command
 852 `global-whitespace-mode'.
 853
 854 If nil, means no modes have `whitespace-mode' automatically
 855 turned on.
 856
 857 If t, all modes that support `whitespace-mode' have it
 858 automatically turned on.
 859
 860 Else it should be a list of `major-mode' symbol names for which
 861 `whitespace-mode' should be automatically turned on.  The sense
 862 of the list is negated if it begins with `not'.  For example:
 863
 864    (c-mode c++-mode)
 865
 866 means that `whitespace-mode' is turned on for buffers in C and
 867 C++ modes only."
 868   :type '(choice :tag "Global Modes"
 869                  (const :tag "None" nil)
 870                  (const :tag "All" t)
 871                  (set :menu-tag "Mode Specific" :tag "Modes"
 872                       :value (not)
 873                       (const :tag "Except" not)
 874                       (repeat :inline t
 875                               (symbol :tag "Mode"))))
 876   :group 'whitespace)
 877
 878
 879 (defcustom whitespace-action nil
 880   "Specify which action is taken when a buffer is visited or written.
 881
 882 It's a list containing some or all of the following values:
 883
 884    nil                  no action is taken.
 885
 886    cleanup              cleanup any bogus whitespace always when local
 887                         whitespace is turned on.
 888                         See `whitespace-cleanup' and
 889                         `whitespace-cleanup-region'.
 890
 891    report-on-bogus      report if there is any bogus whitespace always
 892                         when local whitespace is turned on.
 893
 894    auto-cleanup         cleanup any bogus whitespace when buffer is
 895                         written.
 896                         See `whitespace-cleanup' and
 897                         `whitespace-cleanup-region'.
 898
 899    abort-on-bogus       abort if there is any bogus whitespace and the
 900                         buffer is written.
 901
 902    warn-if-read-only    give a warning if `cleanup' or `auto-cleanup'
 903                         is included in `whitespace-action' and the
 904                         buffer is read-only.
 905
 906 Any other value is treated as nil."
 907   :type '(choice :tag "Actions"
 908                  (const :tag "None" nil)
 909                  (repeat :tag "Action List"
 910                   (choice :tag "Action"
 911                           (const :tag "Cleanup When On" cleanup)
 912                           (const :tag "Report On Bogus" report-on-bogus)
 913                           (const :tag "Auto Cleanup" auto-cleanup)
 914                           (const :tag "Abort On Bogus" abort-on-bogus)
 915                           (const :tag "Warn If Read-Only" warn-if-read-only))))
 916   :group 'whitespace)
 917
 918 \f
 919 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 920 ;;;; User commands - Local mode
 921
 922
 923 ;;;###autoload
 924 (define-minor-mode whitespace-mode
 925   "Toggle whitespace visualization (Whitespace mode).
 926 With a prefix argument ARG, enable Whitespace mode if ARG is
 927 positive, and disable it otherwise.
 928
 929 If called from Lisp, also enables the mode if ARG is omitted or nil,
 930 and toggles it if ARG is `toggle'.
 931
 932 See also `whitespace-style', `whitespace-newline' and
 933 `whitespace-display-mappings'."
 934   :lighter    " ws"
 935   :init-value nil
 936   :global     nil
 937   :group      'whitespace
 938   (cond
 939    (noninteractive                      ; running a batch job
 940     (setq whitespace-mode nil))
 941    (whitespace-mode                     ; whitespace-mode on
 942     (whitespace-turn-on)
 943     (whitespace-action-when-on))
 944    (t                                   ; whitespace-mode off
 945     (whitespace-turn-off))))
 946
 947
 948 ;;;###autoload
 949 (define-minor-mode whitespace-newline-mode
 950   "Toggle newline visualization (Whitespace Newline mode).
 951 With a prefix argument ARG, enable Whitespace Newline mode if ARG
 952 is positive, and disable it otherwise.
 953
 954 If called from Lisp, also enables the mode if ARG is omitted or nil,
 955 and toggles it if ARG is `toggle'.
 956
 957 Use `whitespace-newline-mode' only for NEWLINE visualization
 958 exclusively.  For other visualizations, including NEWLINE
 959 visualization together with (HARD) SPACEs and/or TABs, please,
 960 use `whitespace-mode'.
 961
 962 See also `whitespace-newline' and `whitespace-display-mappings'."
 963   :lighter    " nl"
 964   :init-value nil
 965   :global     nil
 966   :group      'whitespace
 967   (let ((whitespace-style '(face newline-mark newline)))
 968     (whitespace-mode (if whitespace-newline-mode
 969                          1 -1)))
 970   ;; sync states (running a batch job)
 971   (setq whitespace-newline-mode whitespace-mode))
 972
 973 \f
 974 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 975 ;;;; User commands - Global mode
 976
 977
 978 ;;;###autoload
 979 (define-minor-mode global-whitespace-mode
 980   "Toggle whitespace visualization globally (Global Whitespace mode).
 981 With a prefix argument ARG, enable Global Whitespace mode if ARG
 982 is positive, and disable it otherwise.
 983
 984 If called from Lisp, also enables the mode if ARG is omitted or nil,
 985 and toggles it if ARG is `toggle'.
 986
 987 See also `whitespace-style', `whitespace-newline' and
 988 `whitespace-display-mappings'."
 989   :lighter    " WS"
 990   :init-value nil
 991   :global     t
 992   :group      'whitespace
 993   (cond
 994    (noninteractive                      ; running a batch job
 995     (setq global-whitespace-mode nil))
 996    (global-whitespace-mode              ; global-whitespace-mode on
 997     (save-current-buffer
 998       (add-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
 999       (add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
1000       (dolist (buffer (buffer-list))    ; adjust all local mode
1001         (set-buffer buffer)
1002         (unless whitespace-mode
1003           (whitespace-turn-on-if-enabled)))))
1004    (t                                   ; global-whitespace-mode off
1005     (save-current-buffer
1006       (remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
1007       (remove-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
1008       (dolist (buffer (buffer-list))    ; adjust all local mode
1009         (set-buffer buffer)
1010         (unless whitespace-mode
1011           (whitespace-turn-off)))))))
1012
1013 (defvar whitespace-enable-predicate
1014   (lambda ()
1015     (and (cond
1016           ((eq whitespace-global-modes t))
1017           ((listp whitespace-global-modes)
1018            (if (eq (car-safe whitespace-global-modes) 'not)
1019                (not (memq major-mode (cdr whitespace-global-modes)))
1020              (memq major-mode whitespace-global-modes)))
1021           (t nil))
1022          ;; ...we have a display (not running a batch job)
1023          (not noninteractive)
1024          ;; ...the buffer is not internal (name starts with a space)
1025          (not (eq (aref (buffer-name) 0) ?\ ))
1026          ;; ...the buffer is not special (name starts with *)
1027          (or (not (eq (aref (buffer-name) 0) ?*))
1028              ;; except the scratch buffer.
1029              (string= (buffer-name) "*scratch*"))))
1030   "Predicate to decide which buffers obey `global-whitespace-mode'.
1031 This function is called with no argument and should return non-nil
1032 if the current buffer should obey `global-whitespace-mode'.
1033 This variable is normally modified via `add-function'.")
1034
1035 (defun whitespace-turn-on-if-enabled ()
1036   (when (funcall whitespace-enable-predicate)
1037     (whitespace-turn-on)))
1038
1039 ;;;###autoload
1040 (define-minor-mode global-whitespace-newline-mode
1041   "Toggle global newline visualization (Global Whitespace Newline mode).
1042 With a prefix argument ARG, enable Global Whitespace Newline mode
1043 if ARG is positive, and disable it otherwise.
1044
1045 If called from Lisp, also enables the mode if ARG is omitted or nil,
1046 and toggles it if ARG is `toggle'.
1047
1048 Use `global-whitespace-newline-mode' only for NEWLINE
1049 visualization exclusively.  For other visualizations, including
1050 NEWLINE visualization together with (HARD) SPACEs and/or TABs,
1051 please use `global-whitespace-mode'.
1052
1053 See also `whitespace-newline' and `whitespace-display-mappings'."
1054   :lighter    " NL"
1055   :init-value nil
1056   :global     t
1057   :group      'whitespace
1058   (let ((whitespace-style '(newline-mark newline)))
1059     (global-whitespace-mode (if global-whitespace-newline-mode
1060                                 1 -1))
1061     ;; sync states (running a batch job)
1062     (setq global-whitespace-newline-mode global-whitespace-mode)))
1063
1064 \f
1065 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1066 ;;;; User commands - Toggle
1067
1068
1069 (defconst whitespace-style-value-list
1070   '(face
1071     tabs
1072     spaces
1073     trailing
1074     lines
1075     lines-tail
1076     newline
1077     empty
1078     indentation
1079     indentation::tab
1080     indentation::space
1081     big-indent
1082     space-after-tab
1083     space-after-tab::tab
1084     space-after-tab::space
1085     space-before-tab
1086     space-before-tab::tab
1087     space-before-tab::space
1088     help-newline       ; value used by `whitespace-insert-option-mark'
1089     tab-mark
1090     space-mark
1091     newline-mark
1092     )
1093   "List of valid `whitespace-style' values.")
1094
1095
1096 (defconst whitespace-toggle-option-alist
1097   '((?f    . face)
1098     (?t    . tabs)
1099     (?s    . spaces)
1100     (?r    . trailing)
1101     (?l    . lines)
1102     (?L    . lines-tail)
1103     (?n    . newline)
1104     (?e    . empty)
1105     (?\C-i . indentation)
1106     (?I    . indentation::tab)
1107     (?i    . indentation::space)
1108     (?\C-t . big-indent)
1109     (?\C-a . space-after-tab)
1110     (?A    . space-after-tab::tab)
1111     (?a    . space-after-tab::space)
1112     (?\C-b . space-before-tab)
1113     (?B    . space-before-tab::tab)
1114     (?b    . space-before-tab::space)
1115     (?T    . tab-mark)
1116     (?S    . space-mark)
1117     (?N    . newline-mark)
1118     (?x    . whitespace-style)
1119     )
1120   "Alist of toggle options.
1121
1122 Each element has the form:
1123
1124    (CHAR . SYMBOL)
1125
1126 Where:
1127
1128 CHAR    is a char which the user will have to type.
1129
1130 SYMBOL  is a valid symbol associated with CHAR.
1131         See `whitespace-style-value-list'.")
1132
1133
1134 (defvar whitespace-active-style nil
1135   "Used to save locally `whitespace-style' value.")
1136
1137 (defvar whitespace-indent-tabs-mode indent-tabs-mode
1138   "Used to save locally `indent-tabs-mode' value.")
1139
1140 (defvar whitespace-tab-width tab-width
1141   "Used to save locally `tab-width' value.")
1142
1143 (defvar whitespace-point (point)
1144   "Used to save locally current point value.
1145 Used by function `whitespace-trailing-regexp' (which see).")
1146 (defvar-local whitespace-point--used nil
1147   "Region whose highlighting depends on `whitespace-point'.")
1148
1149 (defvar whitespace-font-lock-refontify nil
1150   "Used to save locally the font-lock refontify state.
1151 Used by function `whitespace-post-command-hook' (which see).")
1152
1153 (defvar whitespace-bob-marker nil
1154   "Used to save locally the bob marker value.
1155 Used by function `whitespace-post-command-hook' (which see).")
1156
1157 (defvar whitespace-eob-marker nil
1158   "Used to save locally the eob marker value.
1159 Used by function `whitespace-post-command-hook' (which see).")
1160
1161 (defvar whitespace-buffer-changed nil
1162   "Used to indicate locally if buffer changed.
1163 Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
1164 functions (which see).")
1165
1166
1167 ;;;###autoload
1168 (defun whitespace-toggle-options (arg)
1169   "Toggle local `whitespace-mode' options.
1170
1171 If local whitespace-mode is off, toggle the option given by ARG
1172 and turn on local whitespace-mode.
1173
1174 If local whitespace-mode is on, toggle the option given by ARG
1175 and restart local whitespace-mode.
1176
1177 Interactively, it reads one of the following chars:
1178
1179   CHAR  MEANING
1180   (VIA FACES)
1181    f    toggle face visualization
1182    t    toggle TAB visualization
1183    s    toggle SPACE and HARD SPACE visualization
1184    r    toggle trailing blanks visualization
1185    l    toggle \"long lines\" visualization
1186    L    toggle \"long lines\" tail visualization
1187    n    toggle NEWLINE visualization
1188    e    toggle empty line at bob and/or eob visualization
1189    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1190    I    toggle indentation SPACEs visualization
1191    i    toggle indentation TABs visualization
1192    C-t  toggle big indentation visualization
1193    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1194    A    toggle SPACEs after TAB: SPACEs visualization
1195    a    toggle SPACEs after TAB: TABs visualization
1196    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1197    B    toggle SPACEs before TAB: SPACEs visualization
1198    b    toggle SPACEs before TAB: TABs visualization
1199
1200   (VIA DISPLAY TABLE)
1201    T    toggle TAB visualization
1202    S    toggle SPACEs before TAB visualization
1203    N    toggle NEWLINE visualization
1204
1205    x    restore `whitespace-style' value
1206    ?    display brief help
1207
1208 Non-interactively, ARG should be a symbol or a list of symbols.
1209 The valid symbols are:
1210
1211    face                 toggle face visualization
1212    tabs                 toggle TAB visualization
1213    spaces               toggle SPACE and HARD SPACE visualization
1214    trailing             toggle trailing blanks visualization
1215    lines                toggle \"long lines\" visualization
1216    lines-tail           toggle \"long lines\" tail visualization
1217    newline              toggle NEWLINE visualization
1218    empty                toggle empty line at bob and/or eob visualization
1219    indentation          toggle indentation SPACEs visualization
1220    indentation::tab     toggle indentation SPACEs visualization
1221    indentation::space   toggle indentation TABs visualization
1222    big-indent           toggle big indentation visualization
1223    space-after-tab              toggle SPACEs after TAB visualization
1224    space-after-tab::tab         toggle SPACEs after TAB: SPACEs visualization
1225    space-after-tab::space       toggle SPACEs after TAB: TABs visualization
1226    space-before-tab             toggle SPACEs before TAB visualization
1227    space-before-tab::tab        toggle SPACEs before TAB: SPACEs visualization
1228    space-before-tab::space      toggle SPACEs before TAB: TABs visualization
1229
1230    tab-mark             toggle TAB visualization
1231    space-mark           toggle SPACEs before TAB visualization
1232    newline-mark         toggle NEWLINE visualization
1233
1234    whitespace-style     restore `whitespace-style' value
1235
1236 See `whitespace-style' and `indent-tabs-mode' for documentation."
1237   (interactive (whitespace-interactive-char t))
1238   (let ((whitespace-style
1239          (whitespace-toggle-list t arg whitespace-active-style)))
1240     (whitespace-mode 0)
1241     (whitespace-mode 1)))
1242
1243
1244 (defvar whitespace-toggle-style nil
1245   "Used to toggle the global `whitespace-style' value.")
1246
1247
1248 ;;;###autoload
1249 (defun global-whitespace-toggle-options (arg)
1250   "Toggle global `whitespace-mode' options.
1251
1252 If global whitespace-mode is off, toggle the option given by ARG
1253 and turn on global whitespace-mode.
1254
1255 If global whitespace-mode is on, toggle the option given by ARG
1256 and restart global whitespace-mode.
1257
1258 Interactively, it accepts one of the following chars:
1259
1260   CHAR  MEANING
1261   (VIA FACES)
1262    f    toggle face visualization
1263    t    toggle TAB visualization
1264    s    toggle SPACE and HARD SPACE visualization
1265    r    toggle trailing blanks visualization
1266    l    toggle \"long lines\" visualization
1267    L    toggle \"long lines\" tail visualization
1268    n    toggle NEWLINE visualization
1269    e    toggle empty line at bob and/or eob visualization
1270    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1271    I    toggle indentation SPACEs visualization
1272    i    toggle indentation TABs visualization
1273    C-t  toggle big indentation visualization
1274    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1275    A    toggle SPACEs after TAB: SPACEs visualization
1276    a    toggle SPACEs after TAB: TABs visualization
1277    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1278    B    toggle SPACEs before TAB: SPACEs visualization
1279    b    toggle SPACEs before TAB: TABs visualization
1280
1281   (VIA DISPLAY TABLE)
1282    T    toggle TAB visualization
1283    S    toggle SPACEs before TAB visualization
1284    N    toggle NEWLINE visualization
1285
1286    x    restore `whitespace-style' value
1287    ?    display brief help
1288
1289 Non-interactively, ARG should be a symbol or a list of symbols.
1290 The valid symbols are:
1291
1292    face                 toggle face visualization
1293    tabs                 toggle TAB visualization
1294    spaces               toggle SPACE and HARD SPACE visualization
1295    trailing             toggle trailing blanks visualization
1296    lines                toggle \"long lines\" visualization
1297    lines-tail           toggle \"long lines\" tail visualization
1298    newline              toggle NEWLINE visualization
1299    empty                toggle empty line at bob and/or eob visualization
1300    indentation          toggle indentation SPACEs visualization
1301    indentation::tab     toggle indentation SPACEs visualization
1302    indentation::space   toggle indentation TABs visualization
1303    big-indent           toggle big indentation visualization
1304    space-after-tab              toggle SPACEs after TAB visualization
1305    space-after-tab::tab         toggle SPACEs after TAB: SPACEs visualization
1306    space-after-tab::space       toggle SPACEs after TAB: TABs visualization
1307    space-before-tab             toggle SPACEs before TAB visualization
1308    space-before-tab::tab        toggle SPACEs before TAB: SPACEs visualization
1309    space-before-tab::space      toggle SPACEs before TAB: TABs visualization
1310
1311    tab-mark             toggle TAB visualization
1312    space-mark           toggle SPACEs before TAB visualization
1313    newline-mark         toggle NEWLINE visualization
1314
1315    whitespace-style     restore `whitespace-style' value
1316
1317 See `whitespace-style' and `indent-tabs-mode' for documentation."
1318   (interactive (whitespace-interactive-char nil))
1319   (let ((whitespace-style
1320          (whitespace-toggle-list nil arg whitespace-toggle-style)))
1321     (setq whitespace-toggle-style whitespace-style)
1322     (global-whitespace-mode 0)
1323     (global-whitespace-mode 1)))
1324
1325 \f
1326 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1327 ;;;; User commands - Cleanup
1328
1329
1330 ;;;###autoload
1331 (defun whitespace-cleanup ()
1332   "Cleanup some blank problems in all buffer or at region.
1333
1334 It usually applies to the whole buffer, but in transient mark
1335 mode when the mark is active, it applies to the region.  It also
1336 applies to the region when it is not in transient mark mode, the
1337 mark is active and \\[universal-argument] was pressed just before
1338 calling `whitespace-cleanup' interactively.
1339
1340 See also `whitespace-cleanup-region'.
1341
1342 The problems cleaned up are:
1343
1344 1. empty lines at beginning of buffer.
1345 2. empty lines at end of buffer.
1346    If `whitespace-style' includes the value `empty', remove all
1347    empty lines at beginning and/or end of buffer.
1348
1349 3. `tab-width' or more SPACEs at beginning of line.
1350    If `whitespace-style' includes the value `indentation':
1351    replace `tab-width' or more SPACEs at beginning of line by
1352    TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by
1353    SPACEs.
1354    If `whitespace-style' includes the value `indentation::tab',
1355    replace `tab-width' or more SPACEs at beginning of line by TABs.
1356    If `whitespace-style' includes the value `indentation::space',
1357    replace TABs by SPACEs.
1358
1359 4. SPACEs before TAB.
1360    If `whitespace-style' includes the value `space-before-tab':
1361    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1362    otherwise, replace TABs by SPACEs.
1363    If `whitespace-style' includes the value
1364    `space-before-tab::tab', replace SPACEs by TABs.
1365    If `whitespace-style' includes the value
1366    `space-before-tab::space', replace TABs by SPACEs.
1367
1368 5. SPACEs or TABs at end of line.
1369    If `whitespace-style' includes the value `trailing', remove
1370    all SPACEs or TABs at end of line.
1371
1372 6. `tab-width' or more SPACEs after TAB.
1373    If `whitespace-style' includes the value `space-after-tab':
1374    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1375    otherwise, replace TABs by SPACEs.
1376    If `whitespace-style' includes the value
1377    `space-after-tab::tab', replace SPACEs by TABs.
1378    If `whitespace-style' includes the value
1379    `space-after-tab::space', replace TABs by SPACEs.
1380
1381 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
1382 documentation."
1383   (interactive "@")
1384   (cond
1385    ;; read-only buffer
1386    (buffer-read-only
1387     (whitespace-warn-read-only "cleanup"))
1388    ;; region active
1389    ((and (or transient-mark-mode
1390              current-prefix-arg)
1391          mark-active)
1392     ;; PROBLEMs 1 and 2 are not handled in region
1393     ;; PROBLEM 3: `tab-width' or more SPACEs at bol
1394     ;; PROBLEM 4: SPACEs before TAB
1395     ;; PROBLEM 5: SPACEs or TABs at eol
1396     ;; PROBLEM 6: `tab-width' or more SPACEs after TAB
1397     (whitespace-cleanup-region (region-beginning) (region-end)))
1398    ;; whole buffer
1399    (t
1400     (save-excursion
1401       (save-match-data                ;FIXME: Why?
1402         ;; PROBLEM 1: empty lines at bob
1403         ;; PROBLEM 2: empty lines at eob
1404         ;; ACTION: remove all empty lines at bob and/or eob
1405         (when (memq 'empty whitespace-style)
1406           (let (overwrite-mode)         ; enforce no overwrite
1407             (goto-char (point-min))
1408             (when (looking-at whitespace-empty-at-bob-regexp)
1409               (delete-region (match-beginning 1) (match-end 1)))
1410             (when (re-search-forward
1411                    whitespace-empty-at-eob-regexp nil t)
1412               (delete-region (match-beginning 1) (match-end 1)))))))
1413     ;; PROBLEM 3: `tab-width' or more SPACEs at bol
1414     ;; PROBLEM 4: SPACEs before TAB
1415     ;; PROBLEM 5: SPACEs or TABs at eol
1416     ;; PROBLEM 6: `tab-width' or more SPACEs after TAB
1417     (whitespace-cleanup-region (point-min) (point-max)))))
1418
1419 (defun whitespace-ensure-local-variables ()
1420   "Set `whitespace-indent-tabs-mode' and `whitespace-tab-width' locally."
1421   (set (make-local-variable 'whitespace-indent-tabs-mode)
1422        indent-tabs-mode)
1423   (set (make-local-variable 'whitespace-tab-width)
1424        tab-width))
1425
1426 ;;;###autoload
1427 (defun whitespace-cleanup-region (start end)
1428   "Cleanup some blank problems at region.
1429
1430 The problems cleaned up are:
1431
1432 1. `tab-width' or more SPACEs at beginning of line.
1433    If `whitespace-style' includes the value `indentation':
1434    replace `tab-width' or more SPACEs at beginning of line by TABs,
1435    if `indent-tabs-mode' is non-nil; otherwise, replace TABs by
1436    SPACEs.
1437    If `whitespace-style' includes the value `indentation::tab',
1438    replace `tab-width' or more SPACEs at beginning of line by TABs.
1439    If `whitespace-style' includes the value `indentation::space',
1440    replace TABs by SPACEs.
1441
1442 2. SPACEs before TAB.
1443    If `whitespace-style' includes the value `space-before-tab':
1444    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1445    otherwise, replace TABs by SPACEs.
1446    If `whitespace-style' includes the value
1447    `space-before-tab::tab', replace SPACEs by TABs.
1448    If `whitespace-style' includes the value
1449    `space-before-tab::space', replace TABs by SPACEs.
1450
1451 3. SPACEs or TABs at end of line.
1452    If `whitespace-style' includes the value `trailing', remove
1453    all SPACEs or TABs at end of line.
1454
1455 4. `tab-width' or more SPACEs after TAB.
1456    If `whitespace-style' includes the value `space-after-tab':
1457    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1458    otherwise, replace TABs by SPACEs.
1459    If `whitespace-style' includes the value
1460    `space-after-tab::tab', replace SPACEs by TABs.
1461    If `whitespace-style' includes the value
1462    `space-after-tab::space', replace TABs by SPACEs.
1463
1464 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
1465 documentation."
1466   (interactive "@r")
1467   (if buffer-read-only
1468       ;; read-only buffer
1469       (whitespace-warn-read-only "cleanup region")
1470     ;; non-read-only buffer
1471     (whitespace-ensure-local-variables)
1472     (let ((rstart           (min start end))
1473           (rend             (copy-marker (max start end)))
1474           (indent-tabs-mode whitespace-indent-tabs-mode)
1475           (tab-width        whitespace-tab-width)
1476           overwrite-mode                ; enforce no overwrite
1477           tmp)
1478       (save-excursion
1479         (save-match-data                ;FIXME: Why?
1480           ;; PROBLEM 1: `tab-width' or more SPACEs at bol
1481           (cond
1482            ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs, if
1483            ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1484            ;; by SPACEs.
1485            ((memq 'indentation whitespace-style)
1486             (let ((regexp (whitespace-indentation-regexp)))
1487               (goto-char rstart)
1488               (while (re-search-forward regexp rend t)
1489                 (setq tmp (current-indentation))
1490                 (goto-char (match-beginning 0))
1491                 (delete-horizontal-space)
1492                 (unless (eolp)
1493                   (indent-to tmp)))))
1494            ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs.
1495            ((memq 'indentation::tab whitespace-style)
1496             (whitespace-replace-action
1497              'tabify rstart rend
1498              (whitespace-indentation-regexp 'tab) 0))
1499            ;; ACTION: replace TABs by SPACEs.
1500            ((memq 'indentation::space whitespace-style)
1501             (whitespace-replace-action
1502              'untabify rstart rend
1503              (whitespace-indentation-regexp 'space) 0)))
1504           ;; PROBLEM 3: SPACEs or TABs at eol
1505           ;; ACTION: remove all SPACEs or TABs at eol
1506           (when (memq 'trailing whitespace-style)
1507             (whitespace-replace-action
1508              'delete-region rstart rend
1509              whitespace-trailing-regexp 1))
1510           ;; PROBLEM 4: `tab-width' or more SPACEs after TAB
1511           (cond
1512            ;; ACTION: replace `tab-width' or more SPACEs by TABs, if
1513            ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1514            ;; by SPACEs.
1515            ((memq 'space-after-tab whitespace-style)
1516             (whitespace-replace-action
1517              (if whitespace-indent-tabs-mode 'tabify 'untabify)
1518              rstart rend (whitespace-space-after-tab-regexp) 1))
1519            ;; ACTION: replace `tab-width' or more SPACEs by TABs.
1520            ((memq 'space-after-tab::tab whitespace-style)
1521             (whitespace-replace-action
1522              'tabify rstart rend
1523              (whitespace-space-after-tab-regexp 'tab) 1))
1524            ;; ACTION: replace TABs by SPACEs.
1525            ((memq 'space-after-tab::space whitespace-style)
1526             (whitespace-replace-action
1527              'untabify rstart rend
1528              (whitespace-space-after-tab-regexp 'space) 1)))
1529           ;; PROBLEM 2: SPACEs before TAB
1530           (cond
1531            ;; ACTION: replace SPACEs before TAB by TABs, if
1532            ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1533            ;; by SPACEs.
1534            ((memq 'space-before-tab whitespace-style)
1535             (whitespace-replace-action
1536              (if whitespace-indent-tabs-mode 'tabify 'untabify)
1537              rstart rend whitespace-space-before-tab-regexp
1538              (if whitespace-indent-tabs-mode 0 2)))
1539            ;; ACTION: replace SPACEs before TAB by TABs.
1540            ((memq 'space-before-tab::tab whitespace-style)
1541             (whitespace-replace-action
1542              'tabify rstart rend
1543              whitespace-space-before-tab-regexp 0))
1544            ;; ACTION: replace TABs by SPACEs.
1545            ((memq 'space-before-tab::space whitespace-style)
1546             (whitespace-replace-action
1547              'untabify rstart rend
1548              whitespace-space-before-tab-regexp 2)))))
1549       (set-marker rend nil))))          ; point marker to nowhere
1550
1551
1552 (defun whitespace-replace-action (action rstart rend regexp index)
1553   "Do ACTION in the string matched by REGEXP between RSTART and REND.
1554
1555 INDEX is the level group matched by REGEXP and used by ACTION.
1556
1557 See also `tab-width'."
1558   (goto-char rstart)
1559   (while (re-search-forward regexp rend t)
1560     (goto-char (match-end index))
1561     (funcall action (match-beginning index) (match-end index))))
1562
1563 \f
1564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1565 ;;;; User command - report
1566
1567
1568 (defun whitespace-regexp (regexp &optional kind)
1569   "Return REGEXP depending on `whitespace-indent-tabs-mode'."
1570   (format
1571    (cond
1572     ((or (eq kind 'tab)
1573          whitespace-indent-tabs-mode)
1574      (car regexp))
1575     ((or (eq kind 'space)
1576          (not whitespace-indent-tabs-mode))
1577      (cdr regexp)))
1578    whitespace-tab-width))
1579
1580
1581 (defun whitespace-indentation-regexp (&optional kind)
1582   "Return the indentation regexp depending on `whitespace-indent-tabs-mode'."
1583   (whitespace-regexp whitespace-indentation-regexp kind))
1584
1585
1586 (defun whitespace-space-after-tab-regexp (&optional kind)
1587   "Return the space-after-tab regexp depending on `whitespace-indent-tabs-mode'."
1588   (whitespace-regexp whitespace-space-after-tab-regexp kind))
1589
1590
1591 (defconst whitespace-report-list
1592   (list
1593    (cons 'empty                   whitespace-empty-at-bob-regexp)
1594    (cons 'empty                   whitespace-empty-at-eob-regexp)
1595    (cons 'trailing                whitespace-trailing-regexp)
1596    (cons 'indentation             nil)
1597    (cons 'indentation::tab        nil)
1598    (cons 'indentation::space      nil)
1599    (cons 'space-before-tab        whitespace-space-before-tab-regexp)
1600    (cons 'space-before-tab::tab   whitespace-space-before-tab-regexp)
1601    (cons 'space-before-tab::space whitespace-space-before-tab-regexp)
1602    (cons 'space-after-tab         nil)
1603    (cons 'space-after-tab::tab    nil)
1604    (cons 'space-after-tab::space  nil)
1605    )
1606    "List of whitespace bogus symbol and corresponding regexp.")
1607
1608
1609 (defconst whitespace-report-text
1610   '( ;; `indent-tabs-mode' has non-nil value
1611     "\
1612  Whitespace Report
1613
1614  Current Setting                       Whitespace Problem
1615
1616  empty                    []     []  empty lines at beginning of buffer
1617  empty                    []     []  empty lines at end of buffer
1618  trailing                 []     []  SPACEs or TABs at end of line
1619  indentation              []     []  >= `tab-width' SPACEs at beginning of line
1620  indentation::tab         []     []  >= `tab-width' SPACEs at beginning of line
1621  indentation::space       []     []  TABs at beginning of line
1622  space-before-tab         []     []  SPACEs before TAB
1623  space-before-tab::tab    []     []  SPACEs before TAB: SPACEs
1624  space-before-tab::space  []     []  SPACEs before TAB: TABs
1625  space-after-tab          []     []  >= `tab-width' SPACEs after TAB
1626  space-after-tab::tab     []     []  >= `tab-width' SPACEs after TAB: SPACEs
1627  space-after-tab::space   []     []  >= `tab-width' SPACEs after TAB: TABs
1628
1629  indent-tabs-mode =
1630  tab-width        = \n\n"
1631     . ;; `indent-tabs-mode' has nil value
1632     "\
1633  Whitespace Report
1634
1635  Current Setting                       Whitespace Problem
1636
1637  empty                    []     []  empty lines at beginning of buffer
1638  empty                    []     []  empty lines at end of buffer
1639  trailing                 []     []  SPACEs or TABs at end of line
1640  indentation              []     []  TABs at beginning of line
1641  indentation::tab         []     []  >= `tab-width' SPACEs at beginning of line
1642  indentation::space       []     []  TABs at beginning of line
1643  space-before-tab         []     []  SPACEs before TAB
1644  space-before-tab::tab    []     []  SPACEs before TAB: SPACEs
1645  space-before-tab::space  []     []  SPACEs before TAB: TABs
1646  space-after-tab          []     []  >= `tab-width' SPACEs after TAB
1647  space-after-tab::tab     []     []  >= `tab-width' SPACEs after TAB: SPACEs
1648  space-after-tab::space   []     []  >= `tab-width' SPACEs after TAB: TABs
1649
1650  indent-tabs-mode =
1651  tab-width        = \n\n")
1652   "Text for whitespace bogus report.
1653
1654 It is a cons of strings, where the car part is used when
1655 `indent-tabs-mode' is non-nil, and the cdr part is used when
1656 `indent-tabs-mode' is nil.")
1657
1658
1659 (defconst whitespace-report-buffer-name "*Whitespace Report*"
1660   "The buffer name for whitespace bogus report.")
1661
1662
1663 ;;;###autoload
1664 (defun whitespace-report (&optional force report-if-bogus)
1665   "Report some whitespace problems in buffer.
1666
1667 Perform `whitespace-report-region' on the current buffer."
1668   (interactive (list current-prefix-arg))
1669   (whitespace-report-region (point-min) (point-max)
1670                             force report-if-bogus))
1671
1672
1673 ;;;###autoload
1674 (defun whitespace-report-region (start end &optional force report-if-bogus)
1675   "Report some whitespace problems in a region.
1676
1677 Return nil if there is no whitespace problem; otherwise, return
1678 non-nil.
1679
1680 If FORCE is non-nil or \\[universal-argument] was pressed just
1681 before calling `whitespace-report-region' interactively, it
1682 forces all classes of whitespace problem to be considered
1683 significant.
1684
1685 If REPORT-IF-BOGUS is t, it reports only when there are any
1686 whitespace problems in buffer; if it is `never', it does not
1687 report problems.
1688
1689 Report if some of the following whitespace problems exist:
1690
1691 * If `indent-tabs-mode' is non-nil:
1692    empty                1. empty lines at beginning of buffer.
1693    empty                2. empty lines at end of buffer.
1694    trailing             3. SPACEs or TABs at end of line.
1695    indentation          4. line starts with `tab-width' or more SPACEs.
1696    space-before-tab     5. SPACEs before TAB.
1697    space-after-tab      6. `tab-width' or more SPACEs after TAB.
1698
1699 * If `indent-tabs-mode' is nil:
1700    empty                1. empty lines at beginning of buffer.
1701    empty                2. empty lines at end of buffer.
1702    trailing             3. SPACEs or TABs at end of line.
1703    indentation          4. TABS at beginning of line.
1704    space-before-tab     5. SPACEs before TAB.
1705    space-after-tab      6. `tab-width' or more SPACEs after TAB.
1706
1707 See `whitespace-style' for documentation.
1708 See also `whitespace-cleanup' and `whitespace-cleanup-region' for
1709 cleaning up these problems."
1710   (interactive "r")
1711   (setq force (or current-prefix-arg force))
1712   (save-excursion
1713     (save-match-data                ;FIXME: Why?
1714       (let* ((has-bogus nil)
1715              (rstart    (min start end))
1716              (rend      (max start end))
1717              ;; Fall back to whitespace-style so we can run before
1718              ;; before the mode is active.
1719              (style     (copy-sequence
1720                          (or whitespace-active-style whitespace-style)))
1721              (bogus-list
1722               (mapcar
1723                #'(lambda (option)
1724                    (when force
1725                      (add-to-list 'style (car option)))
1726                    (goto-char rstart)
1727                    (let ((regexp
1728                           (cond
1729                            ((eq (car option) 'indentation)
1730                             (whitespace-indentation-regexp))
1731                            ((eq (car option) 'indentation::tab)
1732                             (whitespace-indentation-regexp 'tab))
1733                            ((eq (car option) 'indentation::space)
1734                             (whitespace-indentation-regexp 'space))
1735                            ((eq (car option) 'space-after-tab)
1736                             (whitespace-space-after-tab-regexp))
1737                            ((eq (car option) 'space-after-tab::tab)
1738                             (whitespace-space-after-tab-regexp 'tab))
1739                            ((eq (car option) 'space-after-tab::space)
1740                             (whitespace-space-after-tab-regexp 'space))
1741                            (t
1742                             (cdr option)))))
1743                      (when (re-search-forward regexp rend t)
1744                        (unless has-bogus
1745                          (setq has-bogus (memq (car option) style)))
1746                        t)))
1747                whitespace-report-list)))
1748         (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus))
1749           (whitespace-kill-buffer whitespace-report-buffer-name)
1750           ;; `whitespace-indent-tabs-mode' is local to current buffer
1751           ;; `whitespace-tab-width' is local to current buffer
1752           (let ((ws-indent-tabs-mode whitespace-indent-tabs-mode)
1753                 (ws-tab-width whitespace-tab-width))
1754             (with-current-buffer (get-buffer-create
1755                                   whitespace-report-buffer-name)
1756               (erase-buffer)
1757               (insert (if ws-indent-tabs-mode
1758                           (car whitespace-report-text)
1759                         (cdr whitespace-report-text)))
1760               (goto-char (point-min))
1761               (forward-line 3)
1762               (dolist (option whitespace-report-list)
1763                 (forward-line 1)
1764                 (whitespace-mark-x
1765                  27 (memq (car option) style))
1766                 (whitespace-mark-x 7 (car bogus-list))
1767                 (setq bogus-list (cdr bogus-list)))
1768               (forward-line 1)
1769               (whitespace-insert-value ws-indent-tabs-mode)
1770               (whitespace-insert-value ws-tab-width)
1771               (when has-bogus
1772                 (goto-char (point-max))
1773                 (insert (substitute-command-keys
1774                          " Type `\\[whitespace-cleanup]'")
1775                         " to cleanup the buffer.\n\n"
1776                         (substitute-command-keys
1777                          " Type `\\[whitespace-cleanup-region]'")
1778                         " to cleanup a region.\n\n"))
1779               (whitespace-display-window (current-buffer)))))
1780         has-bogus))))
1781
1782 \f
1783 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1784 ;;;; Internal functions
1785
1786
1787 (defvar whitespace-font-lock-keywords nil
1788   "Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.")
1789
1790
1791 (defconst whitespace-help-text
1792   "\
1793  Whitespace Toggle Options                  | scroll up  :  SPC   or > |
1794                                             | scroll down:  M-SPC or < |
1795  FACES                                      \\__________________________/
1796  []  f   - toggle face visualization
1797  []  t   - toggle TAB visualization
1798  []  s   - toggle SPACE and HARD SPACE visualization
1799  []  r   - toggle trailing blanks visualization
1800  []  l   - toggle \"long lines\" visualization
1801  []  L   - toggle \"long lines\" tail visualization
1802  []  n   - toggle NEWLINE visualization
1803  []  e   - toggle empty line at bob and/or eob visualization
1804  []  C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode')
1805  []  I   - toggle indentation SPACEs visualization
1806  []  i   - toggle indentation TABs visualization
1807  []  C-t - toggle big indentation visualization
1808  []  C-a - toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1809  []  A   - toggle SPACEs after TAB: SPACEs visualization
1810  []  a   - toggle SPACEs after TAB: TABs visualization
1811  []  C-b - toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1812  []  B   - toggle SPACEs before TAB: SPACEs visualization
1813  []  b   - toggle SPACEs before TAB: TABs visualization
1814
1815  DISPLAY TABLE
1816  []  T - toggle TAB visualization
1817  []  S - toggle SPACE and HARD SPACE visualization
1818  []  N - toggle NEWLINE visualization
1819
1820       x - restore `whitespace-style' value
1821
1822       ? - display this text\n\n"
1823   "Text for whitespace toggle options.")
1824
1825
1826 (defconst whitespace-help-buffer-name "*Whitespace Toggle Options*"
1827   "The buffer name for whitespace toggle options.")
1828
1829
1830 (defun whitespace-insert-value (value)
1831   "Insert VALUE at column 20 of next line."
1832   (forward-line 1)
1833   (move-to-column 20 t)
1834   (insert (format "%s" value)))
1835
1836
1837 (defun whitespace-mark-x (nchars condition)
1838   "Insert the mark (`X' or ` ') after NCHARS depending on CONDITION."
1839   (forward-char nchars)
1840   (insert (if condition "X" " ")))
1841
1842
1843 (defun whitespace-insert-option-mark (the-list the-value)
1844   "Insert the option mark (`X' or ` ') in toggle options buffer."
1845   (goto-char (point-min))
1846   (forward-line 2)
1847   (dolist (sym  the-list)
1848     (if (eq sym 'help-newline)
1849         (forward-line 2)
1850       (forward-line 1)
1851       (whitespace-mark-x 2 (memq sym the-value)))))
1852
1853
1854 (defun whitespace-help-on (style)
1855   "Display the whitespace toggle options."
1856   (unless (get-buffer whitespace-help-buffer-name)
1857     (delete-other-windows)
1858     (let ((buffer (get-buffer-create whitespace-help-buffer-name)))
1859       (with-current-buffer buffer
1860         (erase-buffer)
1861         (insert whitespace-help-text)
1862         (whitespace-insert-option-mark
1863          whitespace-style-value-list style)
1864         (whitespace-display-window buffer)))))
1865
1866
1867 (defun whitespace-display-window (buffer)
1868   "Display BUFFER in a new window."
1869   (goto-char (point-min))
1870   (set-buffer-modified-p nil)
1871   (when (< (window-height) (* 2 window-min-height))
1872     (kill-buffer buffer)
1873     (error "Window height is too small; \
1874 can't split window to display whitespace toggle options"))
1875   (let ((win (split-window)))
1876     (set-window-buffer win buffer)
1877     (shrink-window-if-larger-than-buffer win)))
1878
1879
1880 (defun whitespace-kill-buffer (buffer-name)
1881   "Kill buffer BUFFER-NAME and windows related with it."
1882   (let ((buffer (get-buffer buffer-name)))
1883     (when buffer
1884       (delete-windows-on buffer)
1885       (kill-buffer buffer))))
1886
1887
1888 (defun whitespace-help-off ()
1889   "Remove the buffer and window of the whitespace toggle options."
1890   (whitespace-kill-buffer whitespace-help-buffer-name))
1891
1892
1893 (defun whitespace-help-scroll (&optional up)
1894   "Scroll help window, if it exists.
1895
1896 If UP is non-nil, scroll up; otherwise, scroll down."
1897   (condition-case nil
1898       (let ((buffer (get-buffer whitespace-help-buffer-name)))
1899         (if buffer
1900             (with-selected-window (get-buffer-window buffer)
1901               (if up
1902                   (scroll-up 3)
1903                 (scroll-down 3)))
1904           (ding)))
1905     ;; handler
1906     ((error)
1907      ;; just ignore error
1908      )))
1909
1910
1911 (defun whitespace-interactive-char (local-p)
1912   "Interactive function to read a char and return a symbol.
1913
1914 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1915 uses a global context.
1916
1917 It accepts one of the following chars:
1918
1919   CHAR  MEANING
1920   (VIA FACES)
1921    f    toggle face visualization
1922    t    toggle TAB visualization
1923    s    toggle SPACE and HARD SPACE visualization
1924    r    toggle trailing blanks visualization
1925    l    toggle \"long lines\" visualization
1926    L    toggle \"long lines\" tail visualization
1927    n    toggle NEWLINE visualization
1928    e    toggle empty line at bob and/or eob visualization
1929    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1930    I    toggle indentation SPACEs visualization
1931    i    toggle indentation TABs visualization
1932    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1933    A    toggle SPACEs after TAB: SPACEs visualization
1934    a    toggle SPACEs after TAB: TABs visualization
1935    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1936    B    toggle SPACEs before TAB: SPACEs visualization
1937    b    toggle SPACEs before TAB: TABs visualization
1938
1939   (VIA DISPLAY TABLE)
1940    T    toggle TAB visualization
1941    S    toggle SPACE and HARD SPACE visualization
1942    N    toggle NEWLINE visualization
1943
1944    x    restore `whitespace-style' value
1945    ?    display brief help
1946
1947 See also `whitespace-toggle-option-alist'."
1948   (let* ((is-off (not (if local-p
1949                           whitespace-mode
1950                         global-whitespace-mode)))
1951          (style  (cond (is-off  whitespace-style) ; use default value
1952                        (local-p whitespace-active-style)
1953                        (t       whitespace-toggle-style)))
1954          (prompt
1955           (format "Whitespace Toggle %s (type ? for further options)-"
1956                   (if local-p "Local" "Global")))
1957          ch sym)
1958     ;; read a valid option and get the corresponding symbol
1959     (save-window-excursion
1960       (condition-case data
1961           (progn
1962             (while
1963                 ;; while condition
1964                 (progn
1965                   (setq ch (read-char prompt))
1966                   (not
1967                    (setq sym
1968                          (cdr
1969                           (assq ch whitespace-toggle-option-alist)))))
1970               ;; while body
1971               (cond
1972                ((eq ch ?\?)   (whitespace-help-on style))
1973                ((eq ch ?\ )   (whitespace-help-scroll t))
1974                ((eq ch ?\M- ) (whitespace-help-scroll))
1975                ((eq ch ?>)    (whitespace-help-scroll t))
1976                ((eq ch ?<)    (whitespace-help-scroll))
1977                (t             (ding))))
1978             (whitespace-help-off)
1979             (message " "))              ; clean echo area
1980         ;; handler
1981         ((quit error)
1982          (whitespace-help-off)
1983          (error (error-message-string data)))))
1984     (list sym)))                        ; return the appropriate symbol
1985
1986
1987 (defun whitespace-toggle-list (local-p arg the-list)
1988   "Toggle options in THE-LIST based on list ARG.
1989
1990 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1991 uses a global context.
1992
1993 ARG is a list of options to be toggled.
1994
1995 THE-LIST is a list of options.  This list will be toggled and the
1996 resultant list will be returned."
1997   (unless (if local-p whitespace-mode global-whitespace-mode)
1998     (setq the-list whitespace-style))
1999   (setq the-list (copy-sequence the-list)) ; keep original list
2000   (dolist (sym (if (listp arg) arg (list arg)))
2001     (cond
2002      ;; ignore help value
2003      ((eq sym 'help-newline))
2004      ;; restore default values
2005      ((eq sym 'whitespace-style)
2006       (setq the-list whitespace-style))
2007      ;; toggle valid values
2008      ((memq sym whitespace-style-value-list)
2009       (setq the-list (if (memq sym the-list)
2010                          (delq sym the-list)
2011                        (cons sym the-list))))))
2012   the-list)
2013
2014
2015 (defvar whitespace-display-table nil
2016   "Used to save a local display table.")
2017
2018 (defvar whitespace-display-table-was-local nil
2019   "Used to remember whether a buffer initially had a local display table.")
2020
2021 (defun whitespace-turn-on ()
2022   "Turn on whitespace visualization."
2023   ;; prepare local hooks
2024   (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
2025   ;; create whitespace local buffer environment
2026   (set (make-local-variable 'whitespace-font-lock-keywords) nil)
2027   (set (make-local-variable 'whitespace-display-table) nil)
2028   (set (make-local-variable 'whitespace-display-table-was-local) nil)
2029   (set (make-local-variable 'whitespace-active-style)
2030        (if (listp whitespace-style)
2031            whitespace-style
2032          (list whitespace-style)))
2033   (whitespace-ensure-local-variables)
2034   ;; turn on whitespace
2035   (when whitespace-active-style
2036     (whitespace-color-on)
2037     (whitespace-display-char-on)))
2038
2039
2040 (defun whitespace-turn-off ()
2041   "Turn off whitespace visualization."
2042   (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
2043   (when whitespace-active-style
2044     (whitespace-color-off)
2045     (whitespace-display-char-off)))
2046
2047
2048 (defun whitespace-style-face-p ()
2049   "Return t if there is some visualization via face."
2050   (and (memq 'face whitespace-active-style)
2051        (or (memq 'tabs                    whitespace-active-style)
2052            (memq 'spaces                  whitespace-active-style)
2053            (memq 'trailing                whitespace-active-style)
2054            (memq 'lines                   whitespace-active-style)
2055            (memq 'lines-tail              whitespace-active-style)
2056            (memq 'newline                 whitespace-active-style)
2057            (memq 'empty                   whitespace-active-style)
2058            (memq 'indentation             whitespace-active-style)
2059            (memq 'indentation::tab        whitespace-active-style)
2060            (memq 'indentation::space      whitespace-active-style)
2061            (memq 'big-indent              whitespace-active-style)
2062            (memq 'space-after-tab         whitespace-active-style)
2063            (memq 'space-after-tab::tab    whitespace-active-style)
2064            (memq 'space-after-tab::space  whitespace-active-style)
2065            (memq 'space-before-tab        whitespace-active-style)
2066            (memq 'space-before-tab::tab   whitespace-active-style)
2067            (memq 'space-before-tab::space whitespace-active-style))))
2068
2069
2070 (defun whitespace-color-on ()
2071   "Turn on color visualization."
2072   (when (whitespace-style-face-p)
2073     ;; save current point and refontify when necessary
2074     (set (make-local-variable 'whitespace-point)
2075          (point))
2076     (setq whitespace-point--used
2077           (let ((ol (make-overlay (point) (point) nil nil t)))
2078             (delete-overlay ol) ol))
2079     (set (make-local-variable 'whitespace-font-lock-refontify)
2080          0)
2081     (set (make-local-variable 'whitespace-bob-marker)
2082          (point-min-marker))
2083     (set (make-local-variable 'whitespace-eob-marker)
2084          (point-max-marker))
2085     (set (make-local-variable 'whitespace-buffer-changed)
2086          nil)
2087     (add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
2088     (add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
2089     ;; Add whitespace-mode color into font lock.
2090     (setq
2091      whitespace-font-lock-keywords
2092      `(
2093        (whitespace-point--flush-used)
2094        ,@(when (memq 'spaces whitespace-active-style)
2095            ;; Show SPACEs.
2096            `((,whitespace-space-regexp 1 whitespace-space t)
2097              ;; Show HARD SPACEs.
2098              (,whitespace-hspace-regexp 1 whitespace-hspace t)))
2099        ,@(when (memq 'tabs whitespace-active-style)
2100            ;; Show TABs.
2101            `((,whitespace-tab-regexp 1 whitespace-tab t)))
2102        ,@(when (memq 'trailing whitespace-active-style)
2103            ;; Show trailing blanks.
2104            `((,#'whitespace-trailing-regexp 1 whitespace-trailing t)))
2105        ,@(when (or (memq 'lines      whitespace-active-style)
2106                    (memq 'lines-tail whitespace-active-style))
2107            ;; Show "long" lines.
2108            `((,(let ((line-column (or whitespace-line-column fill-column)))
2109                  (format
2110                   "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
2111                   whitespace-tab-width
2112                   (1- whitespace-tab-width)
2113                   (/ line-column whitespace-tab-width)
2114                   (let ((rem (% line-column whitespace-tab-width)))
2115                     (if (zerop rem)
2116                         ""
2117                       (format ".\\{%d\\}" rem)))))
2118               ,(if (memq 'lines whitespace-active-style)
2119                    0                    ; whole line
2120                  2)                     ; line tail
2121               whitespace-line prepend)))
2122        ,@(when (or (memq 'space-before-tab whitespace-active-style)
2123                    (memq 'space-before-tab::tab whitespace-active-style)
2124                    (memq 'space-before-tab::space whitespace-active-style))
2125            `((,whitespace-space-before-tab-regexp
2126               ,(cond
2127                 ((memq 'space-before-tab whitespace-active-style)
2128                  ;; Show SPACEs before TAB (indent-tabs-mode).
2129                  (if whitespace-indent-tabs-mode 1 2))
2130                 ((memq 'space-before-tab::tab whitespace-active-style)
2131                  1)
2132                 ((memq 'space-before-tab::space whitespace-active-style)
2133                  2))
2134               whitespace-space-before-tab t)))
2135        ,@(when (or (memq 'indentation whitespace-active-style)
2136                    (memq 'indentation::tab whitespace-active-style)
2137                    (memq 'indentation::space whitespace-active-style))
2138            `((,(cond
2139                 ((memq 'indentation whitespace-active-style)
2140                  ;; Show indentation SPACEs (indent-tabs-mode).
2141                  (whitespace-indentation-regexp))
2142                 ((memq 'indentation::tab whitespace-active-style)
2143                  ;; Show indentation SPACEs (SPACEs).
2144                  (whitespace-indentation-regexp 'tab))
2145                 ((memq 'indentation::space whitespace-active-style)
2146                  ;; Show indentation SPACEs (TABs).
2147                  (whitespace-indentation-regexp 'space)))
2148               1 whitespace-indentation t)))
2149        ,@(when (memq 'big-indent whitespace-active-style)
2150            ;; Show big indentation.
2151            `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t)))
2152        ,@(when (memq 'empty whitespace-active-style)
2153            ;; Show empty lines at beginning of buffer.
2154            `((,#'whitespace-empty-at-bob-regexp
2155               1 whitespace-empty t)
2156              ;; Show empty lines at end of buffer.
2157              (,#'whitespace-empty-at-eob-regexp
2158               1 whitespace-empty t)))
2159        ,@(when (or (memq 'space-after-tab whitespace-active-style)
2160                    (memq 'space-after-tab::tab whitespace-active-style)
2161                    (memq 'space-after-tab::space whitespace-active-style))
2162            `((,(cond
2163                 ((memq 'space-after-tab whitespace-active-style)
2164                  ;; Show SPACEs after TAB (indent-tabs-mode).
2165                  (whitespace-space-after-tab-regexp))
2166                 ((memq 'space-after-tab::tab whitespace-active-style)
2167                  ;; Show SPACEs after TAB (SPACEs).
2168                  (whitespace-space-after-tab-regexp 'tab))
2169                 ((memq 'space-after-tab::space whitespace-active-style)
2170                  ;; Show SPACEs after TAB (TABs).
2171                  (whitespace-space-after-tab-regexp 'space)))
2172               1 whitespace-space-after-tab t)))))
2173     (font-lock-add-keywords nil whitespace-font-lock-keywords t)
2174     (font-lock-flush)))
2175
2176
2177 (defun whitespace-color-off ()
2178   "Turn off color visualization."
2179   ;; turn off font lock
2180   (kill-local-variable 'whitespace-point--used)
2181   (when (whitespace-style-face-p)
2182     (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
2183     (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
2184     (font-lock-remove-keywords nil whitespace-font-lock-keywords)
2185     (font-lock-flush)))
2186
2187 (defun whitespace-point--used (start end)
2188   (let ((ostart (overlay-start whitespace-point--used)))
2189     (if ostart
2190         (move-overlay whitespace-point--used
2191                       (min start ostart)
2192                       (max end (overlay-end whitespace-point--used)))
2193       (move-overlay whitespace-point--used start end))))
2194
2195 (defun whitespace-point--flush-used (limit)
2196   (let ((ostart (overlay-start whitespace-point--used)))
2197     ;; Strip parts of whitespace-point--used we're about to refresh.
2198     (when ostart
2199       (let ((oend (overlay-end whitespace-point--used)))
2200         (if (<= (point) ostart)
2201             (if (<= oend limit)
2202                 (delete-overlay whitespace-point--used)
2203               (move-overlay whitespace-point--used limit oend)))
2204         (if (<= oend limit)
2205             (move-overlay whitespace-point--used ostart (point))))))
2206   nil)
2207
2208 (defun whitespace-trailing-regexp (limit)
2209   "Match trailing spaces which do not contain the point at end of line."
2210   (let ((status t))
2211     (while (if (re-search-forward whitespace-trailing-regexp limit t)
2212                (when (= whitespace-point (match-end 1)) ; Loop if point at eol.
2213                  (whitespace-point--used (match-beginning 0) (match-end 0))
2214                  t)
2215              (setq status nil)))                  ;; end of buffer
2216     status))
2217
2218
2219 (defun whitespace-empty-at-bob-regexp (limit)
2220   "Match spaces at beginning of buffer which do not contain the point at \
2221 beginning of buffer."
2222   (let ((b (point))
2223         r)
2224     (cond
2225      ;; at bob
2226      ((= b 1)
2227       (setq r (and (looking-at whitespace-empty-at-bob-regexp)
2228                    (or (/= whitespace-point 1)
2229                        (progn (whitespace-point--used (match-beginning 0)
2230                                                       (match-end 0))
2231                               nil))))
2232       (set-marker whitespace-bob-marker (if r (match-end 1) b)))
2233      ;; inside bob empty region
2234      ((<= limit whitespace-bob-marker)
2235       (setq r (looking-at whitespace-empty-at-bob-regexp))
2236       (if r
2237           (when (< (match-end 1) limit)
2238             (set-marker whitespace-bob-marker (match-end 1)))
2239         (set-marker whitespace-bob-marker b)))
2240      ;; intersection with end of bob empty region
2241      ((<= b whitespace-bob-marker)
2242       (setq r (looking-at whitespace-empty-at-bob-regexp))
2243       (set-marker whitespace-bob-marker (if r (match-end 1) b)))
2244      ;; it is not inside bob empty region
2245      (t
2246       (setq r nil)))
2247     ;; move to end of matching
2248     (and r (goto-char (match-end 1)))
2249     r))
2250
2251
2252 (defsubst whitespace-looking-back (regexp limit)
2253   (save-excursion
2254     (when (/= 0 (skip-chars-backward " \t\n" limit))
2255       (unless (bolp)
2256         (forward-line 1))
2257       (looking-at regexp))))
2258
2259
2260 (defun whitespace-empty-at-eob-regexp (limit)
2261   "Match spaces at end of buffer which do not contain the point at end of \
2262 buffer."
2263   (let ((b (point))
2264         (e (1+ (buffer-size)))
2265         r)
2266     (cond
2267      ;; at eob
2268      ((= limit e)
2269       (goto-char limit)
2270       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2271       (when (and r (= whitespace-point e))
2272         (setq r nil)
2273         (whitespace-point--used (match-beginning 0) (match-end 0)))
2274       (if r
2275           (set-marker whitespace-eob-marker (match-beginning 1))
2276         (set-marker whitespace-eob-marker limit)
2277         (goto-char b)))                 ; return back to initial position
2278      ;; inside eob empty region
2279      ((>= b whitespace-eob-marker)
2280       (goto-char limit)
2281       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2282       (if r
2283           (when (> (match-beginning 1) b)
2284             (set-marker whitespace-eob-marker (match-beginning 1)))
2285         (set-marker whitespace-eob-marker limit)
2286         (goto-char b)))                 ; return back to initial position
2287      ;; intersection with beginning of eob empty region
2288      ((>= limit whitespace-eob-marker)
2289       (goto-char limit)
2290       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2291       (if r
2292           (set-marker whitespace-eob-marker (match-beginning 1))
2293         (set-marker whitespace-eob-marker limit)
2294         (goto-char b)))                 ; return back to initial position
2295      ;; it is not inside eob empty region
2296      (t
2297       (setq r nil)))
2298     r))
2299
2300
2301 (defun whitespace-buffer-changed (_beg _end)
2302   "Set `whitespace-buffer-changed' variable to t."
2303   (setq whitespace-buffer-changed t))
2304
2305
2306 (defun whitespace-post-command-hook ()
2307   "Save current point into `whitespace-point' variable.
2308 Also refontify when necessary."
2309   (unless (and (eq whitespace-point (point))
2310                (not whitespace-buffer-changed))
2311     (setq whitespace-point (point))     ; current point position
2312     (let ((refontify
2313            (cond
2314             ;; It is at end of buffer (eob).
2315             ((= whitespace-point (1+ (buffer-size)))
2316              (when (whitespace-looking-back whitespace-empty-at-eob-regexp
2317                                             nil)
2318                (match-beginning 0)))
2319             ;; It is at end of line ...
2320             ((and (eolp)
2321                   ;; ... with trailing SPACE or TAB
2322                   (or (memq (preceding-char) '(?\s ?\t))))
2323              (line-beginning-position))
2324             ;; It is at beginning of buffer (bob).
2325             ((and (= whitespace-point 1)
2326                   (looking-at whitespace-empty-at-bob-regexp))
2327              (match-end 0))))
2328           (ostart (overlay-start whitespace-point--used)))
2329       (cond
2330        ((not refontify)
2331         ;; New point does not affect highlighting: just refresh the
2332         ;; highlighting of old point, if needed.
2333         (when ostart
2334           (font-lock-flush ostart
2335                            (overlay-end whitespace-point--used))
2336           (delete-overlay whitespace-point--used)))
2337        ((not ostart)
2338         ;; Old point did not affect highlighting, but new one does: refresh the
2339         ;; highlighting of new point.
2340         (font-lock-flush (min refontify (point)) (max refontify (point))))
2341        ((save-excursion
2342           (goto-char ostart)
2343           (setq ostart (line-beginning-position))
2344           (and (<= ostart (max refontify (point)))
2345                (progn
2346                  (goto-char (overlay-end whitespace-point--used))
2347                  (let ((oend (line-beginning-position 2)))
2348                    (<= (min refontify (point)) oend)))))
2349         ;; The old point highlighting and the new point highlighting
2350         ;; cover a contiguous region: do a single refresh.
2351         (font-lock-flush (min refontify (point) ostart)
2352                          (max refontify (point)
2353                               (overlay-end whitespace-point--used)))
2354         (delete-overlay whitespace-point--used))
2355        (t
2356         (font-lock-flush (min refontify (point))
2357                          (max refontify (point)))
2358         (font-lock-flush ostart (overlay-end whitespace-point--used))
2359         (delete-overlay whitespace-point--used))))))
2360
2361 \f
2362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2363 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
2364
2365
2366 (defun whitespace-style-mark-p ()
2367   "Return t if there is some visualization via display table."
2368   (or (memq 'tab-mark     whitespace-active-style)
2369       (memq 'space-mark   whitespace-active-style)
2370       (memq 'newline-mark whitespace-active-style)))
2371
2372
2373 (defsubst whitespace-char-valid-p (char)
2374   ;; This check should be improved!!!
2375   (or (< char 256)
2376       (characterp char)))
2377
2378
2379 (defun whitespace-display-vector-p (vec)
2380   "Return true if every character in vector VEC can be displayed."
2381   (let ((i (length vec)))
2382     (when (> i 0)
2383       (while (and (>= (setq i (1- i)) 0)
2384                   (whitespace-char-valid-p (aref vec i))))
2385       (< i 0))))
2386
2387
2388 (defun whitespace-display-char-on ()
2389   "Turn on character display mapping."
2390   (when (and whitespace-display-mappings
2391              (whitespace-style-mark-p))
2392     (let (vecs vec)
2393       ;; Remember whether a buffer has a local display table.
2394       (unless whitespace-display-table-was-local
2395         (setq whitespace-display-table-was-local t
2396               whitespace-display-table
2397               (copy-sequence buffer-display-table))
2398         ;; Assure `buffer-display-table' is unique
2399         ;; when two or more windows are visible.
2400         (setq buffer-display-table
2401               (copy-sequence buffer-display-table)))
2402       (unless buffer-display-table
2403         (setq buffer-display-table (make-display-table)))
2404       (dolist (entry whitespace-display-mappings)
2405         ;; check if it is to display this mark
2406         (when (memq (car entry) whitespace-style)
2407           ;; Get a displayable mapping.
2408           (setq vecs (cddr entry))
2409           (while (and vecs
2410                       (not (whitespace-display-vector-p (car vecs))))
2411             (setq vecs (cdr vecs)))
2412           ;; Display a valid mapping.
2413           (when vecs
2414             (setq vec (copy-sequence (car vecs)))
2415             ;; NEWLINE char
2416             (when (and (eq (cadr entry) ?\n)
2417                        (memq 'newline whitespace-active-style))
2418               ;; Only insert face bits on NEWLINE char mapping to avoid
2419               ;; obstruction of other faces like TABs and (HARD) SPACEs
2420               ;; faces, font-lock faces, etc.
2421               (dotimes (i (length vec))
2422                 (or (eq (aref vec i) ?\n)
2423                     (aset vec i
2424                           (make-glyph-code (aref vec i)
2425                                            whitespace-newline)))))
2426             ;; Display mapping
2427             (aset buffer-display-table (cadr entry) vec)))))))
2428
2429
2430 (defun whitespace-display-char-off ()
2431   "Turn off character display mapping."
2432   (and whitespace-display-mappings
2433        (whitespace-style-mark-p)
2434        whitespace-display-table-was-local
2435        (setq whitespace-display-table-was-local nil
2436              buffer-display-table whitespace-display-table)))
2437
2438 \f
2439 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2440 ;;;; Hook
2441
2442
2443 (defun whitespace-action-when-on ()
2444   "Action to be taken always when local whitespace is turned on."
2445   (cond ((memq 'cleanup whitespace-action)
2446          (whitespace-cleanup))
2447         ((memq 'report-on-bogus whitespace-action)
2448          (whitespace-report nil t))))
2449
2450
2451 (defun whitespace-write-file-hook ()
2452   "Action to be taken when buffer is written.
2453 It should be added buffer-locally to `write-file-functions'."
2454   (cond ((memq 'auto-cleanup whitespace-action)
2455          (whitespace-cleanup))
2456         ((memq 'abort-on-bogus whitespace-action)
2457          (when (whitespace-report nil t)
2458            (error "Abort write due to whitespace problems in %s"
2459                   (buffer-name)))))
2460   nil)                                  ; continue hook processing
2461
2462
2463 (defun whitespace-warn-read-only (msg)
2464   "Warn if buffer is read-only."
2465   (when (memq 'warn-if-read-only whitespace-action)
2466     (message "Can't %s: %s is read-only" msg (buffer-name))))
2467
2468 \f
2469 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2470
2471
2472 (defun whitespace-unload-function ()
2473   "Unload the whitespace library."
2474   (global-whitespace-mode -1)
2475   ;; be sure all local whitespace mode is turned off
2476   (save-current-buffer
2477     (dolist (buf (buffer-list))
2478       (set-buffer buf)
2479       (whitespace-mode -1)))
2480   nil)                                  ; continue standard unloading
2481
2482
2483 (provide 'whitespace)
2484
2485
2486 (run-hooks 'whitespace-load-hook)
2487
2488
2489 ;;; whitespace.el ends here