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