lisp/whitespace.el

   1 ;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
   6 ;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
   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 <https://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
 499                         "customize the face `whitespace-tab' instead." "24.4")
 500
 501 (defface whitespace-tab
 502   '((((class color) (background dark))
 503      :background "grey22" :foreground "darkgray")
 504     (((class color) (background light))
 505      :background "beige"  :foreground "lightgray")
 506     (t :inverse-video t))
 507   "Face used to visualize TAB."
 508   :group 'whitespace)
 509
 510
 511 (defvar whitespace-newline 'whitespace-newline
 512   "Symbol face used to visualize NEWLINE char mapping.
 513 See `whitespace-display-mappings'.
 514 Used when `whitespace-style' includes the values `newline-mark'
 515 and `newline'.")
 516 (make-obsolete-variable 'whitespace-newline "use the face instead." "24.4")
 517
 518 (defface whitespace-newline
 519   '((default :weight normal)
 520     (((class color) (background dark)) :foreground "darkgray")
 521     (((class color) (min-colors 88) (background light)) :foreground "lightgray")
 522     ;; Displays with 16 colors use lightgray as background, so using a
 523     ;; lightgray foreground makes the newline mark invisible.
 524     (((class color) (background light)) :foreground "brown")
 525     (t :underline t))
 526   "Face used to visualize NEWLINE char mapping.
 527
 528 See `whitespace-display-mappings'."
 529   :group 'whitespace)
 530
 531
 532 (defvar whitespace-trailing 'whitespace-trailing
 533   "Symbol face used to visualize trailing blanks.
 534 Used when `whitespace-style' includes the value `trailing'.")
 535 (make-obsolete-variable 'whitespace-trailing "use the face instead." "24.4")
 536
 537 (defface whitespace-trailing            ; 'trailing-whitespace
 538   '((default :weight bold)
 539     (((class mono)) :inverse-video t :underline t)
 540     (t :background "red1" :foreground "yellow"))
 541   "Face used to visualize trailing blanks."
 542   :group 'whitespace)
 543
 544
 545 (defvar whitespace-line 'whitespace-line
 546   "Symbol face used to visualize \"long\" lines.
 547 See `whitespace-line-column'.
 548 Used when `whitespace-style' includes the value `line'.")
 549 (make-obsolete-variable 'whitespace-line "use the face instead." "24.4")
 550
 551 (defface whitespace-line
 552   '((((class mono)) :inverse-video t :weight bold :underline t)
 553     (t :background "gray20" :foreground "violet"))
 554   "Face used to visualize \"long\" lines.
 555
 556 See `whitespace-line-column'."
 557   :group 'whitespace)
 558
 559
 560 (defvar whitespace-space-before-tab 'whitespace-space-before-tab
 561   "Symbol face used to visualize SPACEs before TAB.
 562 Used when `whitespace-style' includes the value `space-before-tab'.")
 563 (make-obsolete-variable 'whitespace-space-before-tab
 564                         "use the face instead." "24.4")
 565
 566 (defface whitespace-space-before-tab
 567   '((((class mono)) :inverse-video t :weight bold :underline t)
 568     (t :background "DarkOrange" :foreground "firebrick"))
 569   "Face used to visualize SPACEs before TAB."
 570   :group 'whitespace)
 571
 572
 573 (defvar whitespace-indentation 'whitespace-indentation
 574   "Symbol face used to visualize `tab-width' or more SPACEs at beginning of
 575 line.  Used when `whitespace-style' includes the value `indentation'.")
 576 (make-obsolete-variable 'whitespace-indentation "use the face instead." "24.4")
 577
 578 (defface whitespace-indentation
 579   '((((class mono)) :inverse-video t :weight bold :underline t)
 580     (t :background "yellow" :foreground "firebrick"))
 581   "Face used to visualize `tab-width' or more SPACEs at beginning of line."
 582   :group 'whitespace)
 583
 584 (defface whitespace-big-indent
 585   '((((class mono)) :inverse-video t :weight bold :underline t)
 586     (t :background "red" :foreground "firebrick"))
 587   "Face used to visualize big indentation."
 588   :group 'whitespace)
 589
 590
 591 (defvar whitespace-empty 'whitespace-empty
 592   "Symbol face used to visualize empty lines at beginning and/or end of buffer.
 593 Used when `whitespace-style' includes the value `empty'.")
 594 (make-obsolete-variable 'whitespace-empty "use the face instead." "24.4")
 595
 596 (defface whitespace-empty
 597   '((((class mono)) :inverse-video t :weight bold :underline t)
 598     (t :background "yellow" :foreground "firebrick"))
 599   "Face used to visualize empty lines at beginning and/or end of buffer."
 600   :group 'whitespace)
 601
 602
 603 (defvar whitespace-space-after-tab 'whitespace-space-after-tab
 604   "Symbol face used to visualize `tab-width' or more SPACEs after TAB.
 605 Used when `whitespace-style' includes the value `space-after-tab'.")
 606 (make-obsolete-variable 'whitespace-space-after-tab
 607                         "use the face instead." "24.4")
 608
 609 (defface whitespace-space-after-tab
 610   '((((class mono)) :inverse-video t :weight bold :underline t)
 611     (t :background "yellow" :foreground "firebrick"))
 612   "Face used to visualize `tab-width' or more SPACEs after TAB."
 613   :group 'whitespace)
 614
 615
 616 (defcustom whitespace-hspace-regexp
 617   "\\(\u00A0+\\)"
 618   "Specify HARD SPACE characters regexp.
 619
 620 Here are some examples:
 621
 622    \"\\\\(^\\xA0+\\\\)\"                \
 623 visualize only leading HARD SPACEs.
 624    \"\\\\(\\xA0+$\\\\)\"                \
 625 visualize only trailing HARD SPACEs.
 626    \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\"    \
 627 visualize leading and/or trailing HARD SPACEs.
 628    \"\\t\\\\(\\xA0+\\\\)\\t\"           \
 629 visualize only HARD SPACEs between TABs.
 630
 631 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 632       Use exactly one pair of enclosing \\\\( and \\\\).
 633
 634 Used when `whitespace-style' includes `spaces'."
 635   :type '(regexp :tag "HARD SPACE Chars")
 636   :group 'whitespace)
 637
 638
 639 (defcustom whitespace-space-regexp "\\( +\\)"
 640   "Specify SPACE characters regexp.
 641
 642 If you're using `mule' package, there may be other characters
 643 besides \" \" that should be considered SPACE.
 644
 645 Here are some examples:
 646
 647    \"\\\\(^ +\\\\)\"            visualize only leading SPACEs.
 648    \"\\\\( +$\\\\)\"            visualize only trailing SPACEs.
 649    \"\\\\(^ +\\\\| +$\\\\)\"    \
 650 visualize leading and/or trailing SPACEs.
 651    \"\\t\\\\( +\\\\)\\t\"       visualize only SPACEs between TABs.
 652
 653 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 654       Use exactly one pair of enclosing \\\\( and \\\\).
 655
 656 Used when `whitespace-style' includes `spaces'."
 657   :type '(regexp :tag "SPACE Chars")
 658   :group 'whitespace)
 659
 660
 661 (defcustom whitespace-tab-regexp "\\(\t+\\)"
 662   "Specify TAB characters regexp.
 663
 664 If you're using `mule' package, there may be other characters
 665 besides \"\\t\" that should be considered TAB.
 666
 667 Here are some examples:
 668
 669    \"\\\\(^\\t+\\\\)\"          visualize only leading TABs.
 670    \"\\\\(\\t+$\\\\)\"          visualize only trailing TABs.
 671    \"\\\\(^\\t+\\\\|\\t+$\\\\)\"        \
 672 visualize leading and/or trailing TABs.
 673    \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
 674
 675 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 676       Use exactly one pair of enclosing \\\\( and \\\\).
 677
 678 Used when `whitespace-style' includes `tabs'."
 679   :type '(regexp :tag "TAB Chars")
 680   :group 'whitespace)
 681
 682
 683 (defcustom whitespace-trailing-regexp
 684   "\\([\t \u00A0]+\\)$"
 685   "Specify trailing characters regexp.
 686
 687 There may be other characters besides:
 688
 689    \" \"  \"\\t\"  \"\\u00A0\"
 690
 691 that should be considered blank.
 692
 693 NOTE: Enclose always by \"\\\\(\" and \"\\\\)$\" the elements to highlight.
 694       Use exactly one pair of enclosing elements above.
 695
 696 Used when `whitespace-style' includes `trailing'."
 697   :type '(regexp :tag "Trailing Chars")
 698   :group 'whitespace)
 699
 700
 701 (defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)"
 702   "Specify SPACEs before TAB regexp.
 703
 704 Used when `whitespace-style' includes `space-before-tab',
 705 `space-before-tab::tab' or  `space-before-tab::space'."
 706   :type '(regexp :tag "SPACEs Before TAB")
 707   :group 'whitespace)
 708
 709
 710 (defcustom whitespace-indentation-regexp
 711   '("^\t*\\(\\( \\{%d\\}\\)+\\)[^\n\t]"
 712     . "^ *\\(\t+\\)[^\n]")
 713   "Specify regexp for `tab-width' or more SPACEs at beginning of line.
 714
 715 It is a cons where the cons car is used for SPACEs visualization
 716 and the cons cdr is used for TABs visualization.
 717
 718 Used when `whitespace-style' includes `indentation',
 719 `indentation::tab' or  `indentation::space'."
 720   :type '(cons (string :tag "Indentation SPACEs")
 721                (string :tag "Indentation TABs"))
 722   :group 'whitespace)
 723
 724
 725 (defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
 726   "Specify regexp for empty lines at beginning of buffer.
 727
 728 Used when `whitespace-style' includes `empty'."
 729   :type '(regexp :tag "Empty Lines At Beginning Of Buffer")
 730   :group 'whitespace)
 731
 732
 733 (defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
 734   "Specify regexp for empty lines at end of buffer.
 735
 736 Used when `whitespace-style' includes `empty'."
 737   :type '(regexp :tag "Empty Lines At End Of Buffer")
 738   :group 'whitespace)
 739
 740
 741 (defcustom whitespace-space-after-tab-regexp
 742   '("\t+\\(\\( \\{%d,\\}\\)+\\)"
 743     . "\\(\t+\\) \\{%d,\\}")
 744   "Specify regexp for `tab-width' or more SPACEs after TAB.
 745
 746 It is a cons where the cons car is used for SPACEs visualization
 747 and the cons cdr is used for TABs visualization.
 748
 749 Used when `whitespace-style' includes `space-after-tab',
 750 `space-after-tab::tab' or `space-after-tab::space'."
 751   :type '(cons (string :tag "SPACEs After TAB")
 752                string)
 753   :group 'whitespace)
 754
 755 (defcustom whitespace-big-indent-regexp
 756   "^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)"
 757   "Specify big indentation regexp.
 758
 759 If you're using `mule' package, there may be other characters
 760 besides \"\\t\" that should be considered TAB.
 761
 762 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 763       Use exactly one pair of enclosing \\\\( and \\\\).
 764
 765 Used when `whitespace-style' includes `big-indent'."
 766   :version "25.1"
 767   :type '(regexp :tag "Detect too much indentation at the beginning of a line")
 768   :group 'whitespace)
 769
 770
 771 (defcustom whitespace-line-column 80
 772   "Specify column beyond which the line is highlighted.
 773
 774 It must be an integer or nil.  If nil, the `fill-column' variable value is
 775 used.
 776
 777 Used when `whitespace-style' includes `lines' or `lines-tail'."
 778   :type '(choice :tag "Line Length Limit"
 779                  (integer :tag "Line Length")
 780                  (const :tag "Use fill-column" nil))
 781   :safe  'integerp
 782   :group 'whitespace)
 783
 784
 785 ;; Hacked from `visible-whitespace-mappings' in visws.el
 786 (defcustom whitespace-display-mappings
 787   '(
 788     (space-mark   ?\     [?·]     [?.])                ; space - middle dot
 789     (space-mark   ?\xA0  [?¤]     [?_])                ; hard space - currency sign
 790     ;; NEWLINE is displayed using the face `whitespace-newline'
 791     (newline-mark ?\n    [?$ ?\n])                      ; eol - dollar sign
 792     ;; (newline-mark ?\n    [?↵ ?\n] [?$ ?\n])        ; eol - downwards arrow
 793     ;; (newline-mark ?\n    [?¶ ?\n] [?$ ?\n]) ; eol - pilcrow
 794     ;; (newline-mark ?\n    [?¯ ?\n]  [?$ ?\n])        ; eol - overscore
 795     ;; (newline-mark ?\n    [?¬ ?\n]  [?$ ?\n])        ; eol - negation
 796     ;; (newline-mark ?\n    [?° ?\n]  [?$ ?\n])        ; eol - degrees
 797     ;;
 798     ;; WARNING: the mapping below has a problem.
 799     ;; When a TAB occupies exactly one column, it will display the
 800     ;; character ?\xBB at that column followed by a TAB which goes to
 801     ;; the next TAB column.
 802     ;; If this is a problem for you, please, comment the line below.
 803     (tab-mark     ?\t    [?» ?\t] [?\\ ?\t])   ; tab - right guillemet
 804     )
 805   "Specify an alist of mappings for displaying characters.
 806
 807 Each element has the following form:
 808
 809    (KIND CHAR VECTOR...)
 810
 811 Where:
 812
 813 KIND    is the kind of character.
 814         It can be one of the following symbols:
 815
 816         tab-mark        for TAB character
 817
 818         space-mark      for SPACE or HARD SPACE character
 819
 820         newline-mark    for NEWLINE character
 821
 822 CHAR    is the character to be mapped.
 823
 824 VECTOR  is a vector of characters to be displayed in place of CHAR.
 825         The first display vector that can be displayed is used;
 826         if no display vector for a mapping can be displayed, then
 827         that character is displayed unmodified.
 828
 829 The NEWLINE character is displayed using the face given by
 830 `whitespace-newline' variable.
 831
 832 Used when `whitespace-style' includes `tab-mark', `space-mark' or
 833 `newline-mark'."
 834   :type '(repeat
 835           (list :tag "Character Mapping"
 836                 (choice :tag "Char Kind"
 837                         (const :tag "Tab" tab-mark)
 838                         (const :tag "Space" space-mark)
 839                         (const :tag "Newline" newline-mark))
 840                 (character :tag "Char")
 841                 (repeat :inline t :tag "Vector List"
 842                         (vector :tag ""
 843                                 (repeat :inline t
 844                                         :tag "Vector Characters"
 845                                         (character :tag "Char"))))))
 846   :group 'whitespace)
 847
 848
 849 (defcustom whitespace-global-modes t
 850   "Modes for which global `whitespace-mode' is automagically turned on.
 851
 852 Global `whitespace-mode' is controlled by the command
 853 `global-whitespace-mode'.
 854
 855 If nil, means no modes have `whitespace-mode' automatically
 856 turned on.
 857
 858 If t, all modes that support `whitespace-mode' have it
 859 automatically turned on.
 860
 861 Else it should be a list of `major-mode' symbol names for which
 862 `whitespace-mode' should be automatically turned on.  The sense
 863 of the list is negated if it begins with `not'.  For example:
 864
 865    (c-mode c++-mode)
 866
 867 means that `whitespace-mode' is turned on for buffers in C and
 868 C++ modes only."
 869   :type '(choice :tag "Global Modes"
 870                  (const :tag "None" nil)
 871                  (const :tag "All" t)
 872                  (set :menu-tag "Mode Specific" :tag "Modes"
 873                       :value (not)
 874                       (const :tag "Except" not)
 875                       (repeat :inline t
 876                               (symbol :tag "Mode"))))
 877   :group 'whitespace)
 878
 879
 880 (defcustom whitespace-action nil
 881   "Specify which action is taken when a buffer is visited or written.
 882
 883 It's a list containing some or all of the following values:
 884
 885    nil                  no action is taken.
 886
 887    cleanup              cleanup any bogus whitespace always when local
 888                         whitespace is turned on.
 889                         See `whitespace-cleanup' and
 890                         `whitespace-cleanup-region'.
 891
 892    report-on-bogus      report if there is any bogus whitespace always
 893                         when local whitespace is turned on.
 894
 895    auto-cleanup         cleanup any bogus whitespace when buffer is
 896                         written.
 897                         See `whitespace-cleanup' and
 898                         `whitespace-cleanup-region'.
 899
 900    abort-on-bogus       abort if there is any bogus whitespace and the
 901                         buffer is written.
 902
 903    warn-if-read-only    give a warning if `cleanup' or `auto-cleanup'
 904                         is included in `whitespace-action' and the
 905                         buffer is read-only.
 906
 907 Any other value is treated as nil."
 908   :type '(choice :tag "Actions"
 909                  (const :tag "None" nil)
 910                  (repeat :tag "Action List"
 911                   (choice :tag "Action"
 912                           (const :tag "Cleanup When On" cleanup)
 913                           (const :tag "Report On Bogus" report-on-bogus)
 914                           (const :tag "Auto Cleanup" auto-cleanup)
 915                           (const :tag "Abort On Bogus" abort-on-bogus)
 916                           (const :tag "Warn If Read-Only" warn-if-read-only))))
 917   :group 'whitespace)
 918
 919 \f
 920 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 921 ;;;; User commands - Local mode
 922
 923
 924 ;;;###autoload
 925 (define-minor-mode whitespace-mode
 926   "Toggle whitespace visualization (Whitespace mode).
 927 With a prefix argument ARG, enable Whitespace mode if ARG is
 928 positive, and disable it otherwise.
 929
 930 If called from Lisp, also enables the mode if ARG is omitted or nil,
 931 and toggles it if ARG is `toggle'.
 932
 933 See also `whitespace-style', `whitespace-newline' and
 934 `whitespace-display-mappings'."
 935   :lighter    " ws"
 936   :init-value nil
 937   :global     nil
 938   :group      'whitespace
 939   (cond
 940    (noninteractive                      ; running a batch job
 941     (setq whitespace-mode nil))
 942    (whitespace-mode                     ; whitespace-mode on
 943     (whitespace-turn-on)
 944     (whitespace-action-when-on))
 945    (t                                   ; whitespace-mode off
 946     (whitespace-turn-off))))
 947
 948
 949 ;;;###autoload
 950 (define-minor-mode whitespace-newline-mode
 951   "Toggle newline visualization (Whitespace Newline mode).
 952 With a prefix argument ARG, enable Whitespace Newline mode if ARG
 953 is positive, and disable it otherwise.
 954
 955 If called from Lisp, also enables the mode if ARG is omitted or nil,
 956 and toggles it if ARG is `toggle'.
 957
 958 Use `whitespace-newline-mode' only for NEWLINE visualization
 959 exclusively.  For other visualizations, including NEWLINE
 960 visualization together with (HARD) SPACEs and/or TABs, please,
 961 use `whitespace-mode'.
 962
 963 See also `whitespace-newline' and `whitespace-display-mappings'."
 964   :lighter    " nl"
 965   :init-value nil
 966   :global     nil
 967   :group      'whitespace
 968   (let ((whitespace-style '(face newline-mark newline)))
 969     (whitespace-mode (if whitespace-newline-mode
 970                          1 -1)))
 971   ;; sync states (running a batch job)
 972   (setq whitespace-newline-mode whitespace-mode))
 973
 974 \f
 975 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 976 ;;;; User commands - Global mode
 977
 978
 979 ;;;###autoload
 980 (define-minor-mode global-whitespace-mode
 981   "Toggle whitespace visualization globally (Global Whitespace mode).
 982 With a prefix argument ARG, enable Global Whitespace mode if ARG
 983 is positive, and disable it otherwise.
 984
 985 If called from Lisp, also enables the mode if ARG is omitted or nil,
 986 and toggles it if ARG is `toggle'.
 987
 988 See also `whitespace-style', `whitespace-newline' and
 989 `whitespace-display-mappings'."
 990   :lighter    " WS"
 991   :init-value nil
 992   :global     t
 993   :group      'whitespace
 994   (cond
 995    (noninteractive                      ; running a batch job
 996     (setq global-whitespace-mode nil))
 997    (global-whitespace-mode              ; global-whitespace-mode on
 998     (save-current-buffer
 999       (add-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
1000       (add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
1001       (dolist (buffer (buffer-list))    ; adjust all local mode
1002         (set-buffer buffer)
1003         (unless whitespace-mode
1004           (whitespace-turn-on-if-enabled)))))
1005    (t                                   ; global-whitespace-mode off
1006     (save-current-buffer
1007       (remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
1008       (remove-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
1009       (dolist (buffer (buffer-list))    ; adjust all local mode
1010         (set-buffer buffer)
1011         (unless whitespace-mode
1012           (whitespace-turn-off)))))))
1013
1014 (defvar whitespace-enable-predicate
1015   (lambda ()
1016     (and (cond
1017           ((eq whitespace-global-modes t))
1018           ((listp whitespace-global-modes)
1019            (if (eq (car-safe whitespace-global-modes) 'not)
1020                (not (memq major-mode (cdr whitespace-global-modes)))
1021              (memq major-mode whitespace-global-modes)))
1022           (t nil))
1023          ;; ...we have a display (not running a batch job)
1024          (not noninteractive)
1025          ;; ...the buffer is not internal (name starts with a space)
1026          (not (eq (aref (buffer-name) 0) ?\ ))
1027          ;; ...the buffer is not special (name starts with *)
1028          (or (not (eq (aref (buffer-name) 0) ?*))
1029              ;; except the scratch buffer.
1030              (string= (buffer-name) "*scratch*"))))
1031   "Predicate to decide which buffers obey `global-whitespace-mode'.
1032 This function is called with no argument and should return non-nil
1033 if the current buffer should obey `global-whitespace-mode'.
1034 This variable is normally modified via `add-function'.")
1035
1036 (defun whitespace-turn-on-if-enabled ()
1037   (when (funcall whitespace-enable-predicate)
1038     (whitespace-turn-on)))
1039
1040 ;;;###autoload
1041 (define-minor-mode global-whitespace-newline-mode
1042   "Toggle global newline visualization (Global Whitespace Newline mode).
1043 With a prefix argument ARG, enable Global Whitespace Newline mode
1044 if ARG is positive, and disable it otherwise.
1045
1046 If called from Lisp, also enables the mode if ARG is omitted or nil,
1047 and toggles it if ARG is `toggle'.
1048
1049 Use `global-whitespace-newline-mode' only for NEWLINE
1050 visualization exclusively.  For other visualizations, including
1051 NEWLINE visualization together with (HARD) SPACEs and/or TABs,
1052 please use `global-whitespace-mode'.
1053
1054 See also `whitespace-newline' and `whitespace-display-mappings'."
1055   :lighter    " NL"
1056   :init-value nil
1057   :global     t
1058   :group      'whitespace
1059   (let ((whitespace-style '(newline-mark newline)))
1060     (global-whitespace-mode (if global-whitespace-newline-mode
1061                                 1 -1))
1062     ;; sync states (running a batch job)
1063     (setq global-whitespace-newline-mode global-whitespace-mode)))
1064
1065 \f
1066 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1067 ;;;; User commands - Toggle
1068
1069
1070 (defconst whitespace-style-value-list
1071   '(face
1072     tabs
1073     spaces
1074     trailing
1075     lines
1076     lines-tail
1077     newline
1078     empty
1079     indentation
1080     indentation::tab
1081     indentation::space
1082     big-indent
1083     space-after-tab
1084     space-after-tab::tab
1085     space-after-tab::space
1086     space-before-tab
1087     space-before-tab::tab
1088     space-before-tab::space
1089     help-newline       ; value used by `whitespace-insert-option-mark'
1090     tab-mark
1091     space-mark
1092     newline-mark
1093     )
1094   "List of valid `whitespace-style' values.")
1095
1096
1097 (defconst whitespace-toggle-option-alist
1098   '((?f    . face)
1099     (?t    . tabs)
1100     (?s    . spaces)
1101     (?r    . trailing)
1102     (?l    . lines)
1103     (?L    . lines-tail)
1104     (?n    . newline)
1105     (?e    . empty)
1106     (?\C-i . indentation)
1107     (?I    . indentation::tab)
1108     (?i    . indentation::space)
1109     (?\C-t . big-indent)
1110     (?\C-a . space-after-tab)
1111     (?A    . space-after-tab::tab)
1112     (?a    . space-after-tab::space)
1113     (?\C-b . space-before-tab)
1114     (?B    . space-before-tab::tab)
1115     (?b    . space-before-tab::space)
1116     (?T    . tab-mark)
1117     (?S    . space-mark)
1118     (?N    . newline-mark)
1119     (?x    . whitespace-style)
1120     )
1121   "Alist of toggle options.
1122
1123 Each element has the form:
1124
1125    (CHAR . SYMBOL)
1126
1127 Where:
1128
1129 CHAR    is a char which the user will have to type.
1130
1131 SYMBOL  is a valid symbol associated with CHAR.
1132         See `whitespace-style-value-list'.")
1133
1134
1135 (defvar whitespace-active-style nil
1136   "Used to save locally `whitespace-style' value.")
1137
1138 (defvar whitespace-point (point)
1139   "Used to save locally current point value.
1140 Used by function `whitespace-trailing-regexp' (which see).")
1141 (defvar-local whitespace-point--used nil
1142   "Region whose highlighting depends on `whitespace-point'.")
1143
1144 (defvar whitespace-font-lock-refontify nil
1145   "Used to save locally the font-lock refontify state.
1146 Used by function `whitespace-post-command-hook' (which see).")
1147
1148 (defvar whitespace-bob-marker nil
1149   "Used to save locally the bob marker value.
1150 Used by function `whitespace-post-command-hook' (which see).")
1151
1152 (defvar whitespace-eob-marker nil
1153   "Used to save locally the eob marker value.
1154 Used by function `whitespace-post-command-hook' (which see).")
1155
1156 (defvar whitespace-buffer-changed nil
1157   "Used to indicate locally if buffer changed.
1158 Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
1159 functions (which see).")
1160
1161
1162 ;;;###autoload
1163 (defun whitespace-toggle-options (arg)
1164   "Toggle local `whitespace-mode' options.
1165
1166 If local whitespace-mode is off, toggle the option given by ARG
1167 and turn on local whitespace-mode.
1168
1169 If local whitespace-mode is on, toggle the option given by ARG
1170 and restart local whitespace-mode.
1171
1172 Interactively, it reads one of the following chars:
1173
1174   CHAR  MEANING
1175   (VIA FACES)
1176    f    toggle face visualization
1177    t    toggle TAB visualization
1178    s    toggle SPACE and HARD SPACE visualization
1179    r    toggle trailing blanks visualization
1180    l    toggle \"long lines\" visualization
1181    L    toggle \"long lines\" tail visualization
1182    n    toggle NEWLINE visualization
1183    e    toggle empty line at bob and/or eob visualization
1184    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1185    I    toggle indentation SPACEs visualization
1186    i    toggle indentation TABs visualization
1187    C-t  toggle big indentation visualization
1188    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1189    A    toggle SPACEs after TAB: SPACEs visualization
1190    a    toggle SPACEs after TAB: TABs visualization
1191    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1192    B    toggle SPACEs before TAB: SPACEs visualization
1193    b    toggle SPACEs before TAB: TABs visualization
1194
1195   (VIA DISPLAY TABLE)
1196    T    toggle TAB visualization
1197    S    toggle SPACEs before TAB visualization
1198    N    toggle NEWLINE visualization
1199
1200    x    restore `whitespace-style' value
1201    ?    display brief help
1202
1203 Non-interactively, ARG should be a symbol or a list of symbols.
1204 The valid symbols are:
1205
1206    face                 toggle face visualization
1207    tabs                 toggle TAB visualization
1208    spaces               toggle SPACE and HARD SPACE visualization
1209    trailing             toggle trailing blanks visualization
1210    lines                toggle \"long lines\" visualization
1211    lines-tail           toggle \"long lines\" tail visualization
1212    newline              toggle NEWLINE visualization
1213    empty                toggle empty line at bob and/or eob visualization
1214    indentation          toggle indentation SPACEs visualization
1215    indentation::tab     toggle indentation SPACEs visualization
1216    indentation::space   toggle indentation TABs visualization
1217    big-indent           toggle big indentation visualization
1218    space-after-tab              toggle SPACEs after TAB visualization
1219    space-after-tab::tab         toggle SPACEs after TAB: SPACEs visualization
1220    space-after-tab::space       toggle SPACEs after TAB: TABs visualization
1221    space-before-tab             toggle SPACEs before TAB visualization
1222    space-before-tab::tab        toggle SPACEs before TAB: SPACEs visualization
1223    space-before-tab::space      toggle SPACEs before TAB: TABs visualization
1224
1225    tab-mark             toggle TAB visualization
1226    space-mark           toggle SPACEs before TAB visualization
1227    newline-mark         toggle NEWLINE visualization
1228
1229    whitespace-style     restore `whitespace-style' value
1230
1231 See `whitespace-style' and `indent-tabs-mode' for documentation."
1232   (interactive (whitespace-interactive-char t))
1233   (let ((whitespace-style
1234          (whitespace-toggle-list t arg whitespace-active-style)))
1235     (whitespace-mode 0)
1236     (whitespace-mode 1)))
1237
1238
1239 (defvar whitespace-toggle-style nil
1240   "Used to toggle the global `whitespace-style' value.")
1241
1242
1243 ;;;###autoload
1244 (defun global-whitespace-toggle-options (arg)
1245   "Toggle global `whitespace-mode' options.
1246
1247 If global whitespace-mode is off, toggle the option given by ARG
1248 and turn on global whitespace-mode.
1249
1250 If global whitespace-mode is on, toggle the option given by ARG
1251 and restart global whitespace-mode.
1252
1253 Interactively, it accepts one of the following chars:
1254
1255   CHAR  MEANING
1256   (VIA FACES)
1257    f    toggle face visualization
1258    t    toggle TAB visualization
1259    s    toggle SPACE and HARD SPACE visualization
1260    r    toggle trailing blanks visualization
1261    l    toggle \"long lines\" visualization
1262    L    toggle \"long lines\" tail visualization
1263    n    toggle NEWLINE visualization
1264    e    toggle empty line at bob and/or eob visualization
1265    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1266    I    toggle indentation SPACEs visualization
1267    i    toggle indentation TABs visualization
1268    C-t  toggle big indentation visualization
1269    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1270    A    toggle SPACEs after TAB: SPACEs visualization
1271    a    toggle SPACEs after TAB: TABs visualization
1272    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1273    B    toggle SPACEs before TAB: SPACEs visualization
1274    b    toggle SPACEs before TAB: TABs visualization
1275
1276   (VIA DISPLAY TABLE)
1277    T    toggle TAB visualization
1278    S    toggle SPACEs before TAB visualization
1279    N    toggle NEWLINE visualization
1280
1281    x    restore `whitespace-style' value
1282    ?    display brief help
1283
1284 Non-interactively, ARG should be a symbol or a list of symbols.
1285 The valid symbols are:
1286
1287    face                 toggle face visualization
1288    tabs                 toggle TAB visualization
1289    spaces               toggle SPACE and HARD SPACE visualization
1290    trailing             toggle trailing blanks visualization
1291    lines                toggle \"long lines\" visualization
1292    lines-tail           toggle \"long lines\" tail visualization
1293    newline              toggle NEWLINE visualization
1294    empty                toggle empty line at bob and/or eob visualization
1295    indentation          toggle indentation SPACEs visualization
1296    indentation::tab     toggle indentation SPACEs visualization
1297    indentation::space   toggle indentation TABs visualization
1298    big-indent           toggle big indentation visualization
1299    space-after-tab              toggle SPACEs after TAB visualization
1300    space-after-tab::tab         toggle SPACEs after TAB: SPACEs visualization
1301    space-after-tab::space       toggle SPACEs after TAB: TABs visualization
1302    space-before-tab             toggle SPACEs before TAB visualization
1303    space-before-tab::tab        toggle SPACEs before TAB: SPACEs visualization
1304    space-before-tab::space      toggle SPACEs before TAB: TABs visualization
1305
1306    tab-mark             toggle TAB visualization
1307    space-mark           toggle SPACEs before TAB visualization
1308    newline-mark         toggle NEWLINE visualization
1309
1310    whitespace-style     restore `whitespace-style' value
1311
1312 See `whitespace-style' and `indent-tabs-mode' for documentation."
1313   (interactive (whitespace-interactive-char nil))
1314   (let ((whitespace-style
1315          (whitespace-toggle-list nil arg whitespace-toggle-style)))
1316     (setq whitespace-toggle-style whitespace-style)
1317     (global-whitespace-mode 0)
1318     (global-whitespace-mode 1)))
1319
1320 \f
1321 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1322 ;;;; User commands - Cleanup
1323
1324
1325 ;;;###autoload
1326 (defun whitespace-cleanup ()
1327   "Cleanup some blank problems in all buffer or at region.
1328
1329 It usually applies to the whole buffer, but in transient mark
1330 mode when the mark is active, it applies to the region.  It also
1331 applies to the region when it is not in transient mark mode, the
1332 mark is active and \\[universal-argument] was pressed just before
1333 calling `whitespace-cleanup' interactively.
1334
1335 See also `whitespace-cleanup-region'.
1336
1337 The problems cleaned up are:
1338
1339 1. empty lines at beginning of buffer.
1340 2. empty lines at end of buffer.
1341    If `whitespace-style' includes the value `empty', remove all
1342    empty lines at beginning and/or end of buffer.
1343
1344 3. `tab-width' or more SPACEs at beginning of line.
1345    If `whitespace-style' includes the value `indentation':
1346    replace `tab-width' or more SPACEs at beginning of line by
1347    TABs, if `indent-tabs-mode' is non-nil; otherwise, replace TABs by
1348    SPACEs.
1349    If `whitespace-style' includes the value `indentation::tab',
1350    replace `tab-width' or more SPACEs at beginning of line by TABs.
1351    If `whitespace-style' includes the value `indentation::space',
1352    replace TABs by SPACEs.
1353
1354 4. SPACEs before TAB.
1355    If `whitespace-style' includes the value `space-before-tab':
1356    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1357    otherwise, replace TABs by SPACEs.
1358    If `whitespace-style' includes the value
1359    `space-before-tab::tab', replace SPACEs by TABs.
1360    If `whitespace-style' includes the value
1361    `space-before-tab::space', replace TABs by SPACEs.
1362
1363 5. SPACEs or TABs at end of line.
1364    If `whitespace-style' includes the value `trailing', remove
1365    all SPACEs or TABs at end of line.
1366
1367 6. `tab-width' or more SPACEs after TAB.
1368    If `whitespace-style' includes the value `space-after-tab':
1369    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1370    otherwise, replace TABs by SPACEs.
1371    If `whitespace-style' includes the value
1372    `space-after-tab::tab', replace SPACEs by TABs.
1373    If `whitespace-style' includes the value
1374    `space-after-tab::space', replace TABs by SPACEs.
1375
1376 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
1377 documentation."
1378   (interactive "@")
1379   (cond
1380    ;; read-only buffer
1381    (buffer-read-only
1382     (whitespace-warn-read-only "cleanup"))
1383    ;; region active
1384    ((and (or transient-mark-mode
1385              current-prefix-arg)
1386          mark-active)
1387     ;; PROBLEMs 1 and 2 are not handled in region
1388     ;; PROBLEM 3: `tab-width' or more SPACEs at bol
1389     ;; PROBLEM 4: SPACEs before TAB
1390     ;; PROBLEM 5: SPACEs or TABs at eol
1391     ;; PROBLEM 6: `tab-width' or more SPACEs after TAB
1392     (whitespace-cleanup-region (region-beginning) (region-end)))
1393    ;; whole buffer
1394    (t
1395     (save-excursion
1396       ;; PROBLEM 1: empty lines at bob
1397       ;; PROBLEM 2: empty lines at eob
1398       ;; ACTION: remove all empty lines at bob and/or eob
1399       (when (memq 'empty whitespace-style)
1400         (let (overwrite-mode)           ; enforce no overwrite
1401           (goto-char (point-min))
1402           (when (looking-at whitespace-empty-at-bob-regexp)
1403             (delete-region (match-beginning 1) (match-end 1)))
1404           (when (re-search-forward
1405                  whitespace-empty-at-eob-regexp nil t)
1406             (delete-region (match-beginning 1) (match-end 1))))))
1407     ;; PROBLEM 3: `tab-width' or more SPACEs at bol
1408     ;; PROBLEM 4: SPACEs before TAB
1409     ;; PROBLEM 5: SPACEs or TABs at eol
1410     ;; PROBLEM 6: `tab-width' or more SPACEs after TAB
1411     (whitespace-cleanup-region (point-min) (point-max)))))
1412
1413
1414 ;;;###autoload
1415 (defun whitespace-cleanup-region (start end)
1416   "Cleanup some blank problems at region.
1417
1418 The problems cleaned up are:
1419
1420 1. `tab-width' or more SPACEs at beginning of line.
1421    If `whitespace-style' includes the value `indentation':
1422    replace `tab-width' or more SPACEs at beginning of line by TABs,
1423    if `indent-tabs-mode' is non-nil; otherwise, replace TABs by
1424    SPACEs.
1425    If `whitespace-style' includes the value `indentation::tab',
1426    replace `tab-width' or more SPACEs at beginning of line by TABs.
1427    If `whitespace-style' includes the value `indentation::space',
1428    replace TABs by SPACEs.
1429
1430 2. SPACEs before TAB.
1431    If `whitespace-style' includes the value `space-before-tab':
1432    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1433    otherwise, replace TABs by SPACEs.
1434    If `whitespace-style' includes the value
1435    `space-before-tab::tab', replace SPACEs by TABs.
1436    If `whitespace-style' includes the value
1437    `space-before-tab::space', replace TABs by SPACEs.
1438
1439 3. SPACEs or TABs at end of line.
1440    If `whitespace-style' includes the value `trailing', remove
1441    all SPACEs or TABs at end of line.
1442
1443 4. `tab-width' or more SPACEs after TAB.
1444    If `whitespace-style' includes the value `space-after-tab':
1445    replace SPACEs by TABs, if `indent-tabs-mode' is non-nil;
1446    otherwise, replace TABs by SPACEs.
1447    If `whitespace-style' includes the value
1448    `space-after-tab::tab', replace SPACEs by TABs.
1449    If `whitespace-style' includes the value
1450    `space-after-tab::space', replace TABs by SPACEs.
1451
1452 See `whitespace-style', `indent-tabs-mode' and `tab-width' for
1453 documentation."
1454   (interactive "@r")
1455   (if buffer-read-only
1456       ;; read-only buffer
1457       (whitespace-warn-read-only "cleanup region")
1458     ;; non-read-only buffer
1459     (let ((rstart           (min start end))
1460           (rend             (copy-marker (max start end)))
1461           overwrite-mode                ; enforce no overwrite
1462           tmp)
1463       (save-excursion
1464         ;; PROBLEM 1: `tab-width' or more SPACEs at bol
1465         (cond
1466          ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs, if
1467          ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1468          ;; by SPACEs.
1469          ((memq 'indentation whitespace-style)
1470           (let ((regexp (whitespace-indentation-regexp)))
1471             (goto-char rstart)
1472             (while (re-search-forward regexp rend t)
1473               (setq tmp (current-indentation))
1474               (goto-char (match-beginning 0))
1475               (delete-horizontal-space)
1476               (unless (eolp)
1477                 (indent-to tmp)))))
1478          ;; ACTION: replace `tab-width' or more SPACEs at bol by TABs.
1479          ((memq 'indentation::tab whitespace-style)
1480           (whitespace-replace-action
1481            'tabify rstart rend
1482            (whitespace-indentation-regexp 'tab) 0))
1483          ;; ACTION: replace TABs by SPACEs.
1484          ((memq 'indentation::space whitespace-style)
1485           (whitespace-replace-action
1486            'untabify rstart rend
1487            (whitespace-indentation-regexp 'space) 0)))
1488         ;; PROBLEM 3: SPACEs or TABs at eol
1489         ;; ACTION: remove all SPACEs or TABs at eol
1490         (when (memq 'trailing whitespace-style)
1491           (whitespace-replace-action
1492            'delete-region rstart rend
1493            whitespace-trailing-regexp 1))
1494         ;; PROBLEM 4: `tab-width' or more SPACEs after TAB
1495         (cond
1496          ;; ACTION: replace `tab-width' or more SPACEs by TABs, if
1497          ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1498          ;; by SPACEs.
1499          ((memq 'space-after-tab whitespace-style)
1500           (whitespace-replace-action
1501            (if indent-tabs-mode 'tabify 'untabify)
1502            rstart rend (whitespace-space-after-tab-regexp) 1))
1503          ;; ACTION: replace `tab-width' or more SPACEs by TABs.
1504          ((memq 'space-after-tab::tab whitespace-style)
1505           (whitespace-replace-action
1506            'tabify rstart rend
1507            (whitespace-space-after-tab-regexp 'tab) 1))
1508          ;; ACTION: replace TABs by SPACEs.
1509          ((memq 'space-after-tab::space whitespace-style)
1510           (whitespace-replace-action
1511            'untabify rstart rend
1512            (whitespace-space-after-tab-regexp 'space) 1)))
1513         ;; PROBLEM 2: SPACEs before TAB
1514         (cond
1515          ;; ACTION: replace SPACEs before TAB by TABs, if
1516          ;; `indent-tabs-mode' is non-nil; otherwise, replace TABs
1517          ;; by SPACEs.
1518          ((memq 'space-before-tab whitespace-style)
1519           (whitespace-replace-action
1520            (if indent-tabs-mode 'tabify 'untabify)
1521            rstart rend whitespace-space-before-tab-regexp
1522            (if indent-tabs-mode 0 2)))
1523          ;; ACTION: replace SPACEs before TAB by TABs.
1524          ((memq 'space-before-tab::tab whitespace-style)
1525           (whitespace-replace-action
1526            'tabify rstart rend
1527            whitespace-space-before-tab-regexp 0))
1528          ;; ACTION: replace TABs by SPACEs.
1529          ((memq 'space-before-tab::space whitespace-style)
1530           (whitespace-replace-action
1531            'untabify rstart rend
1532            whitespace-space-before-tab-regexp 2))))
1533       (set-marker rend nil))))          ; point marker to nowhere
1534
1535
1536 (defun whitespace-replace-action (action rstart rend regexp index)
1537   "Do ACTION in the string matched by REGEXP between RSTART and REND.
1538
1539 INDEX is the level group matched by REGEXP and used by ACTION.
1540
1541 See also `tab-width'."
1542   (goto-char rstart)
1543   (while (re-search-forward regexp rend t)
1544     (goto-char (match-end index))
1545     (funcall action (match-beginning index) (match-end index))))
1546
1547 \f
1548 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1549 ;;;; User command - report
1550
1551
1552 (defun whitespace-regexp (regexp &optional kind)
1553   "Return REGEXP depending on `indent-tabs-mode'."
1554   (format
1555    (cond
1556     ((or (eq kind 'tab)
1557          indent-tabs-mode)
1558      (car regexp))
1559     ((or (eq kind 'space)
1560          (not indent-tabs-mode))
1561      (cdr regexp)))
1562    tab-width))
1563
1564
1565 (defun whitespace-indentation-regexp (&optional kind)
1566   "Return the indentation regexp depending on `indent-tabs-mode'."
1567   (whitespace-regexp whitespace-indentation-regexp kind))
1568
1569
1570 (defun whitespace-space-after-tab-regexp (&optional kind)
1571   "Return the space-after-tab regexp depending on `indent-tabs-mode'."
1572   (whitespace-regexp whitespace-space-after-tab-regexp kind))
1573
1574
1575 (defconst whitespace-report-list
1576   (list
1577    (cons 'empty                   whitespace-empty-at-bob-regexp)
1578    (cons 'empty                   whitespace-empty-at-eob-regexp)
1579    (cons 'trailing                whitespace-trailing-regexp)
1580    (cons 'indentation             nil)
1581    (cons 'indentation::tab        nil)
1582    (cons 'indentation::space      nil)
1583    (cons 'space-before-tab        whitespace-space-before-tab-regexp)
1584    (cons 'space-before-tab::tab   whitespace-space-before-tab-regexp)
1585    (cons 'space-before-tab::space whitespace-space-before-tab-regexp)
1586    (cons 'space-after-tab         nil)
1587    (cons 'space-after-tab::tab    nil)
1588    (cons 'space-after-tab::space  nil)
1589    )
1590    "List of whitespace bogus symbol and corresponding regexp.")
1591
1592
1593 (defconst whitespace-report-text
1594   '( ;; `indent-tabs-mode' has non-nil value
1595     "\
1596  Whitespace Report
1597
1598  Current Setting                       Whitespace Problem
1599
1600  empty                    []     []  empty lines at beginning of buffer
1601  empty                    []     []  empty lines at end of buffer
1602  trailing                 []     []  SPACEs or TABs at end of line
1603  indentation              []     []  >= `tab-width' SPACEs at beginning of line
1604  indentation::tab         []     []  >= `tab-width' SPACEs at beginning of line
1605  indentation::space       []     []  TABs at beginning of line
1606  space-before-tab         []     []  SPACEs before TAB
1607  space-before-tab::tab    []     []  SPACEs before TAB: SPACEs
1608  space-before-tab::space  []     []  SPACEs before TAB: TABs
1609  space-after-tab          []     []  >= `tab-width' SPACEs after TAB
1610  space-after-tab::tab     []     []  >= `tab-width' SPACEs after TAB: SPACEs
1611  space-after-tab::space   []     []  >= `tab-width' SPACEs after TAB: TABs
1612
1613  indent-tabs-mode =
1614  tab-width        = \n\n"
1615     . ;; `indent-tabs-mode' has nil value
1616     "\
1617  Whitespace Report
1618
1619  Current Setting                       Whitespace Problem
1620
1621  empty                    []     []  empty lines at beginning of buffer
1622  empty                    []     []  empty lines at end of buffer
1623  trailing                 []     []  SPACEs or TABs at end of line
1624  indentation              []     []  TABs at beginning of line
1625  indentation::tab         []     []  >= `tab-width' SPACEs at beginning of line
1626  indentation::space       []     []  TABs at beginning of line
1627  space-before-tab         []     []  SPACEs before TAB
1628  space-before-tab::tab    []     []  SPACEs before TAB: SPACEs
1629  space-before-tab::space  []     []  SPACEs before TAB: TABs
1630  space-after-tab          []     []  >= `tab-width' SPACEs after TAB
1631  space-after-tab::tab     []     []  >= `tab-width' SPACEs after TAB: SPACEs
1632  space-after-tab::space   []     []  >= `tab-width' SPACEs after TAB: TABs
1633
1634  indent-tabs-mode =
1635  tab-width        = \n\n")
1636   "Text for whitespace bogus report.
1637
1638 It is a cons of strings, where the car part is used when
1639 `indent-tabs-mode' is non-nil, and the cdr part is used when
1640 `indent-tabs-mode' is nil.")
1641
1642
1643 (defconst whitespace-report-buffer-name "*Whitespace Report*"
1644   "The buffer name for whitespace bogus report.")
1645
1646
1647 ;;;###autoload
1648 (defun whitespace-report (&optional force report-if-bogus)
1649   "Report some whitespace problems in buffer.
1650
1651 Perform `whitespace-report-region' on the current buffer."
1652   (interactive (list current-prefix-arg))
1653   (whitespace-report-region (point-min) (point-max)
1654                             force report-if-bogus))
1655
1656
1657 ;;;###autoload
1658 (defun whitespace-report-region (start end &optional force report-if-bogus)
1659   "Report some whitespace problems in a region.
1660
1661 Return nil if there is no whitespace problem; otherwise, return
1662 non-nil.
1663
1664 If FORCE is non-nil or \\[universal-argument] was pressed just
1665 before calling `whitespace-report-region' interactively, it
1666 forces all classes of whitespace problem to be considered
1667 significant.
1668
1669 If REPORT-IF-BOGUS is t, it reports only when there are any
1670 whitespace problems in buffer; if it is `never', it does not
1671 report problems.
1672
1673 Report if some of the following whitespace problems exist:
1674
1675 * If `indent-tabs-mode' is non-nil:
1676    empty                1. empty lines at beginning of buffer.
1677    empty                2. empty lines at end of buffer.
1678    trailing             3. SPACEs or TABs at end of line.
1679    indentation          4. line starts with `tab-width' or more SPACEs.
1680    space-before-tab     5. SPACEs before TAB.
1681    space-after-tab      6. `tab-width' or more SPACEs after TAB.
1682
1683 * If `indent-tabs-mode' is nil:
1684    empty                1. empty lines at beginning of buffer.
1685    empty                2. empty lines at end of buffer.
1686    trailing             3. SPACEs or TABs at end of line.
1687    indentation          4. TABS at beginning of line.
1688    space-before-tab     5. SPACEs before TAB.
1689    space-after-tab      6. `tab-width' or more SPACEs after TAB.
1690
1691 See `whitespace-style' for documentation.
1692 See also `whitespace-cleanup' and `whitespace-cleanup-region' for
1693 cleaning up these problems."
1694   (interactive "r")
1695   (setq force (or current-prefix-arg force))
1696   (save-excursion
1697     (let* ((has-bogus nil)
1698            (rstart    (min start end))
1699            (rend      (max start end))
1700            ;; Fall back to whitespace-style so we can run before
1701            ;; before the mode is active.
1702            (style     (copy-sequence
1703                        (or whitespace-active-style whitespace-style)))
1704            (bogus-list
1705             (mapcar
1706              #'(lambda (option)
1707                  (when force
1708                    (add-to-list 'style (car option)))
1709                  (goto-char rstart)
1710                  (let ((regexp
1711                         (cond
1712                          ((eq (car option) 'indentation)
1713                           (whitespace-indentation-regexp))
1714                          ((eq (car option) 'indentation::tab)
1715                           (whitespace-indentation-regexp 'tab))
1716                          ((eq (car option) 'indentation::space)
1717                           (whitespace-indentation-regexp 'space))
1718                          ((eq (car option) 'space-after-tab)
1719                           (whitespace-space-after-tab-regexp))
1720                          ((eq (car option) 'space-after-tab::tab)
1721                           (whitespace-space-after-tab-regexp 'tab))
1722                          ((eq (car option) 'space-after-tab::space)
1723                           (whitespace-space-after-tab-regexp 'space))
1724                          (t
1725                           (cdr option)))))
1726                    (when (re-search-forward regexp rend t)
1727                      (unless has-bogus
1728                        (setq has-bogus (memq (car option) style)))
1729                      t)))
1730              whitespace-report-list)))
1731       (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus))
1732         (whitespace-kill-buffer whitespace-report-buffer-name)
1733         ;; `indent-tabs-mode' may be local to current buffer
1734         ;; `tab-width' may be local to current buffer
1735         (let ((ws-indent-tabs-mode indent-tabs-mode)
1736               (ws-tab-width tab-width))
1737           (with-current-buffer (get-buffer-create
1738                                 whitespace-report-buffer-name)
1739             (erase-buffer)
1740             (insert (if ws-indent-tabs-mode
1741                         (car whitespace-report-text)
1742                       (cdr whitespace-report-text)))
1743             (goto-char (point-min))
1744             (forward-line 3)
1745             (dolist (option whitespace-report-list)
1746               (forward-line 1)
1747               (whitespace-mark-x
1748                27 (memq (car option) style))
1749               (whitespace-mark-x 7 (car bogus-list))
1750               (setq bogus-list (cdr bogus-list)))
1751             (forward-line 1)
1752             (whitespace-insert-value ws-indent-tabs-mode)
1753             (whitespace-insert-value ws-tab-width)
1754             (when has-bogus
1755               (goto-char (point-max))
1756               (insert (substitute-command-keys
1757                        " Type `\\[whitespace-cleanup]'")
1758                       " to cleanup the buffer.\n\n"
1759                       (substitute-command-keys
1760                        " Type `\\[whitespace-cleanup-region]'")
1761                       " to cleanup a region.\n\n"))
1762             (whitespace-display-window (current-buffer)))))
1763       has-bogus)))
1764
1765 \f
1766 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1767 ;;;; Internal functions
1768
1769
1770 (defvar whitespace-font-lock-keywords nil
1771   "Used to save the value `whitespace-color-on' adds to `font-lock-keywords'.")
1772
1773
1774 (defconst whitespace-help-text
1775   "\
1776  Whitespace Toggle Options                  | scroll up  :  SPC   or > |
1777                                             | scroll down:  M-SPC or < |
1778  FACES                                      \\__________________________/
1779  []  f   - toggle face visualization
1780  []  t   - toggle TAB visualization
1781  []  s   - toggle SPACE and HARD SPACE visualization
1782  []  r   - toggle trailing blanks visualization
1783  []  l   - toggle \"long lines\" visualization
1784  []  L   - toggle \"long lines\" tail visualization
1785  []  n   - toggle NEWLINE visualization
1786  []  e   - toggle empty line at bob and/or eob visualization
1787  []  C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode')
1788  []  I   - toggle indentation SPACEs visualization
1789  []  i   - toggle indentation TABs visualization
1790  []  C-t - toggle big indentation visualization
1791  []  C-a - toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1792  []  A   - toggle SPACEs after TAB: SPACEs visualization
1793  []  a   - toggle SPACEs after TAB: TABs visualization
1794  []  C-b - toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1795  []  B   - toggle SPACEs before TAB: SPACEs visualization
1796  []  b   - toggle SPACEs before TAB: TABs visualization
1797
1798  DISPLAY TABLE
1799  []  T - toggle TAB visualization
1800  []  S - toggle SPACE and HARD SPACE visualization
1801  []  N - toggle NEWLINE visualization
1802
1803       x - restore `whitespace-style' value
1804
1805       ? - display this text\n\n"
1806   "Text for whitespace toggle options.")
1807
1808
1809 (defconst whitespace-help-buffer-name "*Whitespace Toggle Options*"
1810   "The buffer name for whitespace toggle options.")
1811
1812
1813 (defun whitespace-insert-value (value)
1814   "Insert VALUE at column 20 of next line."
1815   (forward-line 1)
1816   (move-to-column 20 t)
1817   (insert (format "%s" value)))
1818
1819
1820 (defun whitespace-mark-x (nchars condition)
1821   "Insert the mark (`X' or ` ') after NCHARS depending on CONDITION."
1822   (forward-char nchars)
1823   (insert (if condition "X" " ")))
1824
1825
1826 (defun whitespace-insert-option-mark (the-list the-value)
1827   "Insert the option mark (`X' or ` ') in toggle options buffer."
1828   (goto-char (point-min))
1829   (forward-line 2)
1830   (dolist (sym  the-list)
1831     (if (eq sym 'help-newline)
1832         (forward-line 2)
1833       (forward-line 1)
1834       (whitespace-mark-x 2 (memq sym the-value)))))
1835
1836
1837 (defun whitespace-help-on (style)
1838   "Display the whitespace toggle options."
1839   (unless (get-buffer whitespace-help-buffer-name)
1840     (delete-other-windows)
1841     (let ((buffer (get-buffer-create whitespace-help-buffer-name)))
1842       (with-current-buffer buffer
1843         (erase-buffer)
1844         (insert whitespace-help-text)
1845         (whitespace-insert-option-mark
1846          whitespace-style-value-list style)
1847         (whitespace-display-window buffer)))))
1848
1849
1850 (defun whitespace-display-window (buffer)
1851   "Display BUFFER in a new window."
1852   (goto-char (point-min))
1853   (set-buffer-modified-p nil)
1854   (when (< (window-height) (* 2 window-min-height))
1855     (kill-buffer buffer)
1856     (error "Window height is too small; \
1857 can't split window to display whitespace toggle options"))
1858   (let ((win (split-window)))
1859     (set-window-buffer win buffer)
1860     (shrink-window-if-larger-than-buffer win)))
1861
1862
1863 (defun whitespace-kill-buffer (buffer-name)
1864   "Kill buffer BUFFER-NAME and windows related with it."
1865   (let ((buffer (get-buffer buffer-name)))
1866     (when buffer
1867       (delete-windows-on buffer)
1868       (kill-buffer buffer))))
1869
1870
1871 (defun whitespace-help-off ()
1872   "Remove the buffer and window of the whitespace toggle options."
1873   (whitespace-kill-buffer whitespace-help-buffer-name))
1874
1875
1876 (defun whitespace-help-scroll (&optional up)
1877   "Scroll help window, if it exists.
1878
1879 If UP is non-nil, scroll up; otherwise, scroll down."
1880   (condition-case nil
1881       (let ((buffer (get-buffer whitespace-help-buffer-name)))
1882         (if buffer
1883             (with-selected-window (get-buffer-window buffer)
1884               (if up
1885                   (scroll-up 3)
1886                 (scroll-down 3)))
1887           (ding)))
1888     ;; handler
1889     ((error)
1890      ;; just ignore error
1891      )))
1892
1893
1894 (defun whitespace-interactive-char (local-p)
1895   "Interactive function to read a char and return a symbol.
1896
1897 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1898 uses a global context.
1899
1900 It accepts one of the following chars:
1901
1902   CHAR  MEANING
1903   (VIA FACES)
1904    f    toggle face visualization
1905    t    toggle TAB visualization
1906    s    toggle SPACE and HARD SPACE visualization
1907    r    toggle trailing blanks visualization
1908    l    toggle \"long lines\" visualization
1909    L    toggle \"long lines\" tail visualization
1910    n    toggle NEWLINE visualization
1911    e    toggle empty line at bob and/or eob visualization
1912    C-i  toggle indentation SPACEs visualization (via `indent-tabs-mode')
1913    I    toggle indentation SPACEs visualization
1914    i    toggle indentation TABs visualization
1915    C-a  toggle SPACEs after TAB visualization (via `indent-tabs-mode')
1916    A    toggle SPACEs after TAB: SPACEs visualization
1917    a    toggle SPACEs after TAB: TABs visualization
1918    C-b  toggle SPACEs before TAB visualization (via `indent-tabs-mode')
1919    B    toggle SPACEs before TAB: SPACEs visualization
1920    b    toggle SPACEs before TAB: TABs visualization
1921
1922   (VIA DISPLAY TABLE)
1923    T    toggle TAB visualization
1924    S    toggle SPACE and HARD SPACE visualization
1925    N    toggle NEWLINE visualization
1926
1927    x    restore `whitespace-style' value
1928    ?    display brief help
1929
1930 See also `whitespace-toggle-option-alist'."
1931   (let* ((is-off (not (if local-p
1932                           whitespace-mode
1933                         global-whitespace-mode)))
1934          (style  (cond (is-off  whitespace-style) ; use default value
1935                        (local-p whitespace-active-style)
1936                        (t       whitespace-toggle-style)))
1937          (prompt
1938           (format "Whitespace Toggle %s (type ? for further options)-"
1939                   (if local-p "Local" "Global")))
1940          ch sym)
1941     ;; read a valid option and get the corresponding symbol
1942     (save-window-excursion
1943       (condition-case data
1944           (progn
1945             (while
1946                 ;; while condition
1947                 (progn
1948                   (setq ch (read-char prompt))
1949                   (not
1950                    (setq sym
1951                          (cdr
1952                           (assq ch whitespace-toggle-option-alist)))))
1953               ;; while body
1954               (cond
1955                ((eq ch ?\?)   (whitespace-help-on style))
1956                ((eq ch ?\ )   (whitespace-help-scroll t))
1957                ((eq ch ?\M- ) (whitespace-help-scroll))
1958                ((eq ch ?>)    (whitespace-help-scroll t))
1959                ((eq ch ?<)    (whitespace-help-scroll))
1960                (t             (ding))))
1961             (whitespace-help-off)
1962             (message " "))              ; clean echo area
1963         ;; handler
1964         ((quit error)
1965          (whitespace-help-off)
1966          (error (error-message-string data)))))
1967     (list sym)))                        ; return the appropriate symbol
1968
1969
1970 (defun whitespace-toggle-list (local-p arg the-list)
1971   "Toggle options in THE-LIST based on list ARG.
1972
1973 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1974 uses a global context.
1975
1976 ARG is a list of options to be toggled.
1977
1978 THE-LIST is a list of options.  This list will be toggled and the
1979 resultant list will be returned."
1980   (unless (if local-p whitespace-mode global-whitespace-mode)
1981     (setq the-list whitespace-style))
1982   (setq the-list (copy-sequence the-list)) ; keep original list
1983   (dolist (sym (if (listp arg) arg (list arg)))
1984     (cond
1985      ;; ignore help value
1986      ((eq sym 'help-newline))
1987      ;; restore default values
1988      ((eq sym 'whitespace-style)
1989       (setq the-list whitespace-style))
1990      ;; toggle valid values
1991      ((memq sym whitespace-style-value-list)
1992       (setq the-list (if (memq sym the-list)
1993                          (delq sym the-list)
1994                        (cons sym the-list))))))
1995   the-list)
1996
1997
1998 (defvar whitespace-display-table nil
1999   "Used to save a local display table.")
2000
2001 (defvar whitespace-display-table-was-local nil
2002   "Used to remember whether a buffer initially had a local display table.")
2003
2004 (defun whitespace-turn-on ()
2005   "Turn on whitespace visualization."
2006   ;; prepare local hooks
2007   (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
2008   ;; create whitespace local buffer environment
2009   (set (make-local-variable 'whitespace-font-lock-keywords) nil)
2010   (set (make-local-variable 'whitespace-display-table) nil)
2011   (set (make-local-variable 'whitespace-display-table-was-local) nil)
2012   (set (make-local-variable 'whitespace-active-style)
2013        (if (listp whitespace-style)
2014            whitespace-style
2015          (list whitespace-style)))
2016   ;; turn on whitespace
2017   (when whitespace-active-style
2018     (whitespace-color-on)
2019     (whitespace-display-char-on)))
2020
2021
2022 (defun whitespace-turn-off ()
2023   "Turn off whitespace visualization."
2024   (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
2025   (when whitespace-active-style
2026     (whitespace-color-off)
2027     (whitespace-display-char-off)))
2028
2029
2030 (defun whitespace-style-face-p ()
2031   "Return t if there is some visualization via face."
2032   (and (memq 'face whitespace-active-style)
2033        (or (memq 'tabs                    whitespace-active-style)
2034            (memq 'spaces                  whitespace-active-style)
2035            (memq 'trailing                whitespace-active-style)
2036            (memq 'lines                   whitespace-active-style)
2037            (memq 'lines-tail              whitespace-active-style)
2038            (memq 'newline                 whitespace-active-style)
2039            (memq 'empty                   whitespace-active-style)
2040            (memq 'indentation             whitespace-active-style)
2041            (memq 'indentation::tab        whitespace-active-style)
2042            (memq 'indentation::space      whitespace-active-style)
2043            (memq 'big-indent              whitespace-active-style)
2044            (memq 'space-after-tab         whitespace-active-style)
2045            (memq 'space-after-tab::tab    whitespace-active-style)
2046            (memq 'space-after-tab::space  whitespace-active-style)
2047            (memq 'space-before-tab        whitespace-active-style)
2048            (memq 'space-before-tab::tab   whitespace-active-style)
2049            (memq 'space-before-tab::space whitespace-active-style))))
2050
2051
2052 (defun whitespace-color-on ()
2053   "Turn on color visualization."
2054   (when (whitespace-style-face-p)
2055     ;; save current point and refontify when necessary
2056     (set (make-local-variable 'whitespace-point)
2057          (point))
2058     (setq whitespace-point--used
2059           (let ((ol (make-overlay (point) (point) nil nil t)))
2060             (delete-overlay ol) ol))
2061     (set (make-local-variable 'whitespace-font-lock-refontify)
2062          0)
2063     (set (make-local-variable 'whitespace-bob-marker)
2064          (point-min-marker))
2065     (set (make-local-variable 'whitespace-eob-marker)
2066          (point-max-marker))
2067     (set (make-local-variable 'whitespace-buffer-changed)
2068          nil)
2069     (add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
2070     (add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
2071     ;; Add whitespace-mode color into font lock.
2072     (setq
2073      whitespace-font-lock-keywords
2074      `(
2075        (whitespace-point--flush-used)
2076        ,@(when (memq 'spaces whitespace-active-style)
2077            ;; Show SPACEs.
2078            `((,whitespace-space-regexp 1 whitespace-space t)
2079              ;; Show HARD SPACEs.
2080              (,whitespace-hspace-regexp 1 whitespace-hspace t)))
2081        ,@(when (memq 'tabs whitespace-active-style)
2082            ;; Show TABs.
2083            `((,whitespace-tab-regexp 1 whitespace-tab t)))
2084        ,@(when (memq 'trailing whitespace-active-style)
2085            ;; Show trailing blanks.
2086            `((,#'whitespace-trailing-regexp 1 whitespace-trailing t)))
2087        ,@(when (or (memq 'lines      whitespace-active-style)
2088                    (memq 'lines-tail whitespace-active-style))
2089            ;; Show "long" lines.
2090            `((,(let ((line-column (or whitespace-line-column fill-column)))
2091                  (format
2092                   "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
2093                   tab-width
2094                   (1- tab-width)
2095                   (/ line-column tab-width)
2096                   (let ((rem (% line-column tab-width)))
2097                     (if (zerop rem)
2098                         ""
2099                       (format ".\\{%d\\}" rem)))))
2100               ,(if (memq 'lines whitespace-active-style)
2101                    0                    ; whole line
2102                  2)                     ; line tail
2103               whitespace-line prepend)))
2104        ,@(when (or (memq 'space-before-tab whitespace-active-style)
2105                    (memq 'space-before-tab::tab whitespace-active-style)
2106                    (memq 'space-before-tab::space whitespace-active-style))
2107            `((,whitespace-space-before-tab-regexp
2108               ,(cond
2109                 ((memq 'space-before-tab whitespace-active-style)
2110                  ;; Show SPACEs before TAB (indent-tabs-mode).
2111                  (if indent-tabs-mode 1 2))
2112                 ((memq 'space-before-tab::tab whitespace-active-style)
2113                  1)
2114                 ((memq 'space-before-tab::space whitespace-active-style)
2115                  2))
2116               whitespace-space-before-tab t)))
2117        ,@(when (or (memq 'indentation whitespace-active-style)
2118                    (memq 'indentation::tab whitespace-active-style)
2119                    (memq 'indentation::space whitespace-active-style))
2120            `((,(cond
2121                 ((memq 'indentation whitespace-active-style)
2122                  ;; Show indentation SPACEs (indent-tabs-mode).
2123                  (whitespace-indentation-regexp))
2124                 ((memq 'indentation::tab whitespace-active-style)
2125                  ;; Show indentation SPACEs (SPACEs).
2126                  (whitespace-indentation-regexp 'tab))
2127                 ((memq 'indentation::space whitespace-active-style)
2128                  ;; Show indentation SPACEs (TABs).
2129                  (whitespace-indentation-regexp 'space)))
2130               1 whitespace-indentation t)))
2131        ,@(when (memq 'big-indent whitespace-active-style)
2132            ;; Show big indentation.
2133            `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t)))
2134        ,@(when (memq 'empty whitespace-active-style)
2135            ;; Show empty lines at beginning of buffer.
2136            `((,#'whitespace-empty-at-bob-regexp
2137               1 whitespace-empty t)
2138              ;; Show empty lines at end of buffer.
2139              (,#'whitespace-empty-at-eob-regexp
2140               1 whitespace-empty t)))
2141        ,@(when (or (memq 'space-after-tab whitespace-active-style)
2142                    (memq 'space-after-tab::tab whitespace-active-style)
2143                    (memq 'space-after-tab::space whitespace-active-style))
2144            `((,(cond
2145                 ((memq 'space-after-tab whitespace-active-style)
2146                  ;; Show SPACEs after TAB (indent-tabs-mode).
2147                  (whitespace-space-after-tab-regexp))
2148                 ((memq 'space-after-tab::tab whitespace-active-style)
2149                  ;; Show SPACEs after TAB (SPACEs).
2150                  (whitespace-space-after-tab-regexp 'tab))
2151                 ((memq 'space-after-tab::space whitespace-active-style)
2152                  ;; Show SPACEs after TAB (TABs).
2153                  (whitespace-space-after-tab-regexp 'space)))
2154               1 whitespace-space-after-tab t)))))
2155     (font-lock-add-keywords nil whitespace-font-lock-keywords t)
2156     (font-lock-flush)))
2157
2158
2159 (defun whitespace-color-off ()
2160   "Turn off color visualization."
2161   ;; turn off font lock
2162   (kill-local-variable 'whitespace-point--used)
2163   (when (whitespace-style-face-p)
2164     (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
2165     (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
2166     (font-lock-remove-keywords nil whitespace-font-lock-keywords)
2167     (font-lock-flush)))
2168
2169 (defun whitespace-point--used (start end)
2170   (let ((ostart (overlay-start whitespace-point--used)))
2171     (if ostart
2172         (move-overlay whitespace-point--used
2173                       (min start ostart)
2174                       (max end (overlay-end whitespace-point--used)))
2175       (move-overlay whitespace-point--used start end))))
2176
2177 (defun whitespace-point--flush-used (limit)
2178   (let ((ostart (overlay-start whitespace-point--used)))
2179     ;; Strip parts of whitespace-point--used we're about to refresh.
2180     (when ostart
2181       (let ((oend (overlay-end whitespace-point--used)))
2182         (if (<= (point) ostart)
2183             (if (<= oend limit)
2184                 (delete-overlay whitespace-point--used)
2185               (move-overlay whitespace-point--used limit oend)))
2186         (if (<= oend limit)
2187             (move-overlay whitespace-point--used ostart (point))))))
2188   nil)
2189
2190 (defun whitespace-trailing-regexp (limit)
2191   "Match trailing spaces which do not contain the point at end of line."
2192   (let ((status t))
2193     (while (if (re-search-forward whitespace-trailing-regexp limit t)
2194                (when (= whitespace-point (match-end 1)) ; Loop if point at eol.
2195                  (whitespace-point--used (match-beginning 0) (match-end 0))
2196                  t)
2197              (setq status nil)))                  ;; end of buffer
2198     status))
2199
2200
2201 (defun whitespace-empty-at-bob-regexp (limit)
2202   "Match spaces at beginning of buffer which do not contain the point at \
2203 beginning of buffer."
2204   (let ((b (point))
2205         r)
2206     (cond
2207      ;; at bob
2208      ((= b 1)
2209       (setq r (and (looking-at whitespace-empty-at-bob-regexp)
2210                    (or (/= whitespace-point 1)
2211                        (progn (whitespace-point--used (match-beginning 0)
2212                                                       (match-end 0))
2213                               nil))))
2214       (set-marker whitespace-bob-marker (if r (match-end 1) b)))
2215      ;; inside bob empty region
2216      ((<= limit whitespace-bob-marker)
2217       (setq r (looking-at whitespace-empty-at-bob-regexp))
2218       (if r
2219           (when (< (match-end 1) limit)
2220             (set-marker whitespace-bob-marker (match-end 1)))
2221         (set-marker whitespace-bob-marker b)))
2222      ;; intersection with end of bob empty region
2223      ((<= b whitespace-bob-marker)
2224       (setq r (looking-at whitespace-empty-at-bob-regexp))
2225       (set-marker whitespace-bob-marker (if r (match-end 1) b)))
2226      ;; it is not inside bob empty region
2227      (t
2228       (setq r nil)))
2229     ;; move to end of matching
2230     (and r (goto-char (match-end 1)))
2231     r))
2232
2233
2234 (defsubst whitespace-looking-back (regexp limit)
2235   (save-excursion
2236     (when (/= 0 (skip-chars-backward " \t\n" limit))
2237       (unless (bolp)
2238         (forward-line 1))
2239       (looking-at regexp))))
2240
2241
2242 (defun whitespace-empty-at-eob-regexp (limit)
2243   "Match spaces at end of buffer which do not contain the point at end of \
2244 buffer."
2245   (let ((b (point))
2246         (e (1+ (buffer-size)))
2247         r)
2248     (cond
2249      ;; at eob
2250      ((= limit e)
2251       (goto-char limit)
2252       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2253       (when (and r (= whitespace-point e))
2254         (setq r nil)
2255         (whitespace-point--used (match-beginning 0) (match-end 0)))
2256       (if r
2257           (set-marker whitespace-eob-marker (match-beginning 1))
2258         (set-marker whitespace-eob-marker limit)
2259         (goto-char b)))                 ; return back to initial position
2260      ;; inside eob empty region
2261      ((>= b whitespace-eob-marker)
2262       (goto-char limit)
2263       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2264       (if r
2265           (when (> (match-beginning 1) b)
2266             (set-marker whitespace-eob-marker (match-beginning 1)))
2267         (set-marker whitespace-eob-marker limit)
2268         (goto-char b)))                 ; return back to initial position
2269      ;; intersection with beginning of eob empty region
2270      ((>= limit whitespace-eob-marker)
2271       (goto-char limit)
2272       (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
2273       (if r
2274           (set-marker whitespace-eob-marker (match-beginning 1))
2275         (set-marker whitespace-eob-marker limit)
2276         (goto-char b)))                 ; return back to initial position
2277      ;; it is not inside eob empty region
2278      (t
2279       (setq r nil)))
2280     r))
2281
2282
2283 (defun whitespace-buffer-changed (_beg _end)
2284   "Set `whitespace-buffer-changed' variable to t."
2285   (setq whitespace-buffer-changed t))
2286
2287
2288 (defun whitespace-post-command-hook ()
2289   "Save current point into `whitespace-point' variable.
2290 Also refontify when necessary."
2291   (unless (and (eq whitespace-point (point))
2292                (not whitespace-buffer-changed))
2293     (setq whitespace-point (point))     ; current point position
2294     (let ((refontify
2295            (cond
2296             ;; It is at end of buffer (eob).
2297             ((= whitespace-point (1+ (buffer-size)))
2298              (when (whitespace-looking-back whitespace-empty-at-eob-regexp
2299                                             nil)
2300                (match-beginning 0)))
2301             ;; It is at end of line ...
2302             ((and (eolp)
2303                   ;; ... with trailing SPACE or TAB
2304                   (or (memq (preceding-char) '(?\s ?\t))))
2305              (line-beginning-position))
2306             ;; It is at beginning of buffer (bob).
2307             ((and (= whitespace-point 1)
2308                   (looking-at whitespace-empty-at-bob-regexp))
2309              (match-end 0))))
2310           (ostart (overlay-start whitespace-point--used)))
2311       (cond
2312        ((not refontify)
2313         ;; New point does not affect highlighting: just refresh the
2314         ;; highlighting of old point, if needed.
2315         (when ostart
2316           (font-lock-flush ostart
2317                            (overlay-end whitespace-point--used))
2318           (delete-overlay whitespace-point--used)))
2319        ((not ostart)
2320         ;; Old point did not affect highlighting, but new one does: refresh the
2321         ;; highlighting of new point.
2322         (font-lock-flush (min refontify (point)) (max refontify (point))))
2323        ((save-excursion
2324           (goto-char ostart)
2325           (setq ostart (line-beginning-position))
2326           (and (<= ostart (max refontify (point)))
2327                (progn
2328                  (goto-char (overlay-end whitespace-point--used))
2329                  (let ((oend (line-beginning-position 2)))
2330                    (<= (min refontify (point)) oend)))))
2331         ;; The old point highlighting and the new point highlighting
2332         ;; cover a contiguous region: do a single refresh.
2333         (font-lock-flush (min refontify (point) ostart)
2334                          (max refontify (point)
2335                               (overlay-end whitespace-point--used)))
2336         (delete-overlay whitespace-point--used))
2337        (t
2338         (font-lock-flush (min refontify (point))
2339                          (max refontify (point)))
2340         (font-lock-flush ostart (overlay-end whitespace-point--used))
2341         (delete-overlay whitespace-point--used))))))
2342
2343 \f
2344 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2345 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
2346
2347
2348 (defun whitespace-style-mark-p ()
2349   "Return t if there is some visualization via display table."
2350   (or (memq 'tab-mark     whitespace-active-style)
2351       (memq 'space-mark   whitespace-active-style)
2352       (memq 'newline-mark whitespace-active-style)))
2353
2354
2355 (defsubst whitespace-char-valid-p (char)
2356   ;; This check should be improved!!!
2357   (or (< char 256)
2358       (characterp char)))
2359
2360
2361 (defun whitespace-display-vector-p (vec)
2362   "Return true if every character in vector VEC can be displayed."
2363   (let ((i (length vec)))
2364     (when (> i 0)
2365       (while (and (>= (setq i (1- i)) 0)
2366                   (whitespace-char-valid-p (aref vec i))))
2367       (< i 0))))
2368
2369
2370 (defun whitespace-display-char-on ()
2371   "Turn on character display mapping."
2372   (when (and whitespace-display-mappings
2373              (whitespace-style-mark-p))
2374     (let (vecs vec)
2375       ;; Remember whether a buffer has a local display table.
2376       (unless whitespace-display-table-was-local
2377         (setq whitespace-display-table-was-local t)
2378         (unless (or whitespace-mode global-whitespace-mode)
2379               (setq whitespace-display-table
2380               (copy-sequence buffer-display-table)))
2381         ;; Assure `buffer-display-table' is unique
2382         ;; when two or more windows are visible.
2383         (setq buffer-display-table
2384               (copy-sequence buffer-display-table)))
2385       (unless buffer-display-table
2386         (setq buffer-display-table (make-display-table)))
2387       (dolist (entry whitespace-display-mappings)
2388         ;; check if it is to display this mark
2389         (when (memq (car entry) whitespace-style)
2390           ;; Get a displayable mapping.
2391           (setq vecs (cddr entry))
2392           (while (and vecs
2393                       (not (whitespace-display-vector-p (car vecs))))
2394             (setq vecs (cdr vecs)))
2395           ;; Display a valid mapping.
2396           (when vecs
2397             (setq vec (copy-sequence (car vecs)))
2398             ;; NEWLINE char
2399             (when (and (eq (cadr entry) ?\n)
2400                        (memq 'newline whitespace-active-style))
2401               ;; Only insert face bits on NEWLINE char mapping to avoid
2402               ;; obstruction of other faces like TABs and (HARD) SPACEs
2403               ;; faces, font-lock faces, etc.
2404               (dotimes (i (length vec))
2405                 (or (eq (aref vec i) ?\n)
2406                     (aset vec i
2407                           (make-glyph-code (aref vec i)
2408                                            whitespace-newline)))))
2409             ;; Display mapping
2410             (aset buffer-display-table (cadr entry) vec)))))))
2411
2412
2413 (defun whitespace-display-char-off ()
2414   "Turn off character display mapping."
2415   (and whitespace-display-mappings
2416        (whitespace-style-mark-p)
2417        whitespace-display-table-was-local
2418        (setq whitespace-display-table-was-local nil
2419              buffer-display-table whitespace-display-table)))
2420
2421 \f
2422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2423 ;;;; Hook
2424
2425
2426 (defun whitespace-action-when-on ()
2427   "Action to be taken always when local whitespace is turned on."
2428   (cond ((memq 'cleanup whitespace-action)
2429          (whitespace-cleanup))
2430         ((memq 'report-on-bogus whitespace-action)
2431          (whitespace-report nil t))))
2432
2433
2434 (defun whitespace-write-file-hook ()
2435   "Action to be taken when buffer is written.
2436 It should be added buffer-locally to `write-file-functions'."
2437   (cond ((memq 'auto-cleanup whitespace-action)
2438          (whitespace-cleanup))
2439         ((memq 'abort-on-bogus whitespace-action)
2440          (when (whitespace-report nil t)
2441            (error "Abort write due to whitespace problems in %s"
2442                   (buffer-name)))))
2443   nil)                                  ; continue hook processing
2444
2445
2446 (defun whitespace-warn-read-only (msg)
2447   "Warn if buffer is read-only."
2448   (when (memq 'warn-if-read-only whitespace-action)
2449     (message "Can't %s: %s is read-only" msg (buffer-name))))
2450
2451 \f
2452 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2453
2454
2455 (defun whitespace-unload-function ()
2456   "Unload the whitespace library."
2457   (global-whitespace-mode -1)
2458   ;; be sure all local whitespace mode is turned off
2459   (save-current-buffer
2460     (dolist (buf (buffer-list))
2461       (set-buffer buf)
2462       (whitespace-mode -1)))
2463   nil)                                  ; continue standard unloading
2464
2465
2466 (provide 'whitespace)
2467
2468
2469 (run-hooks 'whitespace-load-hook)
2470
2471
2472 ;;; whitespace.el ends here