Download
(defgroup blank nil
"Visualize blanks (TAB, (HARD) SPACE and NEWLINE)."
:link '(emacs-library-link :tag "Source Lisp File" "blank-mode.el")
:version "22.2"
:group 'wp
:group 'data)
(defcustom blank-style '(mark color)
"*Specify the visualization style.
It's a list which element value can be:
mark display mappings are visualized.
color faces are visualized.
Any other value is ignored.
If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
See also `blank-display-mappings' for documentation."
:type '(repeat :tag "Style of Blank"
(choice :tag "Style of Blank"
(const :tag "Display Table" mark)
(const :tag "Faces" color)))
:group 'blank)
(defcustom blank-chars
'(tabs spaces trailing lines space-before-tab newline
indentation empty space-after-tab)
"*Specify which kind of blank is visualized.
It's a list which element value can be:
trailing trailing blanks are visualized.
tabs TABs are visualized.
spaces SPACEs and HARD SPACEs are visualized.
lines lines whose have columns beyond
`blank-line-column' are highlighted.
Whole line is highlighted.
It has precedence over
`lines-tail' (see below).
lines-tail lines whose have columns beyond
`blank-line-column' are highlighted.
But only the part of line which goes
beyond `blank-line-column' column.
It has effect only if `lines' (see above)
is not present in `blank-chars'.
space-before-tab SPACEs before TAB are visualized.
newline NEWLINEs are visualized.
indentation 8 or more SPACEs at beginning of line are
visualized.
empty empty lines at beginning and/or end of buffer
are visualized.
space-after-tab 8 or more SPACEs after a TAB are visualized.
Any other value is ignored.
If nil, don't visualize TABs, (HARD) SPACEs and NEWLINEs.
Used when `blank-style' has `color' as an element.
If `blank-chars' has `newline' as an element, used when `blank-style'
has `mark' as an element."
:type '(repeat :tag "Kind of Blank"
(choice :tag "Kind of Blank"
(const :tag "Trailing TABs, SPACEs and HARD SPACEs"
trailing)
(const :tag "SPACEs and HARD SPACEs" spaces)
(const :tag "TABs" tabs)
(const :tag "Lines" lines)
(const :tag "SPACEs before TAB"
space-before-tab)
(const :tag "NEWLINEs" newline)
(const :tag "Indentation SPACEs" indentation)
(const :tag "Empty Lines At BOB And/Or EOB"
empty)
(const :tag "SPACEs after TAB"
space-after-tab)))
:group 'blank)
(defcustom blank-space 'blank-space
"*Symbol face used to visualize SPACE.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-space
'((((class color) (background dark))
(:background "grey20" :foreground "aquamarine3"))
(((class color) (background light))
(:background "LightYellow" :foreground "aquamarine3"))
(t (:inverse-video t)))
"Face used to visualize SPACE."
:group 'blank)
(defcustom blank-hspace 'blank-hspace
"*Symbol face used to visualize HARD SPACE.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-hspace
'((((class color) (background dark))
(:background "grey24" :foreground "aquamarine3"))
(((class color) (background light))
(:background "LemonChiffon3" :foreground "aquamarine3"))
(t (:inverse-video t)))
"Face used to visualize HARD SPACE."
:group 'blank)
(defcustom blank-tab 'blank-tab
"*Symbol face used to visualize TAB.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-tab
'((((class color) (background dark))
(:background "grey22" :foreground "aquamarine3"))
(((class color) (background light))
(:background "beige" :foreground "aquamarine3"))
(t (:inverse-video t)))
"Face used to visualize TAB."
:group 'blank)
(defcustom blank-newline 'blank-newline
"*Symbol face used to visualize NEWLINE char mapping.
See `blank-display-mappings'.
Used when `blank-style' has `mark' and `color' as elements
and `blank-chars' has `newline' as an element."
:type 'face
:group 'blank)
(defface blank-newline
'((((class color) (background dark))
(:background "grey26" :foreground "aquamarine3" :bold t))
(((class color) (background light))
(:background "linen" :foreground "aquamarine3" :bold t))
(t (:bold t :underline t)))
"Face used to visualize NEWLINE char mapping.
See `blank-display-mappings'."
:group 'blank)
(defcustom blank-trailing 'blank-trailing
"*Symbol face used to visualize traling blanks.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-trailing
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "red1" :foreground "yellow" :bold t)))
"Face used to visualize trailing blanks."
:group 'blank)
(defcustom blank-line 'blank-line
"*Symbol face used to visualize \"long\" lines.
See `blank-line-column'.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-line
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "gray20" :foreground "violet")))
"Face used to visualize \"long\" lines.
See `blank-line-column'."
:group 'blank)
(defcustom blank-space-before-tab 'blank-space-before-tab
"*Symbol face used to visualize SPACEs before TAB.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-space-before-tab
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "DarkOrange" :foreground "firebrick")))
"Face used to visualize SPACEs before TAB."
:group 'blank)
(defcustom blank-indentation 'blank-indentation
"*Symbol face used to visualize 8 or more SPACEs at beginning of line.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-indentation
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "yellow" :foreground "firebrick")))
"Face used to visualize 8 or more SPACEs at beginning of line."
:group 'blank)
(defcustom blank-empty 'blank-empty
"*Symbol face used to visualize empty lines at beginning and/or end of buffer.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-empty
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "yellow" :foreground "firebrick")))
"Face used to visualize empty lines at beginning and/or end of buffer."
:group 'blank)
(defcustom blank-space-after-tab 'blank-space-after-tab
"*Symbol face used to visualize 8 or more SPACEs after TAB.
Used when `blank-style' has `color' as an element."
:type 'face
:group 'blank)
(defface blank-space-after-tab
'((((class mono)) (:inverse-video t :bold t :underline t))
(t (:background "yellow" :foreground "firebrick")))
"Face used to visualize 8 or more SPACEs after TAB."
:group 'blank)
(defcustom blank-hspace-regexp
"\\(\\(\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20\\)+\\)"
"*Specify HARD SPACE characters regexp.
If you're using `mule' package, it may exist other characters besides:
\"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \"\\xF20\"
that should be considered HARD SPACE.
Here are some examples:
\"\\\\(^\\xA0+\\\\)\" \
visualize only leading HARD SPACEs.
\"\\\\(\\xA0+$\\\\)\" \
visualize only trailing HARD SPACEs.
\"\\\\(^\\xA0+\\\\|\\xA0+$\\\\)\" \
visualize leading and/or trailing HARD SPACEs.
\"\\t\\\\(\\xA0+\\\\)\\t\" \
visualize only HARD SPACEs between TABs.
NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
Use exactly one pair of enclosing \\\\( and \\\\).
Used when `blank-style' has `color' as an element, and
`blank-chars' has `spaces' as an element."
:type '(regexp :tag "HARD SPACE Chars")
:group 'blank)
(defcustom blank-space-regexp "\\( +\\)"
"*Specify SPACE characters regexp.
If you're using `mule' package, it may exist other characters
besides \" \" that should be considered SPACE.
Here are some examples:
\"\\\\(^ +\\\\)\" visualize only leading SPACEs.
\"\\\\( +$\\\\)\" visualize only trailing SPACEs.
\"\\\\(^ +\\\\| +$\\\\)\" \
visualize leading and/or trailing SPACEs.
\"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs.
NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
Use exactly one pair of enclosing \\\\( and \\\\).
Used when `blank-style' has `color' as an element, and
`blank-chars' has `spaces' as an element."
:type '(regexp :tag "SPACE Chars")
:group 'blank)
(defcustom blank-tab-regexp "\\(\t+\\)"
"*Specify TAB characters regexp.
If you're using `mule' package, it may exist other characters
besides \"\\t\" that should be considered TAB.
Here are some examples:
\"\\\\(^\\t+\\\\)\" visualize only leading TABs.
\"\\\\(\\t+$\\\\)\" visualize only trailing TABs.
\"\\\\(^\\t+\\\\|\\t+$\\\\)\" \
visualize leading and/or trailing TABs.
\" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
Use exactly one pair of enclosing \\\\( and \\\\).
Used when `blank-style' has `color' as an element, and
`blank-chars' has `tabs' as an element."
:type '(regexp :tag "TAB Chars")
:group 'blank)
(defcustom blank-trailing-regexp
"\t\\| \\|\xA0\\|\x8A0\\|\x920\\|\xE20\\|\xF20"
"*Specify trailing characters regexp.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
NOTE: DO NOT enclose by \\\\( and \\\\) the elements to highlight.
`blank-mode' surrounds this regexp by \"\\\\(\\\\(\" and
\"\\\\)+\\\\)$\".
Used when `blank-style' has `color' as an element, and
`blank-chars' has `trailing' as an element."
:type '(regexp :tag "Trailing Chars")
:group 'blank)
(defcustom blank-space-before-tab-regexp "\\( +\\)\t"
"*Specify SPACEs before TAB regexp.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `space-before-tab' as an element."
:type '(regexp :tag "SPACEs Before TAB")
:group 'blank)
(defcustom blank-indentation-regexp "^\t*\\(\\( \\{8\\}\\)+\\)[^\n\t]"
"*Specify regexp for 8 or more SPACEs at beginning of line.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `indentation' as an element."
:type '(regexp :tag "Indentation SPACEs")
:group 'blank)
(defcustom blank-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
"*Specify regexp for empty lines at beginning of buffer.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `empty' as an element."
:type '(regexp :tag "Empty Lines At Beginning Of Buffer")
:group 'blank)
(defcustom blank-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
"*Specify regexp for empty lines at end of buffer.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `empty' as an element."
:type '(regexp :tag "Empty Lines At End Of Buffer")
:group 'blank)
(defcustom blank-space-after-tab-regexp "\t\\(\\( \\{8\\}\\)+\\)"
"*Specify regexp for 8 or more SPACEs after TAB.
If you're using `mule' package, it may exist other characters besides:
\" \" \"\\t\" \"\\xA0\" \"\\x8A0\" \"\\x920\" \"\\xE20\" \
\"\\xF20\"
that should be considered blank.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `space-after-tab' as an element."
:type '(regexp :tag "SPACEs After TAB")
:group 'blank)
(defcustom blank-line-column 80
"*Specify column beyond which the line is highlighted.
Used when `blank-style' has `color' as an element, and
`blank-chars' has `lines' or `lines-tail' as an element."
:type '(integer :tag "Line Length")
:group 'blank)
(defcustom blank-display-mappings
'(
(?\ [?\xB7] [?.])
(?\xA0 [?\xA4] [?_])
(?\x8A0 [?\x8A4] [?_])
(?\x920 [?\x924] [?_])
(?\xE20 [?\xE24] [?_])
(?\xF20 [?\xF24] [?_])
(?\n [?$ ?\n])
(?\t [?\xBB ?\t] [?\\ ?\t])
)
"*Specify an alist of mappings for displaying characters.
Each element has the following form:
(CHAR VECTOR...)
Where:
CHAR is the character to be mapped.
VECTOR is a vector of characters to be displayed in place of CHAR.
The first display vector that can be displayed is used;
if no display vector for a mapping can be displayed, then
that character is displayed unmodified.
The NEWLINE character is displayed using the face given by
`blank-newline' variable. The characters in the vector to be
displayed will not have this face applied if the character code
is above #x1FFFF.
Used when `blank-style' has `mark' as an element."
:type '(repeat
(list :tag "Character Mapping"
(character :tag "Char")
(repeat :inline t :tag "Vector List"
(vector :tag ""
(repeat :inline t
:tag "Vector Characters"
(character :tag "Char"))))))
:group 'blank)
(defcustom blank-global-modes t
"*Modes for which global `blank-mode' is automagically turned on.
Global `blank-mode' is controlled by the command `global-blank-mode'.
If nil, means no modes have `blank-mode' automatically turned on.
If t, all modes that support `blank-mode' have it automatically
turned on.
Else it should be a list of `major-mode' symbol names for
which `blank-mode' should be automatically turned on. The sense
of the list is negated if it begins with `not'. For example:
(c-mode c++-mode)
means that `blank-mode' is turned on for buffers in C and C++
modes only."
:type '(choice (const :tag "None" nil)
(const :tag "All" t)
(set :menu-tag "Mode Specific" :tag "Modes"
:value (not)
(const :tag "Except" not)
(repeat :inline t
(symbol :tag "Mode"))))
:group 'blank)
(define-minor-mode blank-mode
"Toggle blank minor mode visualization (\"bl\" on modeline).
If ARG is null, toggle blank visualization.
If ARG is a number greater than zero, turn on visualization;
otherwise, turn off visualization.
Only useful with a windowing system."
:lighter " bl"
:init-value nil
:global nil
:group 'blank
(cond
(noninteractive
(setq blank-mode nil))
(blank-mode
(blank-turn-on))
(t
(blank-turn-off))))
(define-minor-mode global-blank-mode
"Toggle blank global minor mode visualization (\"BL\" on modeline).
If ARG is null, toggle blank visualization.
If ARG is a number greater than zero, turn on visualization;
otherwise, turn off visualization.
Only useful with a windowing system."
:lighter " BL"
:init-value nil
:global t
:group 'blank
(cond
(noninteractive
(setq global-blank-mode nil))
(global-blank-mode
(save-excursion
(if (boundp 'find-file-hook)
(add-hook 'find-file-hook 'blank-turn-on-if-enabled t)
(add-hook 'find-file-hooks 'blank-turn-on-if-enabled t))
(dolist (buffer (buffer-list))
(set-buffer buffer)
(unless blank-mode
(blank-turn-on-if-enabled)))))
(t
(save-excursion
(if (boundp 'find-file-hook)
(remove-hook 'find-file-hook 'blank-turn-on-if-enabled)
(remove-hook 'find-file-hooks 'blank-turn-on-if-enabled))
(dolist (buffer (buffer-list))
(set-buffer buffer)
(unless blank-mode
(blank-turn-off)))))))
(defun blank-turn-on-if-enabled ()
(when (cond
((eq blank-global-modes t))
((listp blank-global-modes)
(if (eq (car-safe blank-global-modes) 'not)
(not (memq major-mode (cdr blank-global-modes)))
(memq major-mode blank-global-modes)))
(t nil))
(let (inhibit-quit)
(or
noninteractive
(eq (aref (buffer-name) 0) ?\ )
(and (eq (aref (buffer-name) 0) ?*)
(not (string= (buffer-name) "*scratch*")))
(blank-turn-on)))))
(defconst blank-chars-value-list
'(tabs
spaces
trailing
space-before-tab
lines
lines-tail
newline
indentation
empty
space-after-tab
)
"List of valid `blank-chars' values.")
(defconst blank-style-value-list
'(color
mark
)
"List of valid `blank-style' values.")
(defconst blank-toggle-option-alist
'((?t . tabs)
(?s . spaces)
(?r . trailing)
(?b . space-before-tab)
(?l . lines)
(?L . lines-tail)
(?n . newline)
(?i . indentation)
(?e . empty)
(?a . space-after-tab)
(?c . color)
(?m . mark)
(?x . blank-chars)
(?z . blank-style)
)
"Alist of toggle options.
Each element has the form:
(CHAR . SYMBOL)
Where:
CHAR is a char which the user will have to type.
SYMBOL is a valid symbol associated with CHAR.
See `blank-chars-value-list' and `blank-style-value-list'.")
(defvar blank-active-chars nil
"Used to save locally `blank-chars' value.")
(make-variable-buffer-local 'blank-active-chars)
(defvar blank-active-style nil
"Used to save locally `blank-style' value.")
(make-variable-buffer-local 'blank-active-style)
(defun blank-toggle-options (arg)
"Toggle local `blank-mode' options.
If local blank-mode is off, toggle the option given by ARG and
turn on local blank-mode.
If local blank-mode is on, toggle the option given by ARG and
restart local blank-mode.
Interactively, it reads one of the following chars:
CHAR MEANING
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
b toggle SPACEs before TAB visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
n toggle NEWLINE visualization
i toggle indentation SPACEs visualization
e toggle empty line at bob and/or eob visualization
a toggle SPACEs after TAB visualization
c toggle color faces
m toggle visual mark
x restore `blank-chars' value
z restore `blank-style' value
? display brief help
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
space-before-tab toggle SPACEs before TAB visualization
lines toggle \"long lines\" visualization
lines-tail toggle \"long lines\" tail visualization
newline toggle NEWLINE visualization
indentation toggle indentation SPACEs visualization
empty toggle empty line at bob and/or eob visualization
space-after-tab toggle SPACEs after TAB visualization
color toggle color faces
mark toggle visual mark
blank-chars restore `blank-chars' value
blank-style restore `blank-style' value
Only useful with a windowing system."
(interactive (blank-interactive-char t))
(let ((blank-chars
(blank-toggle-list t arg blank-active-chars blank-chars
'blank-chars blank-chars-value-list))
(blank-style
(blank-toggle-list t arg blank-active-style blank-style
'blank-style blank-style-value-list)))
(blank-mode 0)
(blank-mode 1)))
(defvar blank-toggle-chars nil
"Used to toggle the global `blank-chars' value.")
(defvar blank-toggle-style nil
"Used to toggle the global `blank-style' value.")
(defun global-blank-toggle-options (arg)
"Toggle global `blank-mode' options.
If global blank-mode is off, toggle the option given by ARG and
turn on global blank-mode.
If global blank-mode is on, toggle the option given by ARG and
restart global blank-mode.
Interactively, it reads one of the following chars:
CHAR MEANING
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
b toggle SPACEs before TAB visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
n toggle NEWLINE visualization
i toggle indentation SPACEs visualization
e toggle empty line at bob and/or eob visualization
a toggle SPACEs after TAB visualization
c toggle color faces
m toggle visual mark
x restore `blank-chars' value
z restore `blank-style' value
? display brief help
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
space-before-tab toggle SPACEs before TAB visualization
lines toggle \"long lines\" visualization
lines-tail toggle \"long lines\" tail visualization
newline toggle NEWLINE visualization
indentation toggle indentation SPACEs visualization
empty toggle empty line at bob and/or eob visualization
space-after-tab toggle SPACEs after TAB visualization
color toggle color faces
mark toggle visual mark
blank-chars restore `blank-chars' value
blank-style restore `blank-style' value
Only useful with a windowing system."
(interactive (blank-interactive-char nil))
(let ((blank-chars
(blank-toggle-list nil arg blank-toggle-chars blank-chars
'blank-chars blank-chars-value-list))
(blank-style
(blank-toggle-list nil arg blank-toggle-style blank-style
'blank-style blank-style-value-list)))
(setq blank-toggle-chars blank-chars
blank-toggle-style blank-style)
(global-blank-mode 0)
(global-blank-mode 1)))
(defun blank-cleanup ()
"Cleanup some blank problems in all buffer or at region.
It usually applies to the whole buffer, but in transient mark
mode when the mark is active, it applies to the region. It also
applies to the region when it is not in transiente mark mode, the
mark is active and it was pressed `C-u' just before calling
`blank-cleanup' interactively.
See also `blank-cleanup-region'.
The problems, which are cleaned up, are:
1. empty lines at beginning of buffer.
2. empty lines at end of buffer.
If `blank-chars' has `empty' as an element, remove all empty
lines at beginning and/or end of buffer.
3. 8 or more SPACEs at beginning of line.
If `blank-chars' has `indentation' as an element, replace 8 or
more SPACEs at beginning of line by TABs.
4. SPACEs before TAB.
If `blank-chars' has `space-before-tab' as an element, replace
SPACEs by TABs.
5. SPACEs or TABs at end of line.
If `blank-chars' has `trailing' as an element, remove all
SPACEs or TABs at end of line.
6. 8 or more SPACEs after TAB.
If `blank-chars' has `space-after-tab' as an element, replace
SPACEs by TABs."
(interactive "@*")
(if (and (or transient-mark-mode
current-prefix-arg)
mark-active)
(blank-cleanup-region (region-beginning) (region-end))
(save-excursion
(save-match-data
(when (memq 'empty blank-chars)
(let (overwrite-mode)
(goto-char (point-min))
(when (re-search-forward blank-empty-at-bob-regexp nil t)
(delete-region (match-beginning 1) (match-end 1)))
(when (re-search-forward blank-empty-at-eob-regexp nil t)
(delete-region (match-beginning 1) (match-end 1)))))))
(blank-cleanup-region (point-min) (point-max))))
(defun blank-cleanup-region (start end)
"Cleanup some blank problems at region.
The problems, which are cleaned up, are:
1. 8 or more SPACEs at beginning of line.
If `blank-chars' has `indentation' as an element, replace 8 or
more SPACEs at beginning of line by TABs.
2. SPACEs before TAB.
If `blank-chars' has `space-before-tab' as an element, replace
SPACEs by TABs.
3. SPACEs or TABs at end of line.
If `blank-chars' has `trailing' as an element, remove all
SPACEs or TABs at end of line.
4. 8 or more SPACEs after TAB.
If `blank-chars' has `space-after-tab' as an element, replace
SPACEs by TABs."
(interactive "@*r")
(let ((rstart (min start end))
(rend (copy-marker (max start end)))
(tab-width 8)
(indent-tabs-mode t)
overwrite-mode
tmp)
(save-excursion
(save-match-data
(when (memq 'indentation blank-chars)
(goto-char rstart)
(while (re-search-forward blank-indentation-regexp rend t)
(setq tmp (current-indentation))
(delete-horizontal-space)
(unless (eolp)
(indent-to tmp))))
(when (memq 'trailing blank-chars)
(let ((regexp (concat "\\(\\(" blank-trailing-regexp
"\\)+\\)$")))
(goto-char rstart)
(while (re-search-forward regexp rend t)
(delete-region (match-beginning 1) (match-end 1)))))
(when (memq 'space-after-tab blank-chars)
(blank-replace-spaces-by-tabs
rstart rend blank-space-after-tab-regexp))
(when (memq 'space-before-tab blank-chars)
(blank-replace-spaces-by-tabs
rstart rend blank-space-before-tab-regexp))))
(set-marker rend nil)))
(defun blank-replace-spaces-by-tabs (rstart rend regexp)
"Replace all SPACEs by TABs matched by REGEXP between RSTART and REND."
(goto-char rstart)
(while (re-search-forward regexp rend t)
(goto-char (match-beginning 1))
(let* ((scol (current-column))
(ecol (save-excursion
(goto-char (match-end 1))
(current-column))))
(delete-region (match-beginning 1) (match-end 1))
(insert-char ?\t
(/ (- (- ecol (% ecol 8))
(- scol (% scol 8)))
8)))))
(defvar blank-font-lock-mode nil
"Used to remember whether a buffer had font lock mode on or not.")
(make-variable-buffer-local 'blank-font-lock-mode)
(defvar blank-font-lock nil
"Used to remember whether a buffer initially had font lock on or not.")
(make-variable-buffer-local 'blank-font-lock)
(defvar blank-font-lock-keywords nil
"Used to save locally `font-lock-keywords' value.")
(make-variable-buffer-local 'blank-font-lock-keywords)
(defconst blank-help-text
"\
blank-mode toggle options:
[] t - toggle TAB visualization
[] s - toggle SPACE and HARD SPACE visualization
[] r - toggle trailing blanks visualization
[] b - toggle SPACEs before TAB visualization
[] l - toggle \"long lines\" visualization
[] L - toggle \"long lines\" tail visualization
[] n - toggle NEWLINE visualization
[] i - toggle indentation SPACEs visualization
[] e - toggle empty line at bob and/or eob visualization
[] a - toggle SPACEs after TAB visualization
[] c - toggle color faces
[] m - toggle visual mark
x - restore `blank-chars' value
z - restore `blank-style' value
? - display this text\n\n"
"Text for blank toggle options.")
(defconst blank-help-buffer-name "*Blank Toggle Options*"
"The buffer name for blank toggle options.")
(defun blank-insert-option-mark (the-list the-value)
"Insert the option mark ('X' or ' ') in toggle options buffer."
(forward-line 1)
(dolist (sym the-list)
(forward-line 1)
(forward-char 2)
(insert (if (memq sym the-value) "X" " "))))
(defun blank-help-on (chars style)
"Display the blank toggle options."
(unless (get-buffer blank-help-buffer-name)
(delete-other-windows)
(let ((buffer (get-buffer-create blank-help-buffer-name)))
(save-excursion
(set-buffer buffer)
(erase-buffer)
(insert blank-help-text)
(goto-char (point-min))
(blank-insert-option-mark blank-chars-value-list chars)
(blank-insert-option-mark blank-style-value-list style)
(goto-char (point-min))
(set-buffer-modified-p nil)
(let ((size (- (window-height)
(max window-min-height
(1+ (count-lines (point-min) (point-max)))))))
(when (<= size 0)
(kill-buffer buffer)
(error "Frame height is too small; \
can't split window to display blank toggle options"))
(set-window-buffer (split-window nil size) buffer))))))
(defun blank-help-off ()
"Remove the buffer and window of the blank toggle options."
(let ((buffer (get-buffer blank-help-buffer-name)))
(when buffer
(delete-windows-on buffer)
(kill-buffer buffer))))
(defun blank-interactive-char (local-p)
"Interactive function to read a char and return a symbol.
If LOCAL-P is non-nil, it uses a local context; otherwise, it
uses a global context.
It reads one of the following chars:
CHAR MEANING
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
b toggle SPACEs before TAB visualization
l toggle \"long lines\" visualization
L toggle \"long lines\" tail visualization
n toggle NEWLINE visualization
i toggle indentation SPACEs visualization
e toggle empty line at bob and/or eob visualization
a toggle SPACEs after TAB visualization
c toggle color faces
m toggle visual mark
x restore `blank-chars' value
z restore `blank-style' value
? display brief help
See also `blank-toggle-option-alist'."
(let* ((is-off (not (if local-p blank-mode global-blank-mode)))
(chars (cond (is-off blank-chars)
(local-p blank-active-chars)
(t blank-toggle-chars)))
(style (cond (is-off blank-style)
(local-p blank-active-style)
(t blank-toggle-style)))
(prompt
(format "Blank Toggle %s (type ? for further options)-"
(if local-p "Local" "Global")))
ch sym)
(save-window-excursion
(condition-case data
(progn
(while
(progn
(setq ch (read-char prompt))
(not
(setq sym
(cdr (assq ch blank-toggle-option-alist)))))
(if (eq ch ?\?)
(blank-help-on chars style)
(ding)))
(blank-help-off)
(message " "))
((quit error)
(blank-help-off)
(error (error-message-string data)))))
(list sym)))
(defun blank-toggle-list (local-p arg the-list default-list
sym-restore sym-list)
"Toggle options in THE-LIST based on list ARG.
If LOCAL-P is non-nil, it uses a local context; otherwise, it
uses a global context.
ARG is a list of options to be toggled.
THE-LIST is a list of options. This list will be toggled and the
resultant list will be returned.
DEFAULT-LIST is the default list of options. It is used to
restore the options in THE-LIST.
SYM-RESTORE is the symbol which indicates to restore the options
in THE-LIST.
SYM-LIST is a list of valid options, used to check if the ARG's
options are valid."
(unless (if local-p blank-mode global-blank-mode)
(setq the-list default-list))
(setq the-list (copy-sequence the-list))
(dolist (sym (if (listp arg) arg (list arg)))
(cond
((eq sym sym-restore)
(setq the-list default-list))
((memq sym sym-list)
(setq the-list (if (memq sym the-list)
(delq sym the-list)
(cons sym the-list))))))
the-list)
(defun blank-turn-on ()
"Turn on blank visualization."
(setq blank-active-style (if (listp blank-style)
blank-style
(list blank-style)))
(setq blank-active-chars (if (listp blank-chars)
blank-chars
(list blank-chars)))
(when (memq 'color blank-active-style)
(blank-color-on))
(when (memq 'mark blank-active-style)
(blank-display-char-on)))
(defun blank-turn-off ()
"Turn off blank visualization."
(when (memq 'color blank-active-style)
(blank-color-off))
(when (memq 'mark blank-active-style)
(blank-display-char-off)))
(defun blank-color-on ()
"Turn on color visualization."
(when blank-active-chars
(unless blank-font-lock
(setq blank-font-lock t
blank-font-lock-keywords
(copy-sequence font-lock-keywords)))
(setq blank-font-lock-mode font-lock-mode)
(font-lock-mode 0)
(when (memq 'spaces blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-space-regexp 1 blank-space t)
(list blank-hspace-regexp 1 blank-hspace t))
t))
(when (memq 'tabs blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-tab-regexp 1 blank-tab t))
t))
(when (memq 'trailing blank-active-chars)
(font-lock-add-keywords
nil
(list
(list (concat "\\(\\(" blank-trailing-regexp "\\)+\\)$")
1 blank-trailing t))
t))
(when (or (memq 'lines blank-active-chars)
(memq 'lines-tail blank-active-chars))
(font-lock-add-keywords
nil
(list
(list
(format
"^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
tab-width (1- tab-width)
(/ blank-line-column tab-width)
(let ((rem (% blank-line-column tab-width)))
(if (zerop rem)
""
(format ".\\{%d\\}" rem))))
(if (memq 'lines blank-active-chars)
0
2)
blank-line t))
t))
(when (memq 'space-before-tab blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-space-before-tab-regexp
1 blank-space-before-tab t))
t))
(when (memq 'indentation blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-indentation-regexp
1 blank-indentation t))
t))
(when (memq 'empty blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-empty-at-bob-regexp
1 blank-empty t))
t)
(font-lock-add-keywords
nil
(list
(list blank-empty-at-eob-regexp
1 blank-empty t))
t))
(when (memq 'space-after-tab blank-active-chars)
(font-lock-add-keywords
nil
(list
(list blank-space-after-tab-regexp
1 blank-space-after-tab t))
t))
(font-lock-mode 1)))
(defun blank-color-off ()
"Turn off color visualization."
(when blank-active-chars
(font-lock-mode 0)
(when blank-font-lock
(setq blank-font-lock nil
font-lock-keywords blank-font-lock-keywords))
(font-lock-mode blank-font-lock-mode)))
(defvar blank-display-table nil
"Used to save a local display table.")
(make-variable-buffer-local 'blank-display-table)
(defvar blank-display-table-was-local nil
"Used to remember whether a buffer initially had a local display table or not.")
(make-variable-buffer-local 'blank-display-table-was-local)
(defsubst blank-char-valid-p (char)
(or (< char 256)
(char-valid-p char)))
(defun blank-legal-display-vector-p (vec)
"Return true if every character in vector VEC can be displayed."
(let ((i (length vec)))
(when (> i 0)
(while (and (>= (setq i (1- i)) 0)
(blank-char-valid-p (aref vec i))))
(< i 0))))
(defun blank-display-char-on ()
"Turn on character display mapping."
(when blank-display-mappings
(let (vecs vec)
(unless blank-display-table-was-local
(setq blank-display-table-was-local t
blank-display-table
(copy-sequence buffer-display-table)))
(unless buffer-display-table
(setq buffer-display-table (make-display-table)))
(dolist (entry blank-display-mappings)
(setq vecs (cdr entry))
(while (and vecs
(not (blank-legal-display-vector-p (car vecs))))
(setq vecs (cdr vecs)))
(when vecs
(setq vec (copy-sequence (car vecs)))
(cond
((not (eq (car entry) ?\n))
(aset buffer-display-table (car entry) vec))
((memq 'newline blank-active-chars)
(when (memq 'color blank-active-style)
(dotimes (i (length vec))
(or (eq (aref vec i) ?\n)
(> (aref vec i) #x1FFFF)
(aset vec i (make-glyph-code (aref vec i)
blank-newline)))))
(aset buffer-display-table (car entry) vec))
(t
)))))))
(defun blank-display-char-off ()
"Turn off character display mapping."
(and blank-display-mappings
blank-display-table-was-local
(setq blank-display-table-was-local nil
buffer-display-table blank-display-table)))
(provide 'blank-mode)
(run-hooks 'blank-load-hook)