diff options
Diffstat (limited to 'lisp/whitespace.el')
-rw-r--r-- | lisp/whitespace.el | 140 |
1 files changed, 91 insertions, 49 deletions
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index e2c8eecf897..41b0a34f9ea 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -295,8 +295,8 @@ It's a list containing some or all of the following values: `whitespace-line-column' are highlighted via faces. Whole line is highlighted. - It has precedence over `lines-tail' (see - below). + It has precedence over `lines-tail' and + `lines-char' (see below). It has effect only if `face' (see above) is present in `whitespace-style'. @@ -310,6 +310,15 @@ It's a list containing some or all of the following values: and if `face' (see above) is present in `whitespace-style'. + lines-char lines which have columns beyond + `whitespace-line-column' are highlighted via + putting a face on the first character that goes + beyond the `whitespace-line-column' column. + It has effect only if `lines' or + `lines-tail' (see above) is not present + in `whitespace-style' and if `face' (see + above) is present in `whitespace-style'. + newline NEWLINEs are visualized via faces. It has effect only if `face' (see above) is present in `whitespace-style'. @@ -431,6 +440,7 @@ See also `whitespace-display-mappings' for documentation." (const :tag "(Face) SPACEs and HARD SPACEs" spaces) (const :tag "(Face) Lines" lines) (const :tag "(Face) Lines, only overlong part" lines-tail) + (const :tag "(Face) Lines, only first character" lines-char) (const :tag "(Face) NEWLINEs" newline) (const :tag "(Face) Missing newlines at EOB" missing-newline-at-eof) @@ -772,7 +782,8 @@ Used when `whitespace-style' includes `big-indent'." It must be an integer or nil. If nil, the `fill-column' variable value is used. -Used when `whitespace-style' includes `lines' or `lines-tail'." +Used when `whitespace-style' includes `lines', `lines-tail' or +`lines-char'." :type '(choice :tag "Line Length Limit" (integer :tag "Line Length") (const :tag "Use fill-column" nil)) @@ -1058,6 +1069,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." trailing lines lines-tail + lines-char newline empty indentation @@ -1085,6 +1097,7 @@ See also `whitespace-newline' and `whitespace-display-mappings'." (?r . trailing) (?l . lines) (?L . lines-tail) + (?\C-l . lines-char) (?n . newline) (?e . empty) (?\C-i . indentation) @@ -1244,6 +1257,7 @@ Interactively, it accepts one of the following chars: r toggle trailing blanks visualization l toggle \"long lines\" visualization L toggle \"long lines\" tail visualization + C-l toggle \"long lines\" one character visualization n toggle NEWLINE visualization e toggle empty line at bob and/or eob visualization C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') @@ -1274,6 +1288,7 @@ The valid symbols are: trailing toggle trailing blanks visualization lines toggle \"long lines\" visualization lines-tail toggle \"long lines\" tail visualization + lines-char toggle \"long lines\" one character visualization newline toggle NEWLINE visualization empty toggle empty line at bob and/or eob visualization indentation toggle indentation SPACEs visualization @@ -1682,37 +1697,37 @@ cleaning up these problems." (rstart (min start end)) (rend (max start end)) ;; Fall back to whitespace-style so we can run before - ;; before the mode is active. + ;; the mode is active. (style (copy-sequence (or whitespace-active-style whitespace-style))) (bogus-list (mapcar - #'(lambda (option) - (when force - (push (car option) style)) - (goto-char rstart) - (let ((regexp - (cond - ((eq (car option) 'indentation) - (whitespace-indentation-regexp)) - ((eq (car option) 'indentation::tab) - (whitespace-indentation-regexp 'tab)) - ((eq (car option) 'indentation::space) - (whitespace-indentation-regexp 'space)) - ((eq (car option) 'space-after-tab) - (whitespace-space-after-tab-regexp)) - ((eq (car option) 'space-after-tab::tab) - (whitespace-space-after-tab-regexp 'tab)) - ((eq (car option) 'space-after-tab::space) - (whitespace-space-after-tab-regexp 'space)) - ((eq (car option) 'missing-newline-at-eof) - "[^\n]\\'") - (t - (cdr option))))) - (when (re-search-forward regexp rend t) - (unless has-bogus - (setq has-bogus (memq (car option) style))) - t))) + (lambda (option) + (when force + (push (car option) style)) + (goto-char rstart) + (let ((regexp + (cond + ((eq (car option) 'indentation) + (whitespace-indentation-regexp)) + ((eq (car option) 'indentation::tab) + (whitespace-indentation-regexp 'tab)) + ((eq (car option) 'indentation::space) + (whitespace-indentation-regexp 'space)) + ((eq (car option) 'space-after-tab) + (whitespace-space-after-tab-regexp)) + ((eq (car option) 'space-after-tab::tab) + (whitespace-space-after-tab-regexp 'tab)) + ((eq (car option) 'space-after-tab::space) + (whitespace-space-after-tab-regexp 'space)) + ((eq (car option) 'missing-newline-at-eof) + "[^\n]\\'") + (t + (cdr option))))) + (when (re-search-forward regexp rend t) + (unless has-bogus + (setq has-bogus (memq (car option) style))) + t))) whitespace-report-list))) (when (pcase report-if-bogus ('nil t) ('never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) @@ -1770,6 +1785,7 @@ cleaning up these problems." [] r - toggle trailing blanks visualization [] l - toggle \"long lines\" visualization [] L - toggle \"long lines\" tail visualization + [] C-l - toggle \"long lines\" one character visualization [] n - toggle NEWLINE visualization [] e - toggle empty line at bob and/or eob visualization [] C-i - toggle indentation SPACEs visualization (via `indent-tabs-mode') @@ -1892,6 +1908,7 @@ It accepts one of the following chars: r toggle trailing blanks visualization l toggle \"long lines\" visualization L toggle \"long lines\" tail visualization + C-l toggle \"long lines\" one character visualization n toggle NEWLINE visualization e toggle empty line at bob and/or eob visualization C-i toggle indentation SPACEs visualization (via `indent-tabs-mode') @@ -2020,6 +2037,7 @@ resultant list will be returned." (memq 'trailing whitespace-active-style) (memq 'lines whitespace-active-style) (memq 'lines-tail whitespace-active-style) + (memq 'lines-char whitespace-active-style) (memq 'newline whitespace-active-style) (memq 'empty whitespace-active-style) (memq 'indentation whitespace-active-style) @@ -2066,12 +2084,17 @@ resultant list will be returned." ;; Show trailing blanks. `((,#'whitespace-trailing-regexp 1 whitespace-trailing t))) ,@(when (or (memq 'lines whitespace-active-style) - (memq 'lines-tail whitespace-active-style)) + (memq 'lines-tail whitespace-active-style) + (memq 'lines-char whitespace-active-style)) ;; Show "long" lines. `((,#'whitespace-lines-regexp - ,(if (memq 'lines whitespace-active-style) - 0 ; whole line - 2) ; line tail + ,(cond + ;; whole line + ((memq 'lines whitespace-active-style) 0) + ;; line tail + ((memq 'lines-tail whitespace-active-style) 2) + ;; first overflowing character + ((memq 'lines-char whitespace-active-style) 3)) whitespace-line prepend))) ,@(when (or (memq 'space-before-tab whitespace-active-style) (memq 'space-before-tab::tab whitespace-active-style) @@ -2089,16 +2112,7 @@ resultant list will be returned." ,@(when (or (memq 'indentation whitespace-active-style) (memq 'indentation::tab whitespace-active-style) (memq 'indentation::space whitespace-active-style)) - `((,(cond - ((memq 'indentation whitespace-active-style) - ;; Show indentation SPACEs (indent-tabs-mode). - (whitespace-indentation-regexp)) - ((memq 'indentation::tab whitespace-active-style) - ;; Show indentation SPACEs (SPACEs). - (whitespace-indentation-regexp 'tab)) - ((memq 'indentation::space whitespace-active-style) - ;; Show indentation SPACEs (TABs). - (whitespace-indentation-regexp 'space))) + `((,#'whitespace--indentation-matcher 1 whitespace-indentation t))) ,@(when (memq 'big-indent whitespace-active-style) ;; Show big indentation. @@ -2182,7 +2196,7 @@ resultant list will be returned." (re-search-forward (let ((line-column (or whitespace-line-column fill-column))) (format - "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(?2:\\(?3:.\\).*\\)$" tab-width (1- tab-width) (/ line-column tab-width) @@ -2333,6 +2347,26 @@ Also refontify when necessary." (font-lock-flush ostart (overlay-end whitespace-point--used)) (delete-overlay whitespace-point--used)))))) +(defun whitespace--indentation-matcher (limit) + "Indentation matcher for `font-lock-keywords'. +This matcher is a function instead of a static regular expression +so that the next call to `font-lock-flush' picks up any changes +to `indent-tabs-mode' and `tab-width'." + (re-search-forward + (whitespace-indentation-regexp + (cond + ((memq 'indentation whitespace-active-style) nil) + ((memq 'indentation::tab whitespace-active-style) 'tab) + ((memq 'indentation::space whitespace-active-style) 'space))) + limit t)) + +(defun whitespace--variable-watcher (_symbol _newval _op buffer) + "Variable watcher that calls `font-lock-flush' for BUFFER." + (when buffer + (with-current-buffer buffer + (when whitespace-mode + (font-lock-flush))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) @@ -2369,9 +2403,11 @@ Also refontify when necessary." ;; Remember whether a buffer has a local display table. (unless whitespace-display-table-was-local (setq whitespace-display-table-was-local t) - (unless (or whitespace-mode global-whitespace-mode) - (setq whitespace-display-table - (copy-sequence buffer-display-table))) + ;; Save the old table so we can restore it when + ;; `whitespace-mode' is switched off again. + (when (or whitespace-mode global-whitespace-mode) + (setq whitespace-display-table + (copy-sequence buffer-display-table))) ;; Assure `buffer-display-table' is unique ;; when two or more windows are visible. (setq buffer-display-table @@ -2445,9 +2481,16 @@ It should be added buffer-locally to `write-file-functions'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defvar whitespace--watched-vars + '(fill-column indent-tabs-mode tab-width whitespace-line-column)) + +(dolist (var whitespace--watched-vars) + (add-variable-watcher var #'whitespace--variable-watcher)) (defun whitespace-unload-function () "Unload the whitespace library." + (dolist (var whitespace--watched-vars) + (remove-variable-watcher var #'whitespace--variable-watcher)) (global-whitespace-mode -1) ;; be sure all local whitespace mode is turned off (save-current-buffer @@ -2463,5 +2506,4 @@ It should be added buffer-locally to `write-file-functions'." "use `with-eval-after-load' instead." "28.1") (run-hooks 'whitespace-load-hook) - ;;; whitespace.el ends here |