diff options
author | Richard Hansen <rhansen@rhansen.org> | 2022-06-28 16:25:43 -0400 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-09-11 13:46:30 +0200 |
commit | f47a5324f44e5b8d0016cff2a4f995ff418a5d19 (patch) | |
tree | 17570eb9f0dbd76fa8ba683c67ea3e42fab121bd /lisp/whitespace.el | |
parent | 395786f42b0eed361ee34cd398bc8ee33802ed04 (diff) | |
download | emacs-f47a5324f44e5b8d0016cff2a4f995ff418a5d19.tar.gz |
whitespace: Redo BoB/EoB empty line highlighting
* lisp/whitespace.el (whitespace--empty-at-bob-matcher,
whitespace--empty-at-eob-matcher, whitespace--update-bob-eob,
whitespace-color-off, whitespace-color-on,
whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp,
whitespace-looking-back, whitespace-post-command-hook): Redo the
`empty' line highlighting logic to ensure that a buffer change causes
all affected `empty' lines to become (un)highlighted (bug#37467).
Also, for improved UX, don't highlight BoB empty lines at or below
point (not just when point is at 1), or EoB empty lines at or above
point (not just when point is `eobp').
(whitespace-bob-marker, whitespace-eob-marker): Clarify documentation.
* test/lisp/whitespace-tests.el (whitespace--with-test-buffer,
whitespace--fu, whitespace-tests--empty-bob,
whitespace-tests--empty-eob): Add tests.
Diffstat (limited to 'lisp/whitespace.el')
-rw-r--r-- | lisp/whitespace.el | 255 |
1 files changed, 155 insertions, 100 deletions
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 8146eff9b0a..ae4d8ae3f06 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1139,12 +1139,21 @@ Used by function `whitespace-trailing-regexp' (which see).") "Region whose highlighting depends on `whitespace-point'.") (defvar-local whitespace-bob-marker nil - "Used to save locally the bob marker value. -Used by function `whitespace-post-command-hook' (which see).") + "Position of the buffer's first non-empty line. +This marker is positioned at the beginning of the first line in +the buffer that contains a non-space character. If no such line +exists, this is positioned at the end of the buffer (which could +be after `whitespace-eob-marker' if the buffer contains nothing +but empty lines).") (defvar-local whitespace-eob-marker nil - "Used to save locally the eob marker value. -Used by function `whitespace-post-command-hook' (which see).") + "Position after the buffer's last non-empty line. +This marker is positioned at the beginning of the first line +immediately following the last line in the buffer that contains a +non-space character. If no such line exists, this is positioned +at the beginning of the buffer (which could be before +`whitespace-bob-marker' if the buffer contains nothing but empty +lines).") (defvar-local whitespace-buffer-changed nil "Used to indicate locally if buffer changed. @@ -2059,9 +2068,14 @@ resultant list will be returned." (delete-overlay ol) ol)) (setq-local whitespace-bob-marker (point-min-marker)) (setq-local whitespace-eob-marker (point-max-marker)) + (whitespace--update-bob-eob) (setq-local whitespace-buffer-changed nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) + (add-hook 'after-change-functions #'whitespace--update-bob-eob + ;; The -1 ensures that it runs before any + ;; `font-lock-mode' hook functions. + -1 t) ;; Add whitespace-mode color into font lock. (setq whitespace-font-lock-keywords @@ -2114,11 +2128,11 @@ resultant list will be returned." `((,whitespace-big-indent-regexp 1 'whitespace-big-indent t))) ,@(when (memq 'empty whitespace-active-style) ;; Show empty lines at beginning of buffer. - `((,#'whitespace-empty-at-bob-regexp - 1 whitespace-empty t) + `((,#'whitespace--empty-at-bob-matcher + 0 whitespace-empty t) ;; Show empty lines at end of buffer. - (,#'whitespace-empty-at-eob-regexp - 1 whitespace-empty t))) + (,#'whitespace--empty-at-eob-matcher + 0 whitespace-empty t))) ,@(when (or (memq 'space-after-tab whitespace-active-style) (memq 'space-after-tab::tab whitespace-active-style) (memq 'space-after-tab::space whitespace-active-style)) @@ -2153,6 +2167,8 @@ resultant list will be returned." (when (whitespace-style-face-p) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) + (remove-hook 'after-change-functions #'whitespace--update-bob-eob + t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) (font-lock-flush))) @@ -2201,115 +2217,83 @@ resultant list will be returned." (format ".\\{%d\\}" rem))))) limit t)) -(defun whitespace-empty-at-bob-regexp (limit) - "Match spaces at beginning of buffer (BOB) which do not contain point at BOB." - (let ((b (point)) - r) - (cond - ;; at bob - ((= b 1) - (setq r (and (looking-at whitespace-empty-at-bob-regexp) - (or (/= whitespace-point 1) - (progn (whitespace-point--used (match-beginning 0) - (match-end 0)) - nil)))) - (set-marker whitespace-bob-marker (if r (match-end 1) b))) - ;; inside bob empty region - ((<= limit whitespace-bob-marker) - (setq r (looking-at whitespace-empty-at-bob-regexp)) - (if r - (when (< (match-end 1) limit) - (set-marker whitespace-bob-marker (match-end 1))) - (set-marker whitespace-bob-marker b))) - ;; intersection with end of bob empty region - ((<= b whitespace-bob-marker) - (setq r (looking-at whitespace-empty-at-bob-regexp)) - (set-marker whitespace-bob-marker (if r (match-end 1) b))) - ;; it is not inside bob empty region - (t - (setq r nil))) - ;; move to end of matching - (and r (goto-char (match-end 1))) - r)) - - -(defsubst whitespace-looking-back (regexp limit) +(defun whitespace--empty-at-bob-matcher (limit) + "Match empty/space-only lines at beginning of buffer (BoB). +Match does not extend past position LIMIT. For improved UX, the +line containing `whitespace-point' and subsequent lines are +excluded from the match. (The idea is that the user might be +about to start typing, and if they do, that line and any +following empty lines will no longer be BoB empty lines. +Highlighting those lines can be distracting.)" + (let ((p (point)) + (e (min whitespace-bob-marker limit + ;; EoB marker will be before BoB marker if the buffer + ;; has nothing but empty lines. + whitespace-eob-marker + (save-excursion (goto-char whitespace-point) + (line-beginning-position))))) + (when (= p 1) + ;; See the comment in `whitespace--update-bob-eob' for why this + ;; text property is added here. + (put-text-property 1 whitespace-bob-marker + 'font-lock-multiline t)) + (when (< p e) + (set-match-data (list p e)) + (goto-char e)))) + +(defsubst whitespace--looking-back (regexp) (save-excursion - (when (/= 0 (skip-chars-backward " \t\n" limit)) + (when (/= 0 (skip-chars-backward " \t\n")) (unless (bolp) (forward-line 1)) (looking-at regexp)))) - -(defun whitespace-empty-at-eob-regexp (limit) - "Match spaces at end of buffer which do not contain the point at end of \ -buffer." - (let ((b (point)) - (e (1+ (buffer-size))) - r) - (cond - ;; at eob - ((= limit e) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (when (and r (= whitespace-point e)) - (setq r nil) - (whitespace-point--used (match-beginning 0) (match-end 0))) - (if r - (set-marker whitespace-eob-marker (match-beginning 1)) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; inside eob empty region - ((>= b whitespace-eob-marker) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (if r - (when (> (match-beginning 1) b) - (set-marker whitespace-eob-marker (match-beginning 1))) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; intersection with beginning of eob empty region - ((>= limit whitespace-eob-marker) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) - (if r - (set-marker whitespace-eob-marker (match-beginning 1)) - (set-marker whitespace-eob-marker limit) - (goto-char b))) ; return back to initial position - ;; it is not inside eob empty region - (t - (setq r nil))) - r)) - +(defun whitespace--empty-at-eob-matcher (limit) + "Match empty/space-only lines at end of buffer (EoB). +Match does not extend past position LIMIT. For improved UX, the +line containing `whitespace-point' and preceding lines are +excluded from the match. (The idea is that the user might be +about to start typing, and if they do, that line and previous +empty lines will no longer be EoB empty lines. Highlighting +those lines can be distracting.)" + (when (= limit (1+ (buffer-size))) + ;; See the comment in `whitespace--update-bob-eob' for why this + ;; text property is added here. + (put-text-property whitespace-eob-marker limit + 'font-lock-multiline t)) + (let ((b (max (point) whitespace-eob-marker + whitespace-bob-marker ; See comment in the bob func. + (save-excursion (goto-char whitespace-point) + (forward-line 1) + (point))))) + (when (< b limit) + (set-match-data (list b limit)) + (goto-char limit)))) (defun whitespace-buffer-changed (_beg _end) "Set `whitespace-buffer-changed' variable to t." (setq whitespace-buffer-changed t)) - (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." (unless (and (eq whitespace-point (point)) (not whitespace-buffer-changed)) + (when (and (not whitespace-buffer-changed) + (memq 'empty whitespace-active-style)) + ;; No need to handle the `whitespace-buffer-changed' case here + ;; because that is taken care of by the `font-lock-multiline' + ;; text property. + (when (<= (min (point) whitespace-point) whitespace-bob-marker) + (font-lock-flush 1 whitespace-bob-marker)) + (when (>= (max (point) whitespace-point) whitespace-eob-marker) + (font-lock-flush whitespace-eob-marker (1+ (buffer-size))))) (setq-local whitespace-buffer-changed nil) (setq whitespace-point (point)) ; current point position - (let ((refontify - (cond - ;; It is at end of buffer (eob). - ((= whitespace-point (1+ (buffer-size))) - (when (whitespace-looking-back whitespace-empty-at-eob-regexp - nil) - (match-beginning 0))) - ;; It is at end of line ... - ((and (eolp) - ;; ... with trailing SPACE or TAB - (or (memq (preceding-char) '(?\s ?\t)))) - (line-beginning-position)) - ;; It is at beginning of buffer (bob). - ((and (= whitespace-point 1) - (looking-at whitespace-empty-at-bob-regexp)) - (match-end 0)))) + (let ((refontify (and (eolp) ; It is at end of line ... + ;; ... with trailing SPACE or TAB + (or (memq (preceding-char) '(?\s ?\t))) + (line-beginning-position))) (ostart (overlay-start whitespace-point--used))) (cond ((not refontify) @@ -2363,6 +2347,77 @@ to `indent-tabs-mode' and `tab-width'." (when whitespace-mode (font-lock-flush))))) +(defun whitespace--update-bob-eob (&optional beg end &rest _) + "Update `whitespace-bob-marker' and `whitespace-eob-marker'. +Also apply `font-lock-multiline' text property. If BEG and END +are non-nil, assume that only characters in that range have +changed since the last call to this function (for optimization +purposes)." + (when (memq 'empty whitespace-active-style) + ;; When a line is changed, `font-lock-mode' normally limits + ;; re-processing to only the changed line. That behavior is + ;; problematic for highlighting `empty' lines because adding or + ;; deleting a character might affect lines before or after the + ;; change. To address this, all `empty' lines are marked with a + ;; non-nil `font-lock-multiline' text property. This forces + ;; `font-lock-mode' to re-process all of the lines whenever + ;; there's an edit within any one of them. + ;; + ;; The text property must be set on `empty' lines twice per + ;; relevant change: + ;; + ;; 1. Before the change. This is necessary to ensure that + ;; previously highlighted lines become un-highlighted if + ;; necessary. The text property must be added after the + ;; previous `font-lock-mode' run (the run in reaction to the + ;; previous change) because `font-lock-mode' clears the text + ;; property when it runs. + ;; + ;; 2. After the change, but before `font-lock-mode' reacts to + ;; the change. This is necessary to ensure that new `empty' + ;; lines become highlighted. + ;; + ;; This hook function is responsible for #2, while the + ;; `whitespace--empty-at-bob-matcher' and + ;; `whitespace--empty-at-eob-matcher' functions are responsible + ;; for #1. (Those functions run after `font-lock-mode' clears the + ;; text property and before the next change.) + (save-excursion + (save-restriction + (widen) + (when (or (null beg) + (<= beg (save-excursion + (goto-char whitespace-bob-marker) + ;; Any change in the first non-`empty' + ;; line, even if it's not the first + ;; character in the line, can potentially + ;; cause subsequent lines to become + ;; classified as `empty' (e.g., delete the + ;; "x" from " x"). + (forward-line 1) + (point)))) + (goto-char 1) + (set-marker whitespace-bob-marker (point)) + (save-match-data + (when (looking-at whitespace-empty-at-bob-regexp) + (set-marker whitespace-bob-marker (match-end 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))) + (when (or (null end) + (>= end (save-excursion + (goto-char whitespace-eob-marker) + ;; See above comment for the BoB case. + (forward-line -1) + (point)))) + (goto-char (1+ (buffer-size))) + (set-marker whitespace-eob-marker (point)) + (save-match-data + (when (whitespace--looking-back + whitespace-empty-at-eob-regexp) + (set-marker whitespace-eob-marker (match-beginning 1)) + (put-text-property (match-beginning 1) (match-end 1) + 'font-lock-multiline t)))))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Hacked from visws.el (Miles Bader <miles@gnu.org>) |