Mercurial > emacs
comparison lisp/blank-mode.el @ 87815:3842a0e47a00
New file: blank-mode.el
author | Vinicius Jose Latorre <viniciusjl@ig.com.br> |
---|---|
date | Thu, 17 Jan 2008 12:46:55 +0000 |
parents | |
children | 37b9cc9f1a31 |
comparison
equal
deleted
inserted
replaced
87814:660a1716aee4 | 87815:3842a0e47a00 |
---|---|
1 ;;; blank-mode.el --- minor mode to visualise 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: 8.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 visualise blanks (TAB, (HARD) SPACE | |
37 ;; and NEWLINE). | |
38 ;; | |
39 ;; blank-mode uses two ways to visualise 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 visualise 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 visualisation." t) | |
98 ;; (autoload 'blank-toggle-options "blank-mode" | |
99 ;; "Toggle local `blank-mode' options." t) | |
100 ;; | |
101 ;; blank-mode was inspired by: | |
102 ;; | |
103 ;; show-whitespace-mode.el Aurelien Tisne <aurelien.tisne@free.fr> | |
104 ;; Simple mode to highlight whitespaces | |
105 ;; (inspired the idea to use font-lock) | |
106 ;; | |
107 ;; whitespace-mode.el Lawrence Mitchell <wence@gmx.li> | |
108 ;; Major mode for editing Whitespace | |
109 ;; (inspired the idea to use display table) | |
110 ;; | |
111 ;; visws.el Miles Bader <miles@gnu.org> | |
112 ;; Make whitespace visible | |
113 ;; (handle display table, his code was modified, but the main | |
114 ;; idea was kept) | |
115 ;; | |
116 ;; | |
117 ;; Using blank-mode | |
118 ;; ---------------- | |
119 ;; | |
120 ;; There is no problem if you mix local and global minor mode usage. | |
121 ;; | |
122 ;; * LOCAL blank-mode: | |
123 ;; + To toggle blank-mode options locally, type: | |
124 ;; | |
125 ;; M-x blank-toggle-options RET | |
126 ;; | |
127 ;; + To activate blank-mode locally, type: | |
128 ;; | |
129 ;; C-u 1 M-x blank-mode RET | |
130 ;; | |
131 ;; + To deactivate blank-mode locally, type: | |
132 ;; | |
133 ;; C-u 0 M-x blank-mode RET | |
134 ;; | |
135 ;; + To toggle blank-mode locally, type: | |
136 ;; | |
137 ;; M-x blank-mode RET | |
138 ;; | |
139 ;; * GLOBAL blank-mode: | |
140 ;; + To toggle blank-mode options globally, type: | |
141 ;; | |
142 ;; M-x global-blank-toggle-options RET | |
143 ;; | |
144 ;; + To activate blank-mode globally, type: | |
145 ;; | |
146 ;; C-u 1 M-x global-blank-mode RET | |
147 ;; | |
148 ;; + To deactivate blank-mode globally, type: | |
149 ;; | |
150 ;; C-u 0 M-x global-blank-mode RET | |
151 ;; | |
152 ;; + To toggle blank-mode globally, type: | |
153 ;; | |
154 ;; M-x global-blank-mode RET | |
155 ;; | |
156 ;; | |
157 ;; Hooks | |
158 ;; ----- | |
159 ;; | |
160 ;; blank-mode has the following hook variables: | |
161 ;; | |
162 ;; `blank-mode-hook' | |
163 ;; It is evaluated always when blank-mode is turned on locally. | |
164 ;; | |
165 ;; `global-blank-mode-hook' | |
166 ;; It is evaluated always when blank-mode is turned on globally. | |
167 ;; | |
168 ;; `blank-load-hook' | |
169 ;; It is evaluated after blank-mode package is loaded. | |
170 ;; | |
171 ;; | |
172 ;; Options | |
173 ;; ------- | |
174 ;; | |
175 ;; Below it's shown a brief description of blank-mode options, please, | |
176 ;; see the options declaration in the code for a long documentation. | |
177 ;; | |
178 ;; `blank-style' Specify the visualisation style. | |
179 ;; | |
180 ;; `blank-chars' Specify which kind of blank is | |
181 ;; visualised. | |
182 ;; | |
183 ;; `blank-space-face' Face used to visualise SPACE. | |
184 ;; | |
185 ;; `blank-hspace-face' Face used to visualise HARD SPACE. | |
186 ;; | |
187 ;; `blank-tab-face' Face used to visualise TAB. | |
188 ;; | |
189 ;; `blank-newline-face' Face used to visualise NEWLINE char | |
190 ;; mapping. | |
191 ;; | |
192 ;; `blank-trailing-face' Face used to visualise trailing | |
193 ;; blanks. | |
194 ;; | |
195 ;; `blank-line-face' Face used to visualise "long" lines. | |
196 ;; | |
197 ;; `blank-space-before-tab-face' Face used to visualise SPACEs | |
198 ;; before TAB. | |
199 ;; | |
200 ;; `blank-space-regexp' Specify SPACE characters regexp. | |
201 ;; | |
202 ;; `blank-hspace-regexp' Specify HARD SPACE characters regexp. | |
203 ;; | |
204 ;; `blank-tab-regexp' Specify TAB characters regexp. | |
205 ;; | |
206 ;; `blank-trailing-regexp' Specify trailing characters regexp. | |
207 ;; | |
208 ;; `blank-space-before-tab-regexp' Specify SPACEs before TAB | |
209 ;; regexp. | |
210 ;; | |
211 ;; `blank-line-length' Specify length beyond which the line | |
212 ;; is highlighted. | |
213 ;; | |
214 ;; `blank-display-mappings' Specify an alist of mappings for | |
215 ;; displaying characters. | |
216 ;; | |
217 ;; `blank-global-modes' Modes for which global `blank-mode' is | |
218 ;; automagically turned on. | |
219 ;; | |
220 ;; | |
221 ;; Acknowledgements | |
222 ;; ---------------- | |
223 ;; | |
224 ;; Thanks to Juri Linkov <juri@jurta.org> for suggesting: | |
225 ;; * `define-minor-mode'. | |
226 ;; * `global-blank-*' name for global commands. | |
227 ;; | |
228 ;; Thanks to Robert J. Chassell <bob@gnu.org> for doc fix and testing. | |
229 ;; | |
230 ;; Thanks to Drew Adams <drew.adams@oracle.com> for toggle commands | |
231 ;; suggestion. | |
232 ;; | |
233 ;; Thanks to Antti Kaihola <antti.kaihola@linux-aktivaattori.org> for | |
234 ;; helping to fix `find-file-hooks' reference. | |
235 ;; | |
236 ;; Thanks to Andreas Roehler <andreas.roehler@easy-emacs.de> for | |
237 ;; indicating defface byte-compilation warnings. | |
238 ;; | |
239 ;; Thanks to TimOCallaghan (EmacsWiki) for the idea about highlight | |
240 ;; "long" lines. See EightyColumnRule (EmacsWiki). | |
241 ;; | |
242 ;; Thanks to Yanghui Bian <yanghuibian@gmail.com> for indicating a new | |
243 ;; newline character mapping. | |
244 ;; | |
245 ;; Thanks to Pete Forman <pete.forman@westgeo.com> for indicating | |
246 ;; whitespace-mode on XEmacs. | |
247 ;; | |
248 ;; Thanks to Miles Bader <miles@gnu.org> for handling display table via | |
249 ;; visws.el (his code was modified, but the main idea was kept). | |
250 ;; | |
251 ;; Thanks to: | |
252 ;; Aurelien Tisne <aurelien.tisne@free.fr> show-whitespace-mode.el | |
253 ;; Lawrence Mitchell <wence@gmx.li> whitespace-mode.el | |
254 ;; Miles Bader <miles@gnu.org> visws.el | |
255 ;; And to all people who contributed with them. | |
256 ;; | |
257 ;; | |
258 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
259 | |
260 ;;; code: | |
261 | |
262 | |
263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
264 ;;;; User Variables: | |
265 | |
266 | |
267 ;;; Interface to the command system | |
268 | |
269 | |
270 (defgroup blank nil | |
271 "Visualise blanks (TAB, (HARD) SPACE and NEWLINE)." | |
272 :link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el") | |
273 :version "22.2" | |
274 :group 'wp | |
275 :group 'data) | |
276 | |
277 | |
278 (defcustom blank-style '(mark color) | |
279 "*Specify the visualisation style. | |
280 | |
281 It's a list which element value can be: | |
282 | |
283 mark display mappings are visualised. | |
284 | |
285 color faces are visualised. | |
286 | |
287 Any other value is ignored. | |
288 | |
289 If it's nil, don't visualise TABs, (HARD) SPACEs and NEWLINEs. | |
290 | |
291 See also `blank-display-mappings' for documentation." | |
292 :type '(repeat :tag "Style of Blank" | |
293 (choice :tag "Style of Blank" | |
294 (const :tag "Display Table" mark) | |
295 (const :tag "Faces" color))) | |
296 :group 'blank) | |
297 | |
298 | |
299 (defcustom blank-chars | |
300 '(tabs spaces trailing lines space-before-tab newline) | |
301 "*Specify which kind of blank is visualised. | |
302 | |
303 It's a list which element value can be: | |
304 | |
305 trailing trailing blanks are visualised. | |
306 | |
307 tabs TABs are visualised. | |
308 | |
309 spaces SPACEs and HARD SPACEs are visualised. | |
310 | |
311 lines lines whose length is greater than | |
312 `blank-line-length' are highlighted. | |
313 | |
314 space-before-tab SPACEs before TAB are visualised. | |
315 | |
316 newline NEWLINEs are visualised. | |
317 | |
318 Any other element value is ignored. | |
319 | |
320 If it's nil, don't visualise TABs, (HARD) SPACEs and NEWLINEs. | |
321 | |
322 Used when `blank-style' has `color' as an element. | |
323 If `blank-chars' has `newline' as an element, used when `blank-style' | |
324 has `mark' as an element." | |
325 :type '(repeat :tag "Kind of Blank" | |
326 (choice :tag "Kind of Blank" | |
327 (const :tag "Trailing TABs, SPACEs and HARD SPACEs" | |
328 trailing) | |
329 (const :tag "SPACEs and HARD SPACEs" spaces) | |
330 (const :tag "TABs" tabs) | |
331 (const :tag "Lines" lines) | |
332 (const :tag "SPACEs before TAB" | |
333 space-before-tab) | |
334 (const :tag "NEWLINEs" newline))) | |
335 :group 'blank) | |
336 | |
337 | |
338 (defcustom blank-space-face 'blank-space-face | |
339 "*Symbol face used to visualise SPACE. | |
340 | |
341 Used when `blank-style' has `color' as an element." | |
342 :type 'face | |
343 :group 'blank) | |
344 | |
345 | |
346 (defface blank-space-face | |
347 '((((class color) (background dark)) | |
348 (:background "grey20" :foreground "aquamarine3")) | |
349 (((class color) (background light)) | |
350 (:background "LightYellow" :foreground "aquamarine3")) | |
351 (t (:inverse-video t))) | |
352 "Face used to visualise SPACE." | |
353 :group 'blank) | |
354 | |
355 | |
356 (defcustom blank-hspace-face 'blank-hspace-face | |
357 "*Symbol face used to visualise HARD SPACE. | |
358 | |
359 Used when `blank-style' has `color' as an element." | |
360 :type 'face | |
361 :group 'blank) | |
362 | |
363 | |
364 (defface blank-hspace-face ; 'nobreak-space | |
365 '((((class color) (background dark)) | |
366 (:background "grey24" :foreground "aquamarine3")) | |
367 (((class color) (background light)) | |
368 (:background "LemonChiffon3" :foreground "aquamarine3")) | |
369 (t (:inverse-video t))) | |
370 "Face used to visualise HARD SPACE." | |
371 :group 'blank) | |
372 | |
373 | |
374 (defcustom blank-tab-face 'blank-tab-face | |
375 "*Symbol face used to visualise TAB. | |
376 | |
377 Used when `blank-style' has `color' as an element." | |
378 :type 'face | |
379 :group 'blank) | |
380 | |
381 | |
382 (defface blank-tab-face | |
383 '((((class color) (background dark)) | |
384 (:background "grey22" :foreground "aquamarine3")) | |
385 (((class color) (background light)) | |
386 (:background "beige" :foreground "aquamarine3")) | |
387 (t (:inverse-video t))) | |
388 "Face used to visualise TAB." | |
389 :group 'blank) | |
390 | |
391 | |
392 (defcustom blank-newline-face 'blank-newline-face | |
393 "*Symbol face used to visualise NEWLINE char mapping. | |
394 | |
395 See `blank-display-mappings'. | |
396 | |
397 Used when `blank-style' has `mark' and `color' as elements | |
398 and `blank-chars' has `newline' as an element." | |
399 :type 'face | |
400 :group 'blank) | |
401 | |
402 | |
403 (defface blank-newline-face | |
404 '((((class color) (background dark)) | |
405 (:background "grey26" :foreground "aquamarine3" :bold t)) | |
406 (((class color) (background light)) | |
407 (:background "linen" :foreground "aquamarine3" :bold t)) | |
408 (t (:bold t :underline t))) | |
409 "Face used to visualise NEWLINE char mapping. | |
410 | |
411 See `blank-display-mappings'." | |
412 :group 'blank) | |
413 | |
414 | |
415 (defcustom blank-trailing-face 'blank-trailing-face | |
416 "*Symbol face used to visualise traling blanks. | |
417 | |
418 Used when `blank-style' has `color' as an element." | |
419 :type 'face | |
420 :group 'blank) | |
421 | |
422 | |
423 (defface blank-trailing-face ; 'trailing-whitespace | |
424 '((((class mono)) (:inverse-video t :bold t :underline t)) | |
425 (t (:background "red1" :foreground "yellow" :bold t))) | |
426 "Face used to visualise trailing blanks." | |
427 :group 'blank) | |
428 | |
429 | |
430 (defcustom blank-line-face 'blank-line-face | |
431 "*Symbol face used to visualise \"long\" lines. | |
432 | |
433 See `blank-line-legnth'. | |
434 | |
435 Used when `blank-style' has `color' as an element." | |
436 :type 'face | |
437 :group 'blank) | |
438 | |
439 | |
440 (defface blank-line-face | |
441 '((((class mono)) (:inverse-video t :bold t :underline t)) | |
442 (t (:background "gray20" :foreground "violet"))) | |
443 "Face used to visualise \"long\" lines. | |
444 | |
445 See `blank-line-length'." | |
446 :group 'blank) | |
447 | |
448 | |
449 (defcustom blank-space-before-tab-face 'blank-space-before-tab-face | |
450 "*Symbol face used to visualise SPACEs before TAB. | |
451 | |
452 Used when `blank-style' has `color' as an element." | |
453 :type 'face | |
454 :group 'blank) | |
455 | |
456 | |
457 (defface blank-space-before-tab-face | |
458 '((((class mono)) (:inverse-video t :bold t :underline t)) | |
459 (t (:background "DarkOrange" :foreground "firebrick"))) | |
460 "Face used to visualise SPACEs before TAB." | |
461 :group 'blank) | |
462 | |
463 | |
464 (defcustom blank-hspace-regexp | |
465 "\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)" | |
466 "*Specify HARD SPACE characters regexp. | |
467 | |
468 If you're using `mule' package, it may exist other characters besides: | |
469 | |
470 \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\" | |
471 | |
472 that it should be considered HARD SPACE. | |
473 | |
474 Here are some examples: | |
475 | |
476 \"\\\\(^\\xA0+\\\\)\" \ | |
477 visualise only leading HARD SPACEs. | |
478 \"\\\\(\\xA0+$\\\\)\" \ | |
479 visualise only trailing HARD SPACEs. | |
480 \"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \ | |
481 visualise leading and/or trailing HARD SPACEs. | |
482 \"\\t\\\\(\\xA0+\\\\)\\t\" \ | |
483 visualise only HARD SPACEs between TABs. | |
484 | |
485 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | |
486 Use exactly one pair of enclosing \\\\( and \\\\). | |
487 | |
488 Used when `blank-style' has `color' as an element, and | |
489 `blank-chars' has `spaces' as an element." | |
490 :type '(regexp :tag "HARD SPACE Chars") | |
491 :group 'blank) | |
492 | |
493 | |
494 (defcustom blank-space-regexp "\\( +\\)" | |
495 "*Specify SPACE characters regexp. | |
496 | |
497 If you're using `mule' package, it may exist other characters | |
498 besides \" \" that it should be considered SPACE. | |
499 | |
500 Here are some examples: | |
501 | |
502 \"\\\\(^ +\\\\)\" visualise only leading SPACEs. | |
503 \"\\\\( +$\\\\)\" visualise only trailing SPACEs. | |
504 \"\\\\(^ +\\\\| +$\\\\)\" \ | |
505 visualise leading and/or trailing SPACEs. | |
506 \"\\t\\\\( +\\\\)\\t\" visualise only SPACEs between TABs. | |
507 | |
508 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | |
509 Use exactly one pair of enclosing \\\\( and \\\\). | |
510 | |
511 Used when `blank-style' has `color' as an element, and | |
512 `blank-chars' has `spaces' as an element." | |
513 :type '(regexp :tag "SPACE Chars") | |
514 :group 'blank) | |
515 | |
516 | |
517 (defcustom blank-tab-regexp "\\(\t+\\)" | |
518 "*Specify TAB characters regexp. | |
519 | |
520 If you're using `mule' package, it may exist other characters | |
521 besides \"\\t\" that it should be considered TAB. | |
522 | |
523 Here are some examples: | |
524 | |
525 \"\\\\(^\\t+\\\\)\" visualise only leading TABs. | |
526 \"\\\\(\\t+$\\\\)\" visualise only trailing TABs. | |
527 \"\\\\(^\\t+\\\\|\\t+$\\\\)\" \ | |
528 visualise leading and/or trailing TABs. | |
529 \" \\\\(\\t+\\\\) \" visualise only TABs between SPACEs. | |
530 | |
531 NOTE: Enclose always by \\\\( and \\\\) the elements to highlight. | |
532 Use exactly one pair of enclosing \\\\( and \\\\). | |
533 | |
534 Used when `blank-style' has `color' as an element, and | |
535 `blank-chars' has `tabs' as an element." | |
536 :type '(regexp :tag "TAB Chars") | |
537 :group 'blank) | |
538 | |
539 | |
540 (defcustom blank-trailing-regexp | |
541 "\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20" | |
542 "*Specify trailing characters regexp. | |
543 | |
544 If you're using `mule' package, it may exist other characters besides: | |
545 | |
546 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | |
547 \"\\xF20\" | |
548 | |
549 that it should be considered blank. | |
550 | |
551 NOTE: DOES NOT enclose by \\\\( and \\\\) the elements to highlight. | |
552 `blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and | |
553 \"\\\\)+\\\\)$\". | |
554 | |
555 Used when `blank-style' has `color' as an element, and | |
556 `blank-chars' has `trailing' as an element." | |
557 :type '(regexp :tag "Trailing Chars") | |
558 :group 'blank) | |
559 | |
560 | |
561 (defcustom blank-space-before-tab-regexp "\\( +\\)\t" | |
562 "*Specify SPACEs before TAB regexp. | |
563 | |
564 If you're using `mule' package, it may exist other characters besides: | |
565 | |
566 \" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \ | |
567 \"\\xF20\" | |
568 | |
569 that it should be considered blank. | |
570 | |
571 Used when `blank-style' has `color' as an element, and | |
572 `blank-chars' has `space-before-tab' as an element." | |
573 :type '(regexp :tag "SPACEs Before TAB") | |
574 :group 'blank) | |
575 | |
576 | |
577 (defcustom blank-line-length 80 | |
578 "*Specify length beyond which the line is highlighted. | |
579 | |
580 Used when `blank-style' has `color' as an element, and | |
581 `blank-chars' has `lines' as an element." | |
582 :type '(integer :tag "Line Length") | |
583 :group 'blank) | |
584 | |
585 | |
586 ;; Hacked from `visible-whitespace-mappings' in visws.el | |
587 (defcustom blank-display-mappings | |
588 ;; Due to limitations of glyph representation, the char code can not | |
589 ;; be above ?\x1FFFF. Probably, this will be fixed after Emacs | |
590 ;; unicode merging. | |
591 '( | |
592 (?\ [?\xB7] [?.]) ; space - centered dot | |
593 (?\xA0 [?\xA4] [?_]) ; hard space - currency | |
594 (?\x8A0 [?\x8A4] [?_]) ; hard space - currency | |
595 (?\x920 [?\x924] [?_]) ; hard space - currency | |
596 (?\xE20 [?\xE24] [?_]) ; hard space - currency | |
597 (?\xF20 [?\xF24] [?_]) ; hard space - currency | |
598 ;; NEWLINE is displayed using the face `blank-newline-face' | |
599 (?\n [?$ ?\n]) ; end-of-line - dollar sign | |
600 ;; (?\n [?\u21B5 ?\n] [?$ ?\n]) ; end-of-line - downwards arrow | |
601 ;; (?\n [?\xB6 ?\n] [?$ ?\n]) ; end-of-line - pilcrow | |
602 ;; (?\n [?\x8AF ?\n] [?$ ?\n]) ; end-of-line - overscore | |
603 ;; (?\n [?\x8AC ?\n] [?$ ?\n]) ; end-of-line - negation | |
604 ;; (?\n [?\x8B0 ?\n] [?$ ?\n]) ; end-of-line - grade | |
605 ;; | |
606 ;; WARNING: the mapping below has a problem. | |
607 ;; When a TAB occupies exactly one column, it will display the | |
608 ;; character ?\xBB at that column followed by a TAB which goes to | |
609 ;; the next TAB column. | |
610 ;; If this is a problem for you, please, comment the line below. | |
611 (?\t [?\xBB ?\t] [?\\ ?\t]) ; tab - left quote mark | |
612 ) | |
613 "*Specify an alist of mappings for displaying characters. | |
614 | |
615 Each element has the following form: | |
616 | |
617 (CHAR VECTOR...) | |
618 | |
619 Where: | |
620 | |
621 CHAR is the character to be mapped. | |
622 | |
623 VECTOR is a vector of characters to be displayed in place of CHAR. | |
624 The first display vector that can be displayed is used; | |
625 if no display vector for a mapping can be displayed, then | |
626 that character is displayed unmodified. | |
627 | |
628 The NEWLINE character is displayed using the face given by | |
629 `blank-newline-face' variable. The characters in the vector to be | |
630 displayed will not have applied this face if the character code is | |
631 above #x1FFFF. | |
632 | |
633 Used when `blank-style' has `mark' as an element." | |
634 :type '(repeat | |
635 (list :tag "Character Mapping" | |
636 (character :tag "Char") | |
637 (repeat :inline t :tag "Vector List" | |
638 (vector :tag "" | |
639 (repeat :inline t | |
640 :tag "Vector Characters" | |
641 (character :tag "Char")))))) | |
642 :group 'blank) | |
643 | |
644 | |
645 (defcustom blank-global-modes t | |
646 "*Modes for which global `blank-mode' is automagically turned on. | |
647 | |
648 Global `blank-mode' is controlled by the command `global-blank-mode'. | |
649 | |
650 If nil, means no modes have `blank-mode' automatically turned on. | |
651 If t, all modes that support `blank-mode' have it automatically | |
652 turned on. | |
653 If a list, it should be a list of `major-mode' symbol names for | |
654 which `blank-mode' should be automatically turned on. The sense | |
655 of the list is negated if it begins with `not'. For example: | |
656 | |
657 (c-mode c++-mode) | |
658 | |
659 means that `blank-mode' is turned on for buffers in C and C++ | |
660 modes only." | |
661 :type '(choice (const :tag "none" nil) | |
662 (const :tag "all" t) | |
663 (set :menu-tag "mode specific" :tag "modes" | |
664 :value (not) | |
665 (const :tag "Except" not) | |
666 (repeat :inline t | |
667 (symbol :tag "mode")))) | |
668 :group 'blank) | |
669 | |
670 | |
671 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
672 ;;;; User commands - Local mode | |
673 | |
674 | |
675 ;;;###autoload | |
676 (define-minor-mode blank-mode | |
677 "Toggle blank minor mode visualisation (bl on modeline). | |
678 | |
679 If ARG is null, toggle blank visualisation. | |
680 If ARG is a number and is greater than zero, turn on | |
681 visualisation; otherwise, turn off visualisation. | |
682 Only useful with a windowing system." | |
683 :lighter " bl" | |
684 :init-value nil | |
685 :global nil | |
686 :group 'blank | |
687 (cond | |
688 (noninteractive ; running a batch job | |
689 (setq blank-mode nil)) | |
690 (blank-mode ; blank-mode on | |
691 (blank-turn-on)) | |
692 (t ; blank-mode off | |
693 (blank-turn-off)))) | |
694 | |
695 | |
696 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
697 ;;;; User commands - Global mode | |
698 | |
699 | |
700 (define-minor-mode global-blank-mode | |
701 "Toggle blank global minor mode visualisation (BL on modeline). | |
702 | |
703 If ARG is null, toggle blank visualisation. | |
704 If ARG is a number and is greater than zero, turn on | |
705 visualisation; otherwise, turn off visualisation. | |
706 Only useful with a windowing system." | |
707 :lighter " BL" | |
708 :init-value nil | |
709 :global t | |
710 :group 'blank | |
711 (cond | |
712 (noninteractive ; running a batch job | |
713 (setq global-blank-mode nil)) | |
714 (global-blank-mode ; global-blank-mode on | |
715 (save-excursion | |
716 (if (boundp 'find-file-hook) | |
717 (add-hook 'find-file-hook 'blank-turn-on-if-enabled t) | |
718 (add-hook 'find-file-hooks 'blank-turn-on-if-enabled t)) | |
719 (dolist (buffer (buffer-list)) ; adjust all local mode | |
720 (set-buffer buffer) | |
721 (unless blank-mode | |
722 (blank-turn-on-if-enabled))))) | |
723 (t ; global-blank-mode off | |
724 (save-excursion | |
725 (if (boundp 'find-file-hook) | |
726 (remove-hook 'find-file-hook 'blank-turn-on-if-enabled) | |
727 (remove-hook 'find-file-hooks 'blank-turn-on-if-enabled)) | |
728 (dolist (buffer (buffer-list)) ; adjust all local mode | |
729 (set-buffer buffer) | |
730 (unless blank-mode | |
731 (blank-turn-off))))))) | |
732 | |
733 | |
734 (defun blank-turn-on-if-enabled () | |
735 (when (cond | |
736 ((eq blank-global-modes t)) | |
737 ((listp blank-global-modes) | |
738 (if (eq (car-safe blank-global-modes) 'not) | |
739 (not (memq major-mode (cdr blank-global-modes))) | |
740 (memq major-mode blank-global-modes))) | |
741 (t nil)) | |
742 (let (inhibit-quit) | |
743 ;; Don't turn on blank mode if... | |
744 (or | |
745 ;; ...we don't have a display (we're running a batch job) | |
746 noninteractive | |
747 ;; ...or if the buffer is invisible (name starts with a space) | |
748 (eq (aref (buffer-name) 0) ?\ ) | |
749 ;; ...or if the buffer is temporary (name starts with *) | |
750 (and (eq (aref (buffer-name) 0) ?*) | |
751 ;; except the scratch buffer. | |
752 (not (string= (buffer-name) "*scratch*"))) | |
753 ;; Otherwise, turn on blank mode. | |
754 (blank-turn-on))))) | |
755 | |
756 | |
757 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
758 ;;;; User commands - Toggle | |
759 | |
760 | |
761 (defconst blank-chars-value-list | |
762 '(tabs | |
763 spaces | |
764 trailing | |
765 space-before-tab | |
766 lines | |
767 newline | |
768 ) | |
769 "List of valid `blank-chars' value.") | |
770 | |
771 | |
772 (defconst blank-style-value-list | |
773 '(color | |
774 mark | |
775 ) | |
776 "List of valid `blank-style' value.") | |
777 | |
778 | |
779 (defconst blank-toggle-option-alist | |
780 '((?t . tabs) | |
781 (?s . spaces) | |
782 (?r . trailing) | |
783 (?b . space-before-tab) | |
784 (?l . lines) | |
785 (?n . newline) | |
786 (?c . color) | |
787 (?m . mark) | |
788 (?x . blank-chars) | |
789 (?z . blank-style) | |
790 ) | |
791 "Alist of toggle options. | |
792 | |
793 Each element has the form: | |
794 | |
795 (CHAR . SYMBOL) | |
796 | |
797 Where: | |
798 | |
799 CHAR is a char which the user will have to type. | |
800 | |
801 SYMBOL is a valid symbol associated with CHAR. | |
802 See `blank-chars-value-list' and `blank-style-value-list'.") | |
803 | |
804 | |
805 (defvar blank-active-chars nil | |
806 "Used to save locally `blank-chars' value.") | |
807 (make-variable-buffer-local 'blank-active-chars) | |
808 | |
809 (defvar blank-active-style nil | |
810 "Used to save locally `blank-style' value.") | |
811 (make-variable-buffer-local 'blank-active-style) | |
812 | |
813 | |
814 ;;;###autoload | |
815 (defun blank-toggle-options (arg) | |
816 "Toggle local `blank-mode' options. | |
817 | |
818 If local blank-mode is off, toggle the option given by ARG and | |
819 turn on local blank-mode. | |
820 | |
821 If local blank-mode is on, toggle the option given by ARG and | |
822 restart local blank-mode. | |
823 | |
824 Interactively, it reads one of the following chars: | |
825 | |
826 CHAR MEANING | |
827 t toggle TAB visualisation | |
828 s toggle SPACE and HARD SPACE visualisation | |
829 r toggle trailing blanks visualisation | |
830 b toggle SPACEs before TAB visualisation | |
831 l toggle \"long lines\" visualisation | |
832 n toggle NEWLINE visualisation | |
833 c toggle color faces | |
834 m toggle visual mark | |
835 x restore `blank-chars' value | |
836 z restore `blank-style' value | |
837 ? display brief help | |
838 | |
839 Non-interactively, ARG should be a symbol or a list of symbol. | |
840 The valid symbols are: | |
841 | |
842 tabs toggle TAB visualisation | |
843 spaces toggle SPACE and HARD SPACE visualisation | |
844 trailing toggle trailing blanks visualisation | |
845 space-before-tab toggle SPACEs before TAB visualisation | |
846 lines toggle \"long lines\" visualisation | |
847 newline toggle NEWLINE visualisation | |
848 color toggle color faces | |
849 mark toggle visual mark | |
850 blank-chars restore `blank-chars' value | |
851 blank-style restore `blank-style' value | |
852 | |
853 Only useful with a windowing system." | |
854 (interactive (blank-interactive-char t)) | |
855 (let ((blank-chars | |
856 (blank-toggle-list t arg blank-active-chars blank-chars | |
857 'blank-chars blank-chars-value-list)) | |
858 (blank-style | |
859 (blank-toggle-list t arg blank-active-style blank-style | |
860 'blank-style blank-style-value-list))) | |
861 (blank-mode 0) | |
862 (blank-mode 1))) | |
863 | |
864 | |
865 (defvar blank-toggle-chars nil | |
866 "Used to toggle the global `blank-chars' value.") | |
867 (defvar blank-toggle-style nil | |
868 "Used to toggle the global `blank-style' value.") | |
869 | |
870 | |
871 ;;;###autoload | |
872 (defun global-blank-toggle-options (arg) | |
873 "Toggle global `blank-mode' options. | |
874 | |
875 If global blank-mode is off, toggle the option given by ARG and | |
876 turn on global blank-mode. | |
877 | |
878 If global blank-mode is on, toggle the option given by ARG and | |
879 restart global blank-mode. | |
880 | |
881 Interactively, it reads one of the following chars: | |
882 | |
883 CHAR MEANING | |
884 t toggle TAB visualisation | |
885 s toggle SPACE and HARD SPACE visualisation | |
886 r toggle trailing blanks visualisation | |
887 b toggle SPACEs before TAB visualisation | |
888 l toggle \"long lines\" visualisation | |
889 n toggle NEWLINE visualisation | |
890 c toggle color faces | |
891 m toggle visual mark | |
892 x restore `blank-chars' value | |
893 z restore `blank-style' value | |
894 ? display brief help | |
895 | |
896 Non-interactively, ARG should be a symbol or a list of symbol. | |
897 The valid symbols are: | |
898 | |
899 tabs toggle TAB visualisation | |
900 spaces toggle SPACE and HARD SPACE visualisation | |
901 trailing toggle trailing blanks visualisation | |
902 space-before-tab toggle SPACEs before TAB visualisation | |
903 lines toggle \"long lines\" visualisation | |
904 newline toggle NEWLINE visualisation | |
905 color toggle color faces | |
906 mark toggle visual mark | |
907 blank-chars restore `blank-chars' value | |
908 blank-style restore `blank-style' value | |
909 | |
910 Only useful with a windowing system." | |
911 (interactive (blank-interactive-char nil)) | |
912 (let ((blank-chars | |
913 (blank-toggle-list nil arg blank-toggle-chars blank-chars | |
914 'blank-chars blank-chars-value-list)) | |
915 (blank-style | |
916 (blank-toggle-list nil arg blank-toggle-style blank-style | |
917 'blank-style blank-style-value-list))) | |
918 (setq blank-toggle-chars blank-chars | |
919 blank-toggle-style blank-style) | |
920 (global-blank-mode 0) | |
921 (global-blank-mode 1))) | |
922 | |
923 | |
924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
925 ;;;; Internal functions | |
926 | |
927 | |
928 (defvar blank-font-lock-mode nil | |
929 "Used to remember whether a buffer had font lock mode on or not.") | |
930 (make-variable-buffer-local 'blank-font-lock-mode) | |
931 | |
932 (defvar blank-font-lock nil | |
933 "Used to remember whether a buffer initially had font lock on or not.") | |
934 (make-variable-buffer-local 'blank-font-lock) | |
935 | |
936 (defvar blank-font-lock-keywords nil | |
937 "Used to save locally `font-lock-keywords' value.") | |
938 (make-variable-buffer-local 'blank-font-lock-keywords) | |
939 | |
940 | |
941 (defconst blank-help-text | |
942 "\ | |
943 blank-mode toggle options: | |
944 | |
945 [] t - toggle TAB visualisation | |
946 [] s - toggle SPACE and HARD SPACE visualisation | |
947 [] r - toggle trailing blanks visualisation | |
948 [] b - toggle SPACEs before TAB visualisation | |
949 [] l - toggle \"long lines\" visualisation | |
950 [] n - toggle NEWLINE visualisation | |
951 | |
952 [] c - toggle color faces | |
953 [] m - toggle visual mark | |
954 | |
955 x - restore `blank-chars' value | |
956 z - restore `blank-style' value | |
957 | |
958 ? - display this text\n\n" | |
959 "Text for blank toggle options.") | |
960 | |
961 | |
962 (defconst blank-help-buffer-name "*Blank Toggle Options*" | |
963 "The buffer name for blank toggle options.") | |
964 | |
965 | |
966 (defun blank-insert-option-mark (the-list the-value) | |
967 "Insert the option mark ('X' or ' ') in toggle options buffer." | |
968 (forward-line 1) | |
969 (dolist (sym the-list) | |
970 (forward-line 1) | |
971 (forward-char 2) | |
972 (insert (if (memq sym the-value) "X" " ")))) | |
973 | |
974 | |
975 (defun blank-help-on (chars style) | |
976 "Display the blank toggle options." | |
977 (unless (get-buffer blank-help-buffer-name) | |
978 (delete-other-windows) | |
979 (let ((buffer (get-buffer-create blank-help-buffer-name))) | |
980 (save-excursion | |
981 (set-buffer buffer) | |
982 (erase-buffer) | |
983 (insert blank-help-text) | |
984 (goto-char (point-min)) | |
985 (blank-insert-option-mark blank-chars-value-list chars) | |
986 (blank-insert-option-mark blank-style-value-list style) | |
987 (goto-char (point-min)) | |
988 (set-buffer-modified-p nil) | |
989 (let ((size (- (window-height) | |
990 (max window-min-height | |
991 (1+ (count-lines (point-min) (point-max))))))) | |
992 (when (<= size 0) | |
993 (kill-buffer buffer) | |
994 (error "Frame height is too small; \ | |
995 can't split window to display blank toggle options")) | |
996 (set-window-buffer (split-window nil size) buffer)))))) | |
997 | |
998 | |
999 (defun blank-help-off () | |
1000 "Remove the buffer and window of the blank toggle options." | |
1001 (let ((buffer (get-buffer blank-help-buffer-name))) | |
1002 (when buffer | |
1003 (delete-windows-on buffer) | |
1004 (kill-buffer buffer)))) | |
1005 | |
1006 | |
1007 (defun blank-interactive-char (local-p) | |
1008 "Interactive function to read a char and return a symbol. | |
1009 | |
1010 If LOCAL-P is non-nil, it uses a local context; otherwise, it | |
1011 uses a global context. | |
1012 | |
1013 It reads one of the following chars: | |
1014 | |
1015 CHAR MEANING | |
1016 t toggle TAB visualisation | |
1017 s toggle SPACE and HARD SPACE visualisation | |
1018 r toggle trailing blanks visualisation | |
1019 b toggle SPACEs before TAB visualisation | |
1020 l toggle \"long lines\" visualisation | |
1021 n toggle NEWLINE visualisation | |
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 See also `blank-toggle-option-alist'." | |
1029 (let* ((is-off (not (if local-p blank-mode global-blank-mode))) | |
1030 (chars (cond (is-off blank-chars) ; use default value | |
1031 (local-p blank-active-chars) | |
1032 (t blank-toggle-chars))) | |
1033 (style (cond (is-off blank-style) ; use default value | |
1034 (local-p blank-active-style) | |
1035 (t blank-toggle-style))) | |
1036 (prompt | |
1037 (format "Blank Toggle %s (type ? for further options)-" | |
1038 (if local-p "Local" "Global"))) | |
1039 ch sym) | |
1040 ;; read a valid option and get the corresponding symbol | |
1041 (save-window-excursion | |
1042 (condition-case data | |
1043 (progn | |
1044 (while | |
1045 ;; while condition | |
1046 (progn | |
1047 (setq ch (read-char prompt)) | |
1048 (not | |
1049 (setq sym | |
1050 (cdr (assq ch blank-toggle-option-alist))))) | |
1051 ;; while body | |
1052 (if (eq ch ?\?) | |
1053 (blank-help-on chars style) | |
1054 (ding))) | |
1055 (blank-help-off) | |
1056 (message " ")) ; clean echo area | |
1057 ;; handler | |
1058 ((quit error) | |
1059 (blank-help-off) | |
1060 (error (error-message-string data))))) | |
1061 (list sym))) ; return the apropriate symbol | |
1062 | |
1063 | |
1064 (defun blank-toggle-list (local-p arg the-list default-list | |
1065 sym-restore sym-list) | |
1066 "Toggle options in THE-LIST based on list ARG. | |
1067 | |
1068 If LOCAL-P is non-nil, it uses a local context; otherwise, it | |
1069 uses a global context. | |
1070 | |
1071 ARG is a list of options to be toggled. | |
1072 | |
1073 THE-LIST is a list of options. This list will be toggled and the | |
1074 resultant list will be returned. | |
1075 | |
1076 DEFAULT-LIST is the default list of options. It is used to | |
1077 restore the options in THE-LIST. | |
1078 | |
1079 SYM-RESTORE is the symbol which indicates to restore the options | |
1080 in THE-LIST. | |
1081 | |
1082 SYM-LIST is a list of valid options, used to check if the ARG's | |
1083 options are valid." | |
1084 (unless (if local-p blank-mode global-blank-mode) | |
1085 (setq the-list default-list)) | |
1086 (setq the-list (copy-sequence the-list)) ; keep original list | |
1087 (dolist (sym (if (listp arg) arg (list arg))) | |
1088 (cond | |
1089 ;; restore default values | |
1090 ((eq sym sym-restore) | |
1091 (setq the-list default-list)) | |
1092 ;; toggle valid values | |
1093 ((memq sym sym-list) | |
1094 (setq the-list (if (memq sym the-list) | |
1095 (delq sym the-list) | |
1096 (cons sym the-list)))))) | |
1097 the-list) | |
1098 | |
1099 | |
1100 (defun blank-turn-on () | |
1101 "Turn on blank visualisation." | |
1102 (setq blank-active-style (if (listp blank-style) | |
1103 blank-style | |
1104 (list blank-style))) | |
1105 (setq blank-active-chars (if (listp blank-chars) | |
1106 blank-chars | |
1107 (list blank-chars))) | |
1108 (and (memq 'color blank-active-style) | |
1109 (blank-color-on)) | |
1110 (and (memq 'mark blank-active-style) | |
1111 (blank-display-char-on))) | |
1112 | |
1113 | |
1114 (defun blank-turn-off () | |
1115 "Turn off blank visualisation." | |
1116 (and (memq 'color blank-active-style) | |
1117 (blank-color-off)) | |
1118 (and (memq 'mark blank-active-style) | |
1119 (blank-display-char-off))) | |
1120 | |
1121 | |
1122 (defun blank-color-on () | |
1123 "Turn on color visualisation." | |
1124 (when blank-active-chars | |
1125 (unless blank-font-lock | |
1126 (setq blank-font-lock t | |
1127 blank-font-lock-keywords | |
1128 (copy-sequence font-lock-keywords))) | |
1129 ;; turn off font lock | |
1130 (setq blank-font-lock-mode font-lock-mode) | |
1131 (font-lock-mode 0) | |
1132 ;; add blank-mode color into font lock | |
1133 (when (memq 'spaces blank-active-chars) | |
1134 (font-lock-add-keywords | |
1135 nil | |
1136 (list | |
1137 ;; Show SPACEs | |
1138 (list blank-space-regexp 1 blank-space-face t) | |
1139 ;; Show HARD SPACEs | |
1140 (list blank-hspace-regexp 1 blank-hspace-face t)) | |
1141 t)) | |
1142 (when (memq 'tabs blank-active-chars) | |
1143 (font-lock-add-keywords | |
1144 nil | |
1145 (list | |
1146 ;; Show TABs | |
1147 (list blank-tab-regexp 1 blank-tab-face t)) | |
1148 t)) | |
1149 (when (memq 'trailing blank-active-chars) | |
1150 (font-lock-add-keywords | |
1151 nil | |
1152 (list | |
1153 ;; Show trailing blanks | |
1154 (list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$") | |
1155 1 blank-trailing-face t)) | |
1156 t)) | |
1157 (when (memq 'lines blank-active-chars) | |
1158 (font-lock-add-keywords | |
1159 nil | |
1160 (list | |
1161 ;; Show "long" lines | |
1162 (list (concat "^\\(.\\{" (int-to-string blank-line-length) | |
1163 ",\\}\\)$") | |
1164 1 blank-line-face t)) | |
1165 t)) | |
1166 (when (memq 'space-before-tab blank-active-chars) | |
1167 (font-lock-add-keywords | |
1168 nil | |
1169 (list | |
1170 ;; Show SPACEs before TAB | |
1171 (list blank-space-before-tab-regexp | |
1172 1 blank-space-before-tab-face t)) | |
1173 t)) | |
1174 ;; now turn on font lock and highlight blanks | |
1175 (font-lock-mode 1))) | |
1176 | |
1177 | |
1178 (defun blank-color-off () | |
1179 "Turn off color visualisation." | |
1180 (when blank-active-chars | |
1181 (when blank-font-lock | |
1182 (setq blank-font-lock nil | |
1183 font-lock-keywords blank-font-lock-keywords)) | |
1184 ;; turn off font lock | |
1185 (font-lock-mode 0) | |
1186 ;; restore original font lock state | |
1187 (font-lock-mode blank-font-lock-mode))) | |
1188 | |
1189 | |
1190 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1191 ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) | |
1192 | |
1193 | |
1194 (defvar blank-display-table nil | |
1195 "Used to save a local display table.") | |
1196 (make-variable-buffer-local 'blank-display-table) | |
1197 | |
1198 (defvar blank-display-table-was-local nil | |
1199 "Used to remember whether a buffer initially had a local display table or not.") | |
1200 (make-variable-buffer-local 'blank-display-table-was-local) | |
1201 | |
1202 | |
1203 (defsubst blank-char-valid-p (char) | |
1204 ;; This check should be improved!!! | |
1205 (or (< char 256) | |
1206 (char-valid-p char))) | |
1207 | |
1208 | |
1209 (defun blank-legal-display-vector-p (vec) | |
1210 "Return true if every character in vector VEC can be displayed." | |
1211 (let ((i (length vec))) | |
1212 (when (> i 0) | |
1213 (while (and (>= (setq i (1- i)) 0) | |
1214 (blank-char-valid-p (aref vec i)))) | |
1215 (< i 0)))) | |
1216 | |
1217 | |
1218 (defun blank-display-char-on () | |
1219 "Turn on character display mapping." | |
1220 (when blank-display-mappings | |
1221 (let (vecs vec) | |
1222 ;; Remember whether a buffer has a local display table. | |
1223 (unless blank-display-table-was-local | |
1224 (setq blank-display-table-was-local t | |
1225 blank-display-table | |
1226 (copy-sequence buffer-display-table))) | |
1227 (unless buffer-display-table | |
1228 (setq buffer-display-table (make-display-table))) | |
1229 (dolist (entry blank-display-mappings) | |
1230 (setq vecs (cdr entry)) | |
1231 ;; Get a displayable mapping. | |
1232 (while (and vecs | |
1233 (not (blank-legal-display-vector-p (car vecs)))) | |
1234 (setq vecs (cdr vecs))) | |
1235 ;; Display a valid mapping. | |
1236 (when vecs | |
1237 (setq vec (copy-sequence (car vecs))) | |
1238 (cond | |
1239 ;; Any char except newline | |
1240 ((not (eq (car entry) ?\n)) | |
1241 (aset buffer-display-table (car entry) vec)) | |
1242 ;; Newline char - display it | |
1243 ((memq 'newline blank-active-chars) | |
1244 ;; Only insert face bits on NEWLINE char mapping to avoid | |
1245 ;; obstruction of other faces like TABs and (HARD) SPACEs | |
1246 ;; faces, font-lock faces, etc. | |
1247 (when (memq 'color blank-active-style) | |
1248 (dotimes (i (length vec)) | |
1249 ;; Due to limitations of glyph representation, the char | |
1250 ;; code can not be above ?\x1FFFF. Probably, this will | |
1251 ;; be fixed after Emacs unicode merging. | |
1252 (or (eq (aref vec i) ?\n) | |
1253 (> (aref vec i) #x1FFFF) | |
1254 (aset vec i (make-glyph-code (aref vec i) | |
1255 blank-newline-face))))) | |
1256 ;; Display mapping | |
1257 (aset buffer-display-table (car entry) vec)) | |
1258 ;; Newline char - don't display it | |
1259 (t | |
1260 ;; Do nothing | |
1261 ))))))) | |
1262 | |
1263 | |
1264 (defun blank-display-char-off () | |
1265 "Turn off character display mapping." | |
1266 (and blank-display-mappings | |
1267 blank-display-table-was-local | |
1268 (setq blank-display-table-was-local nil | |
1269 buffer-display-table blank-display-table))) | |
1270 | |
1271 | |
1272 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1273 | |
1274 | |
1275 (provide 'blank-mode) | |
1276 | |
1277 | |
1278 (run-hooks 'blank-load-hook) | |
1279 | |
1280 | |
1281 ;;; blank-mode.el ends here |