lisp/blank-mode.el

   1 ;;; blank-mode.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
   8 ;; Keywords: data, wp
   9 ;; Version: 9.0
  10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published
  16 ;; by the Free Software Foundation; either version 3, or (at your
  17 ;; option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 ;; General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32 ;;
  33 ;; Introduction
  34 ;; ------------
  35 ;;
  36 ;; This package is a minor mode to visualize blanks (TAB, (HARD) SPACE
  37 ;; and NEWLINE).
  38 ;;
  39 ;; blank-mode uses two ways to visualize blanks: faces and display
  40 ;; table.
  41 ;;
  42 ;; * Faces are used to highlight the background with a color.
  43 ;;   blank-mode uses font-lock to highlight blank characters.
  44 ;;
  45 ;; * Display table changes the way a character is displayed, that is,
  46 ;;   it provides a visual mark for characters, for example, at the end
  47 ;;   of line (?\xB6), at SPACEs (?\xB7) and at TABs (?\xBB).
  48 ;;
  49 ;; The `blank-style' and `blank-chars' variables are used to select
  50 ;; which way should be used to visualize blanks.
  51 ;;
  52 ;; Note that when blank-mode is turned on, blank-mode saves the
  53 ;; font-lock state, that is, if font-lock is on or off.  And
  54 ;; blank-mode restores the font-lock state when it is turned off.  So,
  55 ;; if blank-mode is turned on and font-lock is off, blank-mode also
  56 ;; turns on the font-lock to highlight blanks, but the font-lock will
  57 ;; be turned off when blank-mode is turned off.  Thus, turn on
  58 ;; font-lock before blank-mode is on, if you want that font-lock
  59 ;; continues on after blank-mode is turned off.
  60 ;;
  61 ;; When blank-mode is on, it takes care of highlighting some special
  62 ;; characters over the default mechanism of `nobreak-char-display'
  63 ;; (which see) and `show-trailing-whitespace' (which see).
  64 ;;
  65 ;; There are two ways of using blank-mode: local and global.
  66 ;;
  67 ;; * Local blank-mode affects only the current buffer.
  68 ;;
  69 ;; * Global blank-mode affects all current and future buffers.  That
  70 ;;   is, if you turn on global blank-mode and then create a new
  71 ;;   buffer, the new buffer will also have blank-mode on.  The
  72 ;;   `blank-global-modes' variable controls which major-mode will be
  73 ;;   automagically turned on.
  74 ;;
  75 ;; You can mix the local and global usage without any conflict.  But
  76 ;; local blank-mode has priority over global blank-mode.  Blank mode
  77 ;; is active in a buffer if you have enabled it in that buffer or if
  78 ;; you have enabled it globally.
  79 ;;
  80 ;; When global and local blank-mode are on:
  81 ;;
  82 ;; * if local blank-mode is turned off, blank-mode is turned off for
  83 ;;   the current buffer only.
  84 ;;
  85 ;; * if global blank-mode is turned off, blank-mode continues on only
  86 ;;   in the buffers in which local blank-mode is on.
  87 ;;
  88 ;; To use blank-mode, insert in your ~/.emacs:
  89 ;;
  90 ;;    (require 'blank-mode)
  91 ;;
  92 ;; Or autoload at least one of the commands`blank-mode',
  93 ;; `blank-toggle-options', `global-blank-mode' or
  94 ;; `global-blank-toggle-options'.  For example:
  95 ;;
  96 ;;    (autoload 'blank-mode                  "blank-mode"
  97 ;;      "Toggle blank visualization."          t)
  98 ;;    (autoload 'blank-toggle-options        "blank-mode"
  99 ;;      "Toggle local `blank-mode' options."   t)
 100 ;;
 101 ;; blank-mode was inspired by:
 102 ;;
 103 ;;    whitespace.el            Rajesh Vaidheeswarran <rv@gnu.org>
 104 ;;      Warn about and clean bogus whitespaces in the file
 105 ;;      (inspired the idea to warn and clean some blanks)
 106 ;;
 107 ;;    show-whitespace-mode.el  Aurelien Tisne <aurelien.tisne@free.fr>
 108 ;;       Simple mode to highlight whitespaces
 109 ;;       (inspired the idea to use font-lock)
 110 ;;
 111 ;;    whitespace-mode.el       Lawrence Mitchell <wence@gmx.li>
 112 ;;       Major mode for editing Whitespace
 113 ;;       (inspired the idea to use display table)
 114 ;;
 115 ;;    visws.el                 Miles Bader <miles@gnu.org>
 116 ;;       Make whitespace visible
 117 ;;       (handle display table, his code was modified, but the main
 118 ;;       idea was kept)
 119 ;;
 120 ;;
 121 ;; Using blank-mode
 122 ;; ----------------
 123 ;;
 124 ;; There is no problem if you mix local and global minor mode usage.
 125 ;;
 126 ;; * LOCAL blank-mode:
 127 ;;    + To toggle blank-mode options locally, type:
 128 ;;
 129 ;;         M-x blank-toggle-options RET
 130 ;;
 131 ;;    + To activate blank-mode locally, type:
 132 ;;
 133 ;;         C-u 1 M-x blank-mode RET
 134 ;;
 135 ;;    + To deactivate blank-mode locally, type:
 136 ;;
 137 ;;         C-u 0 M-x blank-mode RET
 138 ;;
 139 ;;    + To toggle blank-mode locally, type:
 140 ;;
 141 ;;         M-x blank-mode RET
 142 ;;
 143 ;; * GLOBAL blank-mode:
 144 ;;    + To toggle blank-mode options globally, type:
 145 ;;
 146 ;;         M-x global-blank-toggle-options RET
 147 ;;
 148 ;;    + To activate blank-mode globally, type:
 149 ;;
 150 ;;         C-u 1 M-x global-blank-mode RET
 151 ;;
 152 ;;    + To deactivate blank-mode globally, type:
 153 ;;
 154 ;;         C-u 0 M-x global-blank-mode RET
 155 ;;
 156 ;;    + To toggle blank-mode globally, type:
 157 ;;
 158 ;;         M-x global-blank-mode RET
 159 ;;
 160 ;; There are also the following useful commands:
 161 ;;
 162 ;; `blank-cleanup'
 163 ;;    Cleanup some blank problems in all buffer or at region.
 164 ;;
 165 ;; `blank-cleanup-region'
 166 ;;    Cleanup some blank problems at region.
 167 ;;
 168 ;; The problems, which are cleaned up, are:
 169 ;;
 170 ;; 1. empty lines at beginning of buffer.
 171 ;; 2. empty lines at end of buffer.
 172 ;;    If `blank-chars' has `empty' as an element, remove all empty
 173 ;;    lines at beginning and/or end of buffer.
 174 ;;
 175 ;; 3. 8 or more SPACEs at beginning of line.
 176 ;;    If `blank-chars' has `indentation' as an element, replace 8 or
 177 ;;    more SPACEs at beginning of line by TABs.
 178 ;;
 179 ;; 4. SPACEs before TAB.
 180 ;;    If `blank-chars' has `space-before-tab' as an element, replace
 181 ;;    SPACEs by TABs.
 182 ;;
 183 ;; 5. SPACEs or TABs at end of line.
 184 ;;    If `blank-chars' has `trailing' as an element, remove all
 185 ;;    SPACEs or TABs at end of line."
 186 ;;
 187 ;; 6. 8 or more SPACEs after TAB.
 188 ;;    If `blank-chars' has `space-after-tab' as an element, replace
 189 ;;    SPACEs by TABs.
 190 ;;
 191 ;;
 192 ;; Hooks
 193 ;; -----
 194 ;;
 195 ;; blank-mode has the following hook variables:
 196 ;;
 197 ;; `blank-mode-hook'
 198 ;;    It is evaluated always when blank-mode is turned on locally.
 199 ;;
 200 ;; `global-blank-mode-hook'
 201 ;;    It is evaluated always when blank-mode is turned on globally.
 202 ;;
 203 ;; `blank-load-hook'
 204 ;;    It is evaluated after blank-mode package is loaded.
 205 ;;
 206 ;;
 207 ;; Options
 208 ;; -------
 209 ;;
 210 ;; Below it's shown a brief description of blank-mode options, please,
 211 ;; see the options declaration in the code for a long documentation.
 212 ;;
 213 ;; `blank-style'                Specify the visualization style.
 214 ;;
 215 ;; `blank-chars'                Specify which kind of blank is
 216 ;;                              visualized.
 217 ;;
 218 ;; `blank-space'                Face used to visualize SPACE.
 219 ;;
 220 ;; `blank-hspace'               Face used to visualize HARD SPACE.
 221 ;;
 222 ;; `blank-tab'                  Face used to visualize TAB.
 223 ;;
 224 ;; `blank-newline'              Face used to visualize NEWLINE char
 225 ;;                              mapping.
 226 ;;
 227 ;; `blank-trailing'             Face used to visualize trailing
 228 ;;                              blanks.
 229 ;;
 230 ;; `blank-line'                 Face used to visualize "long" lines.
 231 ;;
 232 ;; `blank-space-before-tab'     Face used to visualize SPACEs before
 233 ;;                              TAB.
 234 ;;
 235 ;; `blank-indentation'          Face used to visualize 8 or more
 236 ;;                              SPACEs at beginning of line.
 237 ;;
 238 ;; `blank-empty'                Face used to visualize empty lines at
 239 ;;                              beginning and/or end of buffer.
 240 ;;
 241 ;; `blank-space-after-tab'      Face used to visualize 8 or more
 242 ;;                              SPACEs after TAB.
 243 ;;
 244 ;; `blank-space-regexp'         Specify SPACE characters regexp.
 245 ;;
 246 ;; `blank-hspace-regexp'        Specify HARD SPACE characters regexp.
 247 ;;
 248 ;; `blank-tab-regexp'           Specify TAB characters regexp.
 249 ;;
 250 ;; `blank-trailing-regexp'      Specify trailing characters regexp.
 251 ;;
 252 ;; `blank-space-before-tab-regexp'      Specify SPACEs before TAB
 253 ;;                                      regexp.
 254 ;;
 255 ;; `blank-indentation-regexp'   Specify regexp for 8 or more SPACEs at
 256 ;;                              beginning of line.
 257 ;;
 258 ;; `blank-empty-at-bob-regexp'  Specify regexp for empty lines at
 259 ;;                              beginning of buffer.
 260 ;;
 261 ;; `blank-empty-at-eob-regexp'  Specify regexp for empty lines at end
 262 ;;                              of buffer.
 263 ;;
 264 ;; `blank-space-after-tab-regexp'       Specify regexp for 8 or more
 265 ;;                                      SPACEs after TAB.
 266 ;;
 267 ;; `blank-line-length'          Specify length beyond which the line
 268 ;;                              is highlighted.
 269 ;;
 270 ;; `blank-display-mappings'     Specify an alist of mappings for
 271 ;;                              displaying characters.
 272 ;;
 273 ;; `blank-global-modes'         Modes for which global `blank-mode' is
 274 ;;                              automagically turned on.
 275 ;;
 276 ;;
 277 ;; Acknowledgements
 278 ;; ----------------
 279 ;;
 280 ;; Thanks to Juri Linkov <juri@jurta.org> for suggesting:
 281 ;;    * `define-minor-mode'.
 282 ;;    * `global-blank-*' name for global commands.
 283 ;;
 284 ;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing.
 285 ;;
 286 ;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands
 287 ;; suggestion.
 288 ;;
 289 ;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for
 290 ;; helping to fix `find-file-hooks' reference.
 291 ;;
 292 ;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for
 293 ;; indicating defface byte-compilation warnings.
 294 ;;
 295 ;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight
 296 ;; "long" lines. See EightyColumnRule (EmacsWiki).
 297 ;;
 298 ;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new
 299 ;; newline character mapping.
 300 ;;
 301 ;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating
 302 ;; whitespace-mode on XEmacs.
 303 ;;
 304 ;; Thanks to Miles Bader <miles@gnu.org> for handling display table via
 305 ;; visws.el (his code was modified, but the main idea was kept).
 306 ;;
 307 ;; Thanks to:
 308 ;;    Rajesh Vaidheeswarran <rv@gnu.org>        whitespace.el
 309 ;;    Aurelien Tisne <aurelien.tisne@free.fr>   show-whitespace-mode.el
 310 ;;    Lawrence Mitchell <wence@gmx.li>          whitespace-mode.el
 311 ;;    Miles Bader <miles@gnu.org>               visws.el
 312 ;; And to all people who contributed with them.
 313 ;;
 314 ;;
 315 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 316
 317 ;;; code:
 318
 319 \f
 320 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 321 ;;;; User Variables:
 322
 323
 324 ;;; Interface to the command system
 325
 326
 327 (defgroup blank nil
 328   "Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
 329   :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el")
 330   :version "22.2"
 331   :group 'wp
 332   :group 'data)
 333
 334
 335 (defcustom blank-style '(mark color)
 336   "*Specify the visualization style.
 337
 338 It's a list which element value can be:
 339
 340    mark         display mappings are visualized.
 341
 342    color        faces are visualized.
 343
 344 Any other value is ignored.
 345
 346 If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
 347
 348 See also `blank-display-mappings' for documentation."
 349   :type '(repeat :tag "Style of Blank"
 350                  (choice :tag "Style of Blank"
 351                          (const :tag "Display Table" mark)
 352                          (const :tag "Faces" color)))
 353   :group 'blank)
 354
 355
 356 (defcustom blank-chars
 357   '(tabs spaces trailing lines space-before-tab newline
 358          indentation empty space-after-tab)
 359   "*Specify which kind of blank is visualized.
 360
 361 It's a list which element value can be:
 362
 363    trailing             trailing blanks are visualized.
 364
 365    tabs                 TABs are visualized.
 366
 367    spaces               SPACEs and HARD SPACEs are visualized.
 368
 369    lines                lines whose length is greater than
 370                         `blank-line-length' are highlighted.
 371
 372    space-before-tab     SPACEs before TAB are visualized.
 373
 374    newline              NEWLINEs are visualized.
 375
 376    indentation          8 or more SPACEs at beginning of line are
 377                         visualized.
 378
 379    empty                empty lines at beginning and/or end of buffer
 380                         are visualized.
 381
 382    space-after-tab      8 or more SPACEs after a TAB are visualized.
 383
 384 Any other value is ignored.
 385
 386 If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
 387
 388 Used when `blank-style' has `color' as an element.
 389 If `blank-chars' has `newline' as an element, used when `blank-style'
 390 has `mark' as an element."
 391   :type '(repeat :tag "Kind of Blank"
 392                  (choice :tag "Kind of Blank"
 393                          (const :tag "Trailing TABs, SPACEs and HARD SPACEs"
 394                                 trailing)
 395                          (const :tag "SPACEs and HARD SPACEs" spaces)
 396                          (const :tag "TABs" tabs)
 397                          (const :tag "Lines" lines)
 398                          (const :tag "SPACEs before TAB"
 399                                 space-before-tab)
 400                          (const :tag "NEWLINEs" newline)
 401                          (const :tag "Indentation SPACEs" indentation)
 402                          (const :tag "Empty Lines At BOB And/Or EOB"
 403                                 empty)
 404                          (const :tag "SPACEs after TAB"
 405                                 space-after-tab)))
 406   :group 'blank)
 407
 408
 409 (defcustom blank-space 'blank-space
 410   "*Symbol face used to visualize SPACE.
 411
 412 Used when `blank-style' has `color' as an element."
 413   :type 'face
 414   :group 'blank)
 415
 416
 417 (defface blank-space
 418   '((((class color) (background dark))
 419      (:background "grey20"      :foreground "aquamarine3"))
 420     (((class color) (background light))
 421      (:background "LightYellow" :foreground "aquamarine3"))
 422     (t (:inverse-video t)))
 423   "Face used to visualize SPACE."
 424   :group 'blank)
 425
 426
 427 (defcustom blank-hspace 'blank-hspace
 428   "*Symbol face used to visualize HARD SPACE.
 429
 430 Used when `blank-style' has `color' as an element."
 431   :type 'face
 432   :group 'blank)
 433
 434
 435 (defface blank-hspace                   ; 'nobreak-space
 436   '((((class color) (background dark))
 437      (:background "grey24"        :foreground "aquamarine3"))
 438     (((class color) (background light))
 439      (:background "LemonChiffon3" :foreground "aquamarine3"))
 440     (t (:inverse-video t)))
 441   "Face used to visualize HARD SPACE."
 442   :group 'blank)
 443
 444
 445 (defcustom blank-tab 'blank-tab
 446   "*Symbol face used to visualize TAB.
 447
 448 Used when `blank-style' has `color' as an element."
 449   :type 'face
 450   :group 'blank)
 451
 452
 453 (defface blank-tab
 454   '((((class color) (background dark))
 455      (:background "grey22" :foreground "aquamarine3"))
 456     (((class color) (background light))
 457      (:background "beige"  :foreground "aquamarine3"))
 458     (t (:inverse-video t)))
 459   "Face used to visualize TAB."
 460   :group 'blank)
 461
 462
 463 (defcustom blank-newline 'blank-newline
 464   "*Symbol face used to visualize NEWLINE char mapping.
 465
 466 See `blank-display-mappings'.
 467
 468 Used when `blank-style' has `mark' and `color' as elements
 469 and `blank-chars' has `newline' as an element."
 470   :type 'face
 471   :group 'blank)
 472
 473
 474 (defface blank-newline
 475   '((((class color) (background dark))
 476      (:background "grey26" :foreground "aquamarine3" :bold t))
 477     (((class color) (background light))
 478      (:background "linen"  :foreground "aquamarine3" :bold t))
 479     (t (:bold t :underline t)))
 480   "Face used to visualize NEWLINE char mapping.
 481
 482 See `blank-display-mappings'."
 483   :group 'blank)
 484
 485
 486 (defcustom blank-trailing 'blank-trailing
 487   "*Symbol face used to visualize traling blanks.
 488
 489 Used when `blank-style' has `color' as an element."
 490   :type 'face
 491   :group 'blank)
 492
 493
 494 (defface blank-trailing                 ; 'trailing-whitespace
 495   '((((class mono)) (:inverse-video t :bold t :underline t))
 496     (t (:background "red1" :foreground "yellow" :bold t)))
 497   "Face used to visualize trailing blanks."
 498   :group 'blank)
 499
 500
 501 (defcustom blank-line 'blank-line
 502   "*Symbol face used to visualize \"long\" lines.
 503
 504 See `blank-line-length'.
 505
 506 Used when `blank-style' has `color' as an element."
 507   :type 'face
 508   :group 'blank)
 509
 510
 511 (defface blank-line
 512   '((((class mono)) (:inverse-video t :bold t :underline t))
 513     (t (:background "gray20" :foreground "violet")))
 514   "Face used to visualize \"long\" lines.
 515
 516 See `blank-line-length'."
 517   :group 'blank)
 518
 519
 520 (defcustom blank-space-before-tab 'blank-space-before-tab
 521   "*Symbol face used to visualize SPACEs before TAB.
 522
 523 Used when `blank-style' has `color' as an element."
 524   :type 'face
 525   :group 'blank)
 526
 527
 528 (defface blank-space-before-tab
 529   '((((class mono)) (:inverse-video t :bold t :underline t))
 530     (t (:background "DarkOrange" :foreground "firebrick")))
 531   "Face used to visualize SPACEs before TAB."
 532   :group 'blank)
 533
 534
 535 (defcustom blank-indentation 'blank-indentation
 536   "*Symbol face used to visualize 8 or more SPACEs at beginning of line.
 537
 538 Used when `blank-style' has `color' as an element."
 539   :type 'face
 540   :group 'blank)
 541
 542
 543 (defface blank-indentation
 544   '((((class mono)) (:inverse-video t :bold t :underline t))
 545     (t (:background "yellow" :foreground "firebrick")))
 546   "Face used to visualize 8 or more SPACEs at beginning of line."
 547   :group 'blank)
 548
 549
 550 (defcustom blank-empty 'blank-empty
 551   "*Symbol face used to visualize empty lines at beginning and/or end of buffer.
 552
 553 Used when `blank-style' has `color' as an element."
 554   :type 'face
 555   :group 'blank)
 556
 557
 558 (defface blank-empty
 559   '((((class mono)) (:inverse-video t :bold t :underline t))
 560     (t (:background "yellow" :foreground "firebrick")))
 561   "Face used to visualize empty lines at beginning and/or end of buffer."
 562   :group 'blank)
 563
 564
 565 (defcustom blank-space-after-tab 'blank-space-after-tab
 566   "*Symbol face used to visualize 8 or more SPACEs after TAB.
 567
 568 Used when `blank-style' has `color' as an element."
 569   :type 'face
 570   :group 'blank)
 571
 572
 573 (defface blank-space-after-tab
 574   '((((class mono)) (:inverse-video t :bold t :underline t))
 575     (t (:background "yellow" :foreground "firebrick")))
 576   "Face used to visualize 8 or more SPACEs after TAB."
 577   :group 'blank)
 578
 579
 580 (defcustom blank-hspace-regexp
 581   "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)"
 582   "*Specify HARD SPACE characters regexp.
 583
 584 If you're using `mule' package, it may exist other characters besides:
 585
 586    \"\\xA0\"   \"\\x8A0\"   \"\\x920\"   \"\\xE20\"   \"\\xF20\"
 587
 588 that should be considered HARD SPACE.
 589
 590 Here are some examples:
 591
 592    \"\\\\(^\\xA0+\\\\)\"                \
 593 visualize only leading HARD SPACEs.
 594    \"\\\\(\\xA0+$\\\\)\"                \
 595 visualize only trailing HARD SPACEs.
 596    \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\"    \
 597 visualize leading and/or trailing HARD SPACEs.
 598    \"\\t\\\\(\\xA0+\\\\)\\t\"           \
 599 visualize only HARD SPACEs between TABs.
 600
 601 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 602       Use exactly one pair of enclosing \\\\( and \\\\).
 603
 604 Used when `blank-style' has `color' as an element, and
 605 `blank-chars' has `spaces' as an element."
 606   :type '(regexp :tag "HARD SPACE Chars")
 607   :group 'blank)
 608
 609
 610 (defcustom blank-space-regexp "\\( +\\)"
 611   "*Specify SPACE characters regexp.
 612
 613 If you're using `mule' package, it may exist other characters
 614 besides \" \" that should be considered SPACE.
 615
 616 Here are some examples:
 617
 618    \"\\\\(^ +\\\\)\"            visualize only leading SPACEs.
 619    \"\\\\( +$\\\\)\"            visualize only trailing SPACEs.
 620    \"\\\\(^ +\\\\| +$\\\\)\"    \
 621 visualize leading and/or trailing SPACEs.
 622    \"\\t\\\\( +\\\\)\\t\"       visualize only SPACEs between TABs.
 623
 624 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 625       Use exactly one pair of enclosing \\\\( and \\\\).
 626
 627 Used when `blank-style' has `color' as an element, and
 628 `blank-chars' has `spaces' as an element."
 629   :type '(regexp :tag "SPACE Chars")
 630   :group 'blank)
 631
 632
 633 (defcustom blank-tab-regexp "\\(\t+\\)"
 634   "*Specify TAB characters regexp.
 635
 636 If you're using `mule' package, it may exist other characters
 637 besides \"\\t\" that should be considered TAB.
 638
 639 Here are some examples:
 640
 641    \"\\\\(^\\t+\\\\)\"          visualize only leading TABs.
 642    \"\\\\(\\t+$\\\\)\"          visualize only trailing TABs.
 643    \"\\\\(^\\t+\\\\|\\t+$\\\\)\"        \
 644 visualize leading and/or trailing TABs.
 645    \" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
 646
 647 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
 648       Use exactly one pair of enclosing \\\\( and \\\\).
 649
 650 Used when `blank-style' has `color' as an element, and
 651 `blank-chars' has `tabs' as an element."
 652   :type '(regexp :tag "TAB Chars")
 653   :group 'blank)
 654
 655
 656 (defcustom blank-trailing-regexp
 657   "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20"
 658   "*Specify trailing characters regexp.
 659
 660 If you're using `mule' package, it may exist other characters besides:
 661
 662    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 663 \"\\xF20\"
 664
 665 that should be considered blank.
 666
 667 NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight.
 668       `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and
 669       \"\\\\)+\\\\)$\".
 670
 671 Used when `blank-style' has `color' as an element, and
 672 `blank-chars' has `trailing' as an element."
 673   :type '(regexp :tag "Trailing Chars")
 674   :group 'blank)
 675
 676
 677 (defcustom blank-space-before-tab-regexp "\\( +\\)\t"
 678   "*Specify SPACEs before TAB regexp.
 679
 680 If you're using `mule' package, it may exist other characters besides:
 681
 682    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 683 \"\\xF20\"
 684
 685 that should be considered blank.
 686
 687 Used when `blank-style' has `color' as an element, and
 688 `blank-chars' has `space-before-tab' as an element."
 689   :type '(regexp :tag "SPACEs Before TAB")
 690   :group 'blank)
 691
 692
 693 (defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]"
 694   "*Specify regexp for 8 or more SPACEs at beginning of line.
 695
 696 If you're using `mule' package, it may exist other characters besides:
 697
 698    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 699 \"\\xF20\"
 700
 701 that should be considered blank.
 702
 703 Used when `blank-style' has `color' as an element, and
 704 `blank-chars' has `indentation' as an element."
 705   :type '(regexp :tag "Indentation SPACEs")
 706   :group 'blank)
 707
 708
 709 (defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
 710   "*Specify regexp for empty lines at beginning of buffer.
 711
 712 If you're using `mule' package, it may exist other characters besides:
 713
 714    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 715 \"\\xF20\"
 716
 717 that should be considered blank.
 718
 719 Used when `blank-style' has `color' as an element, and
 720 `blank-chars' has `empty' as an element."
 721   :type '(regexp :tag "Empty Lines At Beginning Of Buffer")
 722   :group 'blank)
 723
 724
 725 (defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
 726   "*Specify regexp for empty lines at end of buffer.
 727
 728 If you're using `mule' package, it may exist other characters besides:
 729
 730    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 731 \"\\xF20\"
 732
 733 that should be considered blank.
 734
 735 Used when `blank-style' has `color' as an element, and
 736 `blank-chars' has `empty' as an element."
 737   :type '(regexp :tag "Empty Lines At End Of Buffer")
 738   :group 'blank)
 739
 740
 741 (defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)"
 742   "*Specify regexp for 8 or more SPACEs after TAB.
 743
 744 If you're using `mule' package, it may exist other characters besides:
 745
 746    \" \"  \"\\t\"  \"\\xA0\"  \"\\x8A0\"  \"\\x920\"  \"\\xE20\"  \
 747 \"\\xF20\"
 748
 749 that should be considered blank.
 750
 751 Used when `blank-style' has `color' as an element, and
 752 `blank-chars' has `space-after-tab' as an element."
 753   :type '(regexp :tag "SPACEs After TAB")
 754   :group 'blank)
 755
 756
 757 (defcustom blank-line-length 80
 758   "*Specify length beyond which the line is highlighted.
 759
 760 Used when `blank-style' has `color' as an element, and
 761 `blank-chars' has `lines' as an element."
 762   :type '(integer :tag "Line Length")
 763   :group 'blank)
 764
 765
 766 ;; Hacked from `visible-whitespace-mappings' in visws.el
 767 (defcustom blank-display-mappings
 768   ;; Due to limitations of glyph representation, the char code can not
 769   ;; be above ?\x1FFFF.  Probably, this will be fixed after Emacs
 770   ;; unicode merging.
 771   '(
 772     (?\     [?\xB7]       [?.])         ; space - centered dot
 773     (?\xA0  [?\xA4]       [?_])         ; hard space - currency
 774     (?\x8A0 [?\x8A4]      [?_])         ; hard space - currency
 775     (?\x920 [?\x924]      [?_])         ; hard space - currency
 776     (?\xE20 [?\xE24]      [?_])         ; hard space - currency
 777     (?\xF20 [?\xF24]      [?_])         ; hard space - currency
 778     ;; NEWLINE is displayed using the face `blank-newline'
 779     (?\n    [?$ ?\n])                   ; end-of-line - dollar sign
 780     ;; (?\n    [?\u21B5 ?\n] [?$ ?\n])  ; end-of-line - downwards arrow
 781     ;; (?\n    [?\xB6 ?\n]   [?$ ?\n])  ; end-of-line - pilcrow
 782     ;; (?\n    [?\x8AF ?\n]  [?$ ?\n])  ; end-of-line - overscore
 783     ;; (?\n    [?\x8AC ?\n]  [?$ ?\n])  ; end-of-line - negation
 784     ;; (?\n    [?\x8B0 ?\n]  [?$ ?\n])  ; end-of-line - grade
 785     ;;
 786     ;; WARNING: the mapping below has a problem.
 787     ;; When a TAB occupies exactly one column, it will display the
 788     ;; character ?\xBB at that column followed by a TAB which goes to
 789     ;; the next TAB column.
 790     ;; If this is a problem for you, please, comment the line below.
 791     (?\t    [?\xBB ?\t]   [?\\ ?\t])    ; tab - left quote mark
 792     )
 793   "*Specify an alist of mappings for displaying characters.
 794
 795 Each element has the following form:
 796
 797    (CHAR VECTOR...)
 798
 799 Where:
 800
 801 CHAR    is the character to be mapped.
 802
 803 VECTOR  is a vector of characters to be displayed in place of CHAR.
 804         The first display vector that can be displayed is used;
 805         if no display vector for a mapping can be displayed, then
 806         that character is displayed unmodified.
 807
 808 The NEWLINE character is displayed using the face given by
 809 `blank-newline' variable.  The characters in the vector to be
 810 displayed will not have this face applied if the character code
 811 is above #x1FFFF.
 812
 813 Used when `blank-style' has `mark' as an element."
 814   :type '(repeat
 815           (list :tag "Character Mapping"
 816                 (character :tag "Char")
 817                 (repeat :inline t :tag "Vector List"
 818                         (vector :tag ""
 819                                 (repeat :inline t
 820                                         :tag "Vector Characters"
 821                                         (character :tag "Char"))))))
 822   :group 'blank)
 823
 824
 825 (defcustom blank-global-modes t
 826   "*Modes for which global `blank-mode' is automagically turned on.
 827
 828 Global `blank-mode' is controlled by the command `global-blank-mode'.
 829
 830 If nil, means no modes have `blank-mode' automatically turned on.
 831 If t, all modes that support `blank-mode' have it automatically
 832 turned on.
 833 Else it should be a list of `major-mode' symbol names for
 834 which `blank-mode' should be automatically turned on.  The sense
 835 of the list is negated if it begins with `not'.  For example:
 836
 837    (c-mode c++-mode)
 838
 839 means that `blank-mode' is turned on for buffers in C and C++
 840 modes only."
 841   :type '(choice (const :tag "None" nil)
 842                  (const :tag "All" t)
 843                  (set :menu-tag "Mode Specific" :tag "Modes"
 844                       :value (not)
 845                       (const :tag "Except" not)
 846                       (repeat :inline t
 847                               (symbol :tag "Mode"))))
 848   :group 'blank)
 849
 850 \f
 851 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 852 ;;;; User commands - Local mode
 853
 854
 855 ;;;###autoload
 856 (define-minor-mode blank-mode
 857   "Toggle blank minor mode visualization (\"bl\" on modeline).
 858
 859 If ARG is null, toggle blank visualization.
 860 If ARG is a number greater than zero, turn on visualization;
 861 otherwise, turn off visualization.
 862 Only useful with a windowing system."
 863   :lighter    " bl"
 864   :init-value nil
 865   :global     nil
 866   :group      'blank
 867   (cond
 868    (noninteractive                      ; running a batch job
 869     (setq blank-mode nil))
 870    (blank-mode                          ; blank-mode on
 871     (blank-turn-on))
 872    (t                                   ; blank-mode off
 873     (blank-turn-off))))
 874
 875 \f
 876 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 877 ;;;; User commands - Global mode
 878
 879
 880 (define-minor-mode global-blank-mode
 881   "Toggle blank global minor mode visualization (\"BL\" on modeline).
 882
 883 If ARG is null, toggle blank visualization.
 884 If ARG is a number greater than zero, turn on visualization;
 885 otherwise, turn off visualization.
 886 Only useful with a windowing system."
 887   :lighter    " BL"
 888   :init-value nil
 889   :global     t
 890   :group      'blank
 891   (cond
 892    (noninteractive                      ; running a batch job
 893     (setq global-blank-mode nil))
 894    (global-blank-mode                   ; global-blank-mode on
 895     (save-excursion
 896       (if (boundp 'find-file-hook)
 897           (add-hook 'find-file-hook 'blank-turn-on-if-enabled t)
 898         (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t))
 899       (dolist (buffer (buffer-list))    ; adjust all local mode
 900         (set-buffer buffer)
 901         (unless blank-mode
 902           (blank-turn-on-if-enabled)))))
 903    (t                                   ; global-blank-mode off
 904     (save-excursion
 905       (if (boundp 'find-file-hook)
 906           (remove-hook 'find-file-hook 'blank-turn-on-if-enabled)
 907         (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled))
 908       (dolist (buffer (buffer-list))    ; adjust all local mode
 909         (set-buffer buffer)
 910         (unless blank-mode
 911           (blank-turn-off)))))))
 912
 913
 914 (defun blank-turn-on-if-enabled ()
 915   (when (cond
 916          ((eq blank-global-modes t))
 917          ((listp blank-global-modes)
 918           (if (eq (car-safe blank-global-modes) 'not)
 919               (not (memq major-mode (cdr blank-global-modes)))
 920             (memq major-mode blank-global-modes)))
 921          (t nil))
 922     (let (inhibit-quit)
 923       ;; Don't turn on blank mode if...
 924       (or
 925        ;; ...we don't have a display (we're running a batch job)
 926        noninteractive
 927        ;; ...or if the buffer is invisible (name starts with a space)
 928        (eq (aref (buffer-name) 0) ?\ )
 929        ;; ...or if the buffer is temporary (name starts with *)
 930        (and (eq (aref (buffer-name) 0) ?*)
 931             ;; except the scratch buffer.
 932             (not (string= (buffer-name) "*scratch*")))
 933        ;; Otherwise, turn on blank mode.
 934        (blank-turn-on)))))
 935
 936 \f
 937 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 938 ;;;; User commands - Toggle
 939
 940
 941 (defconst blank-chars-value-list
 942   '(tabs
 943     spaces
 944     trailing
 945     space-before-tab
 946     lines
 947     newline
 948     indentation
 949     empty
 950     space-after-tab
 951     )
 952   "List of valid `blank-chars' values.")
 953
 954
 955 (defconst blank-style-value-list
 956   '(color
 957     mark
 958     )
 959   "List of valid `blank-style' values.")
 960
 961
 962 (defconst blank-toggle-option-alist
 963   '((?t . tabs)
 964     (?s . spaces)
 965     (?r . trailing)
 966     (?b . space-before-tab)
 967     (?l . lines)
 968     (?n . newline)
 969     (?i . indentation)
 970     (?e . empty)
 971     (?a . space-after-tab)
 972     (?c . color)
 973     (?m . mark)
 974     (?x . blank-chars)
 975     (?z . blank-style)
 976     )
 977   "Alist of toggle options.
 978
 979 Each element has the form:
 980
 981    (CHAR . SYMBOL)
 982
 983 Where:
 984
 985 CHAR    is a char which the user will have to type.
 986
 987 SYMBOL  is a valid symbol associated with CHAR.
 988         See `blank-chars-value-list' and `blank-style-value-list'.")
 989
 990
 991 (defvar blank-active-chars nil
 992   "Used to save locally `blank-chars' value.")
 993 (make-variable-buffer-local 'blank-active-chars)
 994
 995 (defvar blank-active-style nil
 996   "Used to save locally `blank-style' value.")
 997 (make-variable-buffer-local 'blank-active-style)
 998
 999
1000 ;;;###autoload
1001 (defun blank-toggle-options (arg)
1002   "Toggle local `blank-mode' options.
1003
1004 If local blank-mode is off, toggle the option given by ARG and
1005 turn on local blank-mode.
1006
1007 If local blank-mode is on, toggle the option given by ARG and
1008 restart local blank-mode.
1009
1010 Interactively, it reads one of the following chars:
1011
1012   CHAR  MEANING
1013    t    toggle TAB visualization
1014    s    toggle SPACE and HARD SPACE visualization
1015    r    toggle trailing blanks visualization
1016    b    toggle SPACEs before TAB visualization
1017    l    toggle \"long lines\" visualization
1018    n    toggle NEWLINE visualization
1019    i    toggle indentation SPACEs visualization
1020    e    toggle empty line at bob and/or eob visualization
1021    a    toggle SPACEs after TAB visualization
1022    c    toggle color faces
1023    m    toggle visual mark
1024    x    restore `blank-chars' value
1025    z    restore `blank-style' value
1026    ?    display brief help
1027
1028 Non-interactively, ARG should be a symbol or a list of symbols.
1029 The valid symbols are:
1030
1031    tabs                 toggle TAB visualization
1032    spaces               toggle SPACE and HARD SPACE visualization
1033    trailing             toggle trailing blanks visualization
1034    space-before-tab     toggle SPACEs before TAB visualization
1035    lines                toggle \"long lines\" visualization
1036    newline              toggle NEWLINE visualization
1037    indentation          toggle indentation SPACEs visualization
1038    empty                toggle empty line at bob and/or eob visualization
1039    space-after-tab      toggle SPACEs after TAB visualization
1040    color                toggle color faces
1041    mark                 toggle visual mark
1042    blank-chars          restore `blank-chars' value
1043    blank-style          restore `blank-style' value
1044
1045 Only useful with a windowing system."
1046   (interactive (blank-interactive-char t))
1047   (let ((blank-chars
1048          (blank-toggle-list t arg blank-active-chars blank-chars
1049                             'blank-chars blank-chars-value-list))
1050         (blank-style
1051          (blank-toggle-list t arg blank-active-style blank-style
1052                             'blank-style blank-style-value-list)))
1053     (blank-mode 0)
1054     (blank-mode 1)))
1055
1056
1057 (defvar blank-toggle-chars nil
1058   "Used to toggle the global `blank-chars' value.")
1059 (defvar blank-toggle-style nil
1060   "Used to toggle the global `blank-style' value.")
1061
1062
1063 ;;;###autoload
1064 (defun global-blank-toggle-options (arg)
1065   "Toggle global `blank-mode' options.
1066
1067 If global blank-mode is off, toggle the option given by ARG and
1068 turn on global blank-mode.
1069
1070 If global blank-mode is on, toggle the option given by ARG and
1071 restart global blank-mode.
1072
1073 Interactively, it reads one of the following chars:
1074
1075   CHAR  MEANING
1076    t    toggle TAB visualization
1077    s    toggle SPACE and HARD SPACE visualization
1078    r    toggle trailing blanks visualization
1079    b    toggle SPACEs before TAB visualization
1080    l    toggle \"long lines\" visualization
1081    n    toggle NEWLINE visualization
1082    i    toggle indentation SPACEs visualization
1083    e    toggle empty line at bob and/or eob visualization
1084    a    toggle SPACEs after TAB visualization
1085    c    toggle color faces
1086    m    toggle visual mark
1087    x    restore `blank-chars' value
1088    z    restore `blank-style' value
1089    ?    display brief help
1090
1091 Non-interactively, ARG should be a symbol or a list of symbols.
1092 The valid symbols are:
1093
1094    tabs                 toggle TAB visualization
1095    spaces               toggle SPACE and HARD SPACE visualization
1096    trailing             toggle trailing blanks visualization
1097    space-before-tab     toggle SPACEs before TAB visualization
1098    lines                toggle \"long lines\" visualization
1099    newline              toggle NEWLINE visualization
1100    indentation          toggle indentation SPACEs visualization
1101    empty                toggle empty line at bob and/or eob visualization
1102    space-after-tab      toggle SPACEs after TAB visualization
1103    color                toggle color faces
1104    mark                 toggle visual mark
1105    blank-chars          restore `blank-chars' value
1106    blank-style          restore `blank-style' value
1107
1108 Only useful with a windowing system."
1109   (interactive (blank-interactive-char nil))
1110   (let ((blank-chars
1111          (blank-toggle-list nil arg blank-toggle-chars blank-chars
1112                             'blank-chars blank-chars-value-list))
1113         (blank-style
1114          (blank-toggle-list nil arg blank-toggle-style blank-style
1115                             'blank-style blank-style-value-list)))
1116     (setq blank-toggle-chars blank-chars
1117           blank-toggle-style blank-style)
1118     (global-blank-mode 0)
1119     (global-blank-mode 1)))
1120
1121 \f
1122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1123 ;;;; User commands - Cleanup
1124
1125
1126 ;;;###autoload
1127 (defun blank-cleanup ()
1128   "Cleanup some blank problems in all buffer or at region.
1129
1130 It usually applies to the whole buffer, but in transient mark
1131 mode when the mark is active, it applies to the region.  It also
1132 applies to the region when it is not in transiente mark mode, the
1133 mark is active and it was pressed `C-u' just before calling
1134 `blank-cleanup' interactively.
1135
1136 See also `blank-cleanup-region'.
1137
1138 The problems, which are cleaned up, are:
1139
1140 1. empty lines at beginning of buffer.
1141 2. empty lines at end of buffer.
1142    If `blank-chars' has `empty' as an element, remove all empty
1143    lines at beginning and/or end of buffer.
1144
1145 3. 8 or more SPACEs at beginning of line.
1146    If `blank-chars' has `indentation' as an element, replace 8 or
1147    more SPACEs at beginning of line by TABs.
1148
1149 4. SPACEs before TAB.
1150    If `blank-chars' has `space-before-tab' as an element, replace
1151    SPACEs by TABs.
1152
1153 5. SPACEs or TABs at end of line.
1154    If `blank-chars' has `trailing' as an element, remove all
1155    SPACEs or TABs at end of line.
1156
1157 6. 8 or more SPACEs after TAB.
1158    If `blank-chars' has `space-after-tab' as an element, replace
1159    SPACEs by TABs."
1160   (interactive "@*")
1161   (if (and (or transient-mark-mode
1162                current-prefix-arg)
1163            mark-active)
1164       ;; region active
1165       ;; problems 1 and 2 are not handled in region
1166       ;; problem 3: 8 or more SPACEs at bol
1167       ;; problem 4: SPACEs before TAB
1168       ;; problem 5: SPACEs or TABs at eol
1169       ;; problem 6: 8 or more SPACEs after TAB
1170       (blank-cleanup-region (region-beginning) (region-end))
1171     ;; whole buffer
1172     (save-excursion
1173       ;; problem 1: empty lines at bob
1174       ;; problem 2: empty lines at eob
1175       ;; action: remove all empty lines at bob and/or eob
1176       (when (memq 'empty blank-chars)
1177         (let (overwrite-mode)           ; enforce no overwrite
1178           (goto-char (point-min))
1179           (when (re-search-forward blank-empty-at-bob-regexp nil t)
1180             (delete-region (match-beginning 1) (match-end 1)))
1181           (when (re-search-forward blank-empty-at-eob-regexp nil t)
1182             (delete-region (match-beginning 1) (match-end 1)))))
1183       ;; problem 3: 8 or more SPACEs at bol
1184       ;; problem 4: SPACEs before TAB
1185       ;; problem 5: SPACEs or TABs at eol
1186       ;; problem 6: 8 or more SPACEs after TAB
1187       (blank-cleanup-region (point-min) (point-max)))))
1188
1189
1190 ;;;###autoload
1191 (defun blank-cleanup-region (start end)
1192   "Cleanup some blank problems at region.
1193
1194 The problems, which are cleaned up, are:
1195
1196 1. 8 or more SPACEs at beginning of line.
1197    If `blank-chars' has `indentation' as an element, replace 8 or
1198    more SPACEs at beginning of line by TABs.
1199
1200 2. SPACEs before TAB.
1201    If `blank-chars' has `space-before-tab' as an element, replace
1202    SPACEs by TABs.
1203
1204 3. SPACEs or TABs at end of line.
1205    If `blank-chars' has `trailing' as an element, remove all
1206    SPACEs or TABs at end of line.
1207
1208 4. 8 or more SPACEs after TAB.
1209    If `blank-chars' has `space-after-tab' as an element, replace
1210    SPACEs by TABs."
1211   (interactive "@*r")
1212   (let ((rstart           (min start end))
1213         (rend             (copy-marker (max start end)))
1214         (tab-width        8)            ; assure TAB width
1215         (indent-tabs-mode t)            ; always insert TABs
1216         overwrite-mode                  ; enforce no overwrite
1217         tmp)
1218     (save-excursion
1219       ;; problem 1: 8 or more SPACEs at bol
1220       ;; action: replace 8 or more SPACEs at bol by TABs
1221       (when (memq 'indentation blank-chars)
1222         (goto-char rstart)
1223         (while (re-search-forward blank-indentation-regexp rend t)
1224           (setq tmp (current-indentation))
1225           (delete-horizontal-space)
1226           (unless (eolp)
1227             (indent-to tmp))))
1228       ;; problem 3: SPACEs or TABs at eol
1229       ;; action: remove all SPACEs or TABs at eol
1230       (when (memq 'trailing blank-chars)
1231         (let ((regexp
1232                (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$")))
1233           (goto-char rstart)
1234           (while (re-search-forward regexp rend t)
1235             (delete-region (match-beginning 1) (match-end 1)))))
1236       ;; problem 4: 8 or more SPACEs after TAB
1237       ;; action: replace 8 or more SPACEs by TABs
1238       (when (memq 'space-after-tab blank-chars)
1239         (goto-char rstart)
1240         (while (re-search-forward blank-space-after-tab-regexp rend t)
1241           (goto-char (match-beginning 1))
1242           (let ((scol (current-column))
1243                 (ecol (save-excursion
1244                         (goto-char (match-end 1))
1245                         (current-column))))
1246             (delete-region (match-beginning 1) (match-end 1))
1247             (insert-char ?\t (/ (- ecol scol) 8)))))
1248       ;; problem 2: SPACEs before TAB
1249       ;; action: replace SPACEs before TAB by TABs
1250       (when (memq 'space-before-tab blank-chars)
1251         (goto-char rstart)
1252         (while (re-search-forward blank-space-before-tab-regexp rend t)
1253           (goto-char (match-beginning 1))
1254           (let* ((scol         (current-column))
1255                  (ecol         (save-excursion
1256                                  (goto-char (match-end 1))
1257                                  (current-column)))
1258                  (next-tab-col (* (/ (+ scol 8) 8) 8)))
1259             (delete-region (match-beginning 1) (match-end 1))
1260             (when (<= next-tab-col ecol)
1261               (insert-char ?\t
1262                            (/ (- (- ecol (% ecol 8))  ; prev end col
1263                                  (- scol (% scol 8))) ; prev start col
1264                               8)))))))
1265     (set-marker rend nil)))             ; point marker to nowhere
1266
1267 \f
1268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1269 ;;;; Internal functions
1270
1271
1272 (defvar blank-font-lock-mode nil
1273   "Used to remember whether a buffer had font lock mode on or not.")
1274 (make-variable-buffer-local 'blank-font-lock-mode)
1275
1276 (defvar blank-font-lock nil
1277   "Used to remember whether a buffer initially had font lock on or not.")
1278 (make-variable-buffer-local 'blank-font-lock)
1279
1280 (defvar blank-font-lock-keywords nil
1281   "Used to save locally `font-lock-keywords' value.")
1282 (make-variable-buffer-local 'blank-font-lock-keywords)
1283
1284
1285 (defconst blank-help-text
1286   "\
1287       blank-mode toggle options:
1288
1289  []  t - toggle TAB visualization
1290  []  s - toggle SPACE and HARD SPACE visualization
1291  []  r - toggle trailing blanks visualization
1292  []  b - toggle SPACEs before TAB visualization
1293  []  l - toggle \"long lines\" visualization
1294  []  n - toggle NEWLINE visualization
1295  []  i - toggle indentation SPACEs visualization
1296  []  e - toggle empty line at bob and/or eob visualization
1297  []  a - toggle SPACEs after TAB visualization
1298
1299  []  c - toggle color faces
1300  []  m - toggle visual mark
1301
1302       x - restore `blank-chars' value
1303       z - restore `blank-style' value
1304
1305       ? - display this text\n\n"
1306   "Text for blank toggle options.")
1307
1308
1309 (defconst blank-help-buffer-name "*Blank Toggle Options*"
1310   "The buffer name for blank toggle options.")
1311
1312
1313 (defun blank-insert-option-mark (the-list the-value)
1314   "Insert the option mark ('X' or ' ') in toggle options buffer."
1315   (forward-line 1)
1316   (dolist (sym  the-list)
1317     (forward-line 1)
1318     (forward-char 2)
1319     (insert (if (memq sym the-value) "X" " "))))
1320
1321
1322 (defun blank-help-on (chars style)
1323   "Display the blank toggle options."
1324   (unless (get-buffer blank-help-buffer-name)
1325     (delete-other-windows)
1326     (let ((buffer (get-buffer-create blank-help-buffer-name)))
1327       (save-excursion
1328         (set-buffer buffer)
1329         (erase-buffer)
1330         (insert blank-help-text)
1331         (goto-char (point-min))
1332         (blank-insert-option-mark blank-chars-value-list chars)
1333         (blank-insert-option-mark blank-style-value-list style)
1334         (goto-char (point-min))
1335         (set-buffer-modified-p nil)
1336         (let ((size (- (window-height)
1337                        (max window-min-height
1338                             (1+ (count-lines (point-min) (point-max)))))))
1339           (when (<= size 0)
1340             (kill-buffer buffer)
1341             (error "Frame height is too small; \
1342 can't split window to display blank toggle options"))
1343           (set-window-buffer (split-window nil size) buffer))))))
1344
1345
1346 (defun blank-help-off ()
1347   "Remove the buffer and window of the blank toggle options."
1348   (let ((buffer (get-buffer blank-help-buffer-name)))
1349     (when buffer
1350       (delete-windows-on buffer)
1351       (kill-buffer buffer))))
1352
1353
1354 (defun blank-interactive-char (local-p)
1355   "Interactive function to read a char and return a symbol.
1356
1357 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1358 uses a global context.
1359
1360 It reads one of the following chars:
1361
1362   CHAR  MEANING
1363    t    toggle TAB visualization
1364    s    toggle SPACE and HARD SPACE visualization
1365    r    toggle trailing blanks visualization
1366    b    toggle SPACEs before TAB visualization
1367    l    toggle \"long lines\" visualization
1368    n    toggle NEWLINE visualization
1369    i    toggle indentation SPACEs visualization
1370    e    toggle empty line at bob and/or eob visualization
1371    a    toggle SPACEs after TAB visualization
1372    c    toggle color faces
1373    m    toggle visual mark
1374    x    restore `blank-chars' value
1375    z    restore `blank-style' value
1376    ?    display brief help
1377
1378 See also `blank-toggle-option-alist'."
1379   (let* ((is-off (not (if local-p blank-mode global-blank-mode)))
1380          (chars  (cond (is-off  blank-chars) ; use default value
1381                        (local-p blank-active-chars)
1382                        (t       blank-toggle-chars)))
1383          (style  (cond (is-off  blank-style) ; use default value
1384                        (local-p blank-active-style)
1385                        (t       blank-toggle-style)))
1386          (prompt
1387           (format "Blank Toggle %s (type ? for further options)-"
1388                   (if local-p "Local" "Global")))
1389          ch sym)
1390     ;; read a valid option and get the corresponding symbol
1391     (save-window-excursion
1392       (condition-case data
1393           (progn
1394             (while
1395                 ;; while condition
1396                 (progn
1397                   (setq ch (read-char prompt))
1398                   (not
1399                    (setq sym
1400                          (cdr (assq ch blank-toggle-option-alist)))))
1401               ;; while body
1402               (if (eq ch ?\?)
1403                   (blank-help-on chars style)
1404                 (ding)))
1405             (blank-help-off)
1406             (message " "))              ; clean echo area
1407         ;; handler
1408         ((quit error)
1409          (blank-help-off)
1410          (error (error-message-string data)))))
1411     (list sym)))                        ; return the apropriate symbol
1412
1413
1414 (defun blank-toggle-list (local-p arg the-list default-list
1415                                   sym-restore sym-list)
1416   "Toggle options in THE-LIST based on list ARG.
1417
1418 If LOCAL-P is non-nil, it uses a local context; otherwise, it
1419 uses a global context.
1420
1421 ARG is a list of options to be toggled.
1422
1423 THE-LIST is a list of options.  This list will be toggled and the
1424 resultant list will be returned.
1425
1426 DEFAULT-LIST is the default list of options.  It is used to
1427 restore the options in THE-LIST.
1428
1429 SYM-RESTORE is the symbol which indicates to restore the options
1430 in THE-LIST.
1431
1432 SYM-LIST is a list of valid options, used to check if the ARG's
1433 options are valid."
1434   (unless (if local-p blank-mode global-blank-mode)
1435     (setq the-list default-list))
1436   (setq the-list (copy-sequence the-list)) ; keep original list
1437   (dolist (sym (if (listp arg) arg (list arg)))
1438     (cond
1439      ;; restore default values
1440      ((eq sym sym-restore)
1441       (setq the-list default-list))
1442      ;; toggle valid values
1443      ((memq sym sym-list)
1444       (setq the-list (if (memq sym the-list)
1445                          (delq sym the-list)
1446                        (cons sym the-list))))))
1447   the-list)
1448
1449
1450 (defun blank-turn-on ()
1451   "Turn on blank visualization."
1452   (setq blank-active-style (if (listp blank-style)
1453                                blank-style
1454                              (list blank-style)))
1455   (setq blank-active-chars (if (listp blank-chars)
1456                                blank-chars
1457                              (list blank-chars)))
1458   (when (memq 'color blank-active-style)
1459     (blank-color-on))
1460   (when (memq 'mark  blank-active-style)
1461     (blank-display-char-on)))
1462
1463
1464 (defun blank-turn-off ()
1465   "Turn off blank visualization."
1466   (when (memq 'color blank-active-style)
1467     (blank-color-off))
1468   (when (memq 'mark  blank-active-style)
1469     (blank-display-char-off)))
1470
1471
1472 (defun blank-color-on ()
1473   "Turn on color visualization."
1474   (when blank-active-chars
1475     (unless blank-font-lock
1476       (setq blank-font-lock t
1477             blank-font-lock-keywords
1478             (copy-sequence font-lock-keywords)))
1479     ;; turn off font lock
1480     (setq blank-font-lock-mode font-lock-mode)
1481     (font-lock-mode 0)
1482     ;; add blank-mode color into font lock
1483     (when (memq 'spaces blank-active-chars)
1484       (font-lock-add-keywords
1485        nil
1486        (list
1487         ;; Show SPACEs
1488         (list blank-space-regexp  1 blank-space  t)
1489         ;; Show HARD SPACEs
1490         (list blank-hspace-regexp 1 blank-hspace t))
1491        t))
1492     (when (memq 'tabs blank-active-chars)
1493       (font-lock-add-keywords
1494        nil
1495        (list
1496         ;; Show TABs
1497         (list blank-tab-regexp 1 blank-tab t))
1498        t))
1499     (when (memq 'trailing blank-active-chars)
1500       (font-lock-add-keywords
1501        nil
1502        (list
1503         ;; Show trailing blanks
1504         (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$")
1505               1 blank-trailing t))
1506        t))
1507     (when (memq 'lines blank-active-chars)
1508       (font-lock-add-keywords
1509        nil
1510        (list
1511         ;; Show "long" lines
1512         (list (concat "^\\(.\\{" (int-to-string blank-line-length)
1513                       ",\\}\\)$")
1514               1 blank-line t))
1515        t))
1516     (when (memq 'space-before-tab blank-active-chars)
1517       (font-lock-add-keywords
1518        nil
1519        (list
1520         ;; Show SPACEs before TAB
1521         (list blank-space-before-tab-regexp
1522               1 blank-space-before-tab t))
1523        t))
1524     (when (memq 'indentation blank-active-chars)
1525       (font-lock-add-keywords
1526        nil
1527        (list
1528         ;; Show indentation SPACEs
1529         (list blank-indentation-regexp
1530               1 blank-indentation t))
1531        t))
1532     (when (memq 'empty blank-active-chars)
1533       (font-lock-add-keywords
1534        nil
1535        (list
1536         ;; Show empty lines at beginning of buffer
1537         (list blank-empty-at-bob-regexp
1538               1 blank-empty t))
1539        t)
1540       (font-lock-add-keywords
1541        nil
1542        (list
1543         ;; Show empty lines at end of buffer
1544         (list blank-empty-at-eob-regexp
1545               1 blank-empty t))
1546        t))
1547     (when (memq 'space-after-tab blank-active-chars)
1548       (font-lock-add-keywords
1549        nil
1550        (list
1551         ;; Show SPACEs after TAB
1552         (list blank-space-after-tab-regexp
1553               1 blank-space-after-tab t))
1554        t))
1555     ;; now turn on font lock and highlight blanks
1556     (font-lock-mode 1)))
1557
1558
1559 (defun blank-color-off ()
1560   "Turn off color visualization."
1561   (when blank-active-chars
1562     ;; turn off font lock
1563     (font-lock-mode 0)
1564     (when blank-font-lock
1565       (setq blank-font-lock nil
1566             font-lock-keywords blank-font-lock-keywords))
1567     ;; restore original font lock state
1568     (font-lock-mode blank-font-lock-mode)))
1569
1570 \f
1571 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1572 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>)
1573
1574
1575 (defvar blank-display-table nil
1576   "Used to save a local display table.")
1577 (make-variable-buffer-local 'blank-display-table)
1578
1579 (defvar blank-display-table-was-local nil
1580   "Used to remember whether a buffer initially had a local display table or not.")
1581 (make-variable-buffer-local 'blank-display-table-was-local)
1582
1583
1584 (defsubst blank-char-valid-p (char)
1585   ;; This check should be improved!!!
1586   (or (< char 256)
1587       (char-valid-p char)))
1588
1589
1590 (defun blank-legal-display-vector-p (vec)
1591   "Return true if every character in vector VEC can be displayed."
1592   (let ((i (length vec)))
1593     (when (> i 0)
1594       (while (and (>= (setq i (1- i)) 0)
1595                   (blank-char-valid-p (aref vec i))))
1596       (< i 0))))
1597
1598
1599 (defun blank-display-char-on ()
1600   "Turn on character display mapping."
1601   (when blank-display-mappings
1602     (let (vecs vec)
1603       ;; Remember whether a buffer has a local display table.
1604       (unless blank-display-table-was-local
1605         (setq blank-display-table-was-local t
1606               blank-display-table
1607               (copy-sequence buffer-display-table)))
1608       (unless buffer-display-table
1609         (setq buffer-display-table (make-display-table)))
1610       (dolist (entry blank-display-mappings)
1611         (setq vecs (cdr entry))
1612         ;; Get a displayable mapping.
1613         (while (and vecs
1614                     (not (blank-legal-display-vector-p (car vecs))))
1615           (setq vecs (cdr vecs)))
1616         ;; Display a valid mapping.
1617         (when vecs
1618           (setq vec (copy-sequence (car vecs)))
1619           (cond
1620            ;; Any char except newline
1621            ((not (eq (car entry) ?\n))
1622             (aset buffer-display-table (car entry) vec))
1623            ;; Newline char - display it
1624            ((memq 'newline blank-active-chars)
1625             ;; Only insert face bits on NEWLINE char mapping to avoid
1626             ;; obstruction of other faces like TABs and (HARD) SPACEs
1627             ;; faces, font-lock faces, etc.
1628             (when (memq 'color blank-active-style)
1629               (dotimes (i (length vec))
1630                 ;; Due to limitations of glyph representation, the char
1631                 ;; code can not be above ?\x1FFFF.  Probably, this will
1632                 ;; be fixed after Emacs unicode merging.
1633                 (or (eq (aref vec i) ?\n)
1634                     (> (aref vec i) #x1FFFF)
1635                     (aset vec i (make-glyph-code (aref vec i)
1636                                                  blank-newline)))))
1637             ;; Display mapping
1638             (aset buffer-display-table (car entry) vec))
1639            ;; Newline char - don't display it
1640            (t
1641             ;; Do nothing
1642             )))))))
1643
1644
1645 (defun blank-display-char-off ()
1646   "Turn off character display mapping."
1647   (and blank-display-mappings
1648        blank-display-table-was-local
1649        (setq blank-display-table-was-local nil
1650              buffer-display-table          blank-display-table)))
1651
1652 \f
1653 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1654
1655
1656 (provide 'blank-mode)
1657
1658
1659 (run-hooks 'blank-load-hook)
1660
1661
1662 ;; arch-tag: 1b1e2500-dbd4-4a26-8f7a-5a5edfd3c97e
1663 ;;; blank-mode.el ends here