procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

whitespace: Redo BoB/EoB empty line highlighting

Browse source 
* 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.
This commit is contained in:
Richard Hansen 2022-06-28 16:25:43 -04:00 • committed by Lars Ingebrigtsen
parent 395786f42b
commit f47a5324f4
2 changed files with 384 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

253
lisp/whitespace.el
View file

@ -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))
(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 limit)
(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>)

230
test/lisp/whitespace-tests.el
View file

@ -20,8 +20,35 @@
;;; Code:
(require 'ert)
(require 'ert-x)
(require 'faceup)
(require 'whitespace)
(defmacro whitespace-tests--with-test-buffer (style &rest body)
"Run BODY in a buffer with `whitespace-mode' style STYLE.
The buffer is displayed in `selected-window', and
`noninteractive' is set to nil even in batch mode."
(declare (debug ((style form) def-body))
(indent 1))
`(ert-with-test-buffer-selected ()
;; In case global-*-mode is enabled.
(whitespace-mode -1)
(font-lock-mode -1)
(let ((noninteractive nil)
(whitespace-style ,style))
(font-lock-mode 1)
(whitespace-mode 1)
,@body)))
(defun whitespace-tests--faceup (&rest lines)
"Convenience wrapper around `faceup-test-font-lock-buffer'.
Returns non-nil if the concatenated LINES match the current
buffer's content."
(faceup-test-font-lock-buffer nil (apply #'concat lines)))
(let ((x (get 'faceup-test-font-lock-buffer 'ert-explainer)))
(put 'whitespace-tests--faceup 'ert-explainer
(lambda (&rest lines) (funcall x nil (apply #'concat lines)))))
(defun whitespace-tests--cleanup-string (string)
(with-temp-buffer
(insert string)
@ -80,6 +107,209 @@
(whitespace-turn-off)
buffer-display-table))))))
(ert-deftest whitespace-tests--empty-bob ()
(whitespace-tests--with-test-buffer '(face empty)
(electric-indent-mode -1)
;; Insert some empty lines. None of the lines should be
;; highlighted even though point is on the last line because the
;; entire buffer is empty lines.
(execute-kbd-macro (kbd "SPC RET C-q TAB RET RET SPC"))
(should (equal (buffer-string) " \n\t\n\n "))
(should (equal (line-number-at-pos) 4))
(should (whitespace-tests--faceup " \n"
"\t\n"
"\n"
" "))
;; Adding content on the last line (and keeping point there)
;; should cause the previous lines to be highlighted. Note that
;; the `whitespace-empty' face applies to the newline just before
;; the last line, which has the desired property of extending the
;; highlight the full width of the window.
(execute-kbd-macro (kbd "x"))
(should (equal (buffer-string) " \n\t\n\n x"))
(should (equal (line-number-at-pos) 4))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"\t\n"
"\n"
"» x"))
;; Lines should become un-highlighted as point moves up into the
;; empty lines.
(execute-kbd-macro (kbd "<up>"))
(should (equal (line-number-at-pos) 3))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"\t\n"
"»\n"
" x"))
(execute-kbd-macro (kbd "<up>"))
(should (equal (line-number-at-pos) 2))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"»\t\n"
"\n"
" x"))
(execute-kbd-macro (kbd "<up> <home>"))
(should (equal (point) 1))
(should (whitespace-tests--faceup " \n"
"\t\n"
"\n"
" x"))
;; Line 1 should be un-highlighted when point is in line 1 even if
;; point is not bobp.
(execute-kbd-macro (kbd "<right>"))
(should (equal (line-number-at-pos) 1))
(should (> (point) 1))
(should (whitespace-tests--faceup " \n"
"\t\n"
"\n"
" x"))
;; Make sure lines become re-highlighted as point moves down.
(execute-kbd-macro (kbd "<down>"))
(should (equal (line-number-at-pos) 2))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"»\t\n"
"\n"
" x"))
(execute-kbd-macro (kbd "<down>"))
(should (equal (line-number-at-pos) 3))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"\t\n"
"»\n"
" x"))
(execute-kbd-macro (kbd "<down>"))
(should (equal (line-number-at-pos) 4))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"\t\n"
"\n"
"» x"))
;; Inserting content on line 2 should un-highlight lines 2 and 3.
(execute-kbd-macro (kbd "<up> <up> <end>"))
(should (equal (line-number-at-pos) 2))
(should (equal (- (point) (line-beginning-position)) 1))
(execute-kbd-macro (kbd "y <down> <down>"))
(should (equal (line-number-at-pos) 4))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"»\ty\n"
"\n"
" x"))
;; Removing the content on line 2 should re-highlight lines 2 and
;; 3.
(execute-kbd-macro (kbd "<up> <up> <end>"))
(should (equal (line-number-at-pos) 2))
(should (equal (- (point) (line-beginning-position)) 2))
(execute-kbd-macro (kbd "DEL <down> <down>"))
(should (equal (line-number-at-pos) 4))
(should (whitespace-tests--faceup "«:whitespace-empty: \n"
"\t\n"
"\n"
"» x"))))
(ert-deftest whitespace-tests--empty-eob ()
(whitespace-tests--with-test-buffer '(face empty)
(electric-indent-mode -1)
;; Insert some empty lines. None of the lines should be
;; highlighted even though point is on line 1 because the entire
;; buffer is empty lines.
(execute-kbd-macro (kbd "RET RET C-q TAB RET SPC C-<home>"))
(should (equal (buffer-string) "\n\n\t\n "))
(should (equal (line-number-at-pos) 1))
(should (whitespace-tests--faceup "\n"
"\n"
"\t\n"
" "))
;; Adding content on the first line (and keeping point there)
;; should cause the subsequent lines to be highlighted.
(execute-kbd-macro (kbd "x"))
(should (equal (buffer-string) "x\n\n\t\n "))
(should (equal (line-number-at-pos) 1))
(should (whitespace-tests--faceup "x\n"
"«:whitespace-empty:\n"
"\t\n"
" »"))
;; Lines should become un-highlighted as point moves down into the
;; empty lines.
(execute-kbd-macro (kbd "<down>"))
(should (equal (line-number-at-pos) 2))
(should (whitespace-tests--faceup "x\n"
"\n"
"«:whitespace-empty:\t\n"
" »"))
(execute-kbd-macro (kbd "<down>"))
(should (equal (line-number-at-pos) 3))
(should (whitespace-tests--faceup "x\n"
"\n"
"\t\n"
"«:whitespace-empty: »"))
(execute-kbd-macro (kbd "C-<end>"))
(should (equal (line-number-at-pos) 4))
(should (eobp))
(should (equal (- (point) (line-beginning-position)) 1))
(should (whitespace-tests--faceup "x\n"
"\n"
"\t\n"
" "))
;; The last line should be un-highlighted when point is in that
;; line even if point is not eobp.
(execute-kbd-macro (kbd "<left>"))
(should (equal (line-number-at-pos) 4))
(should (not (eobp)))
(should (whitespace-tests--faceup "x\n"
"\n"
"\t\n"
" "))
;; Make sure lines become re-highlighted as point moves up.
(execute-kbd-macro (kbd "<up>"))
(should (equal (line-number-at-pos) 3))
(should (whitespace-tests--faceup "x\n"
"\n"
"\t\n"
"«:whitespace-empty: »"))
(execute-kbd-macro (kbd "<up>"))
(should (equal (line-number-at-pos) 2))
(should (whitespace-tests--faceup "x\n"
"\n"
"«:whitespace-empty:\t\n"
" »"))
(execute-kbd-macro (kbd "<up>"))
(should (equal (line-number-at-pos) 1))
(should (whitespace-tests--faceup "x\n"
"«:whitespace-empty:\n"
"\t\n"
" »"))
;; Inserting content on line 3 should un-highlight lines 2 and 3.
(execute-kbd-macro (kbd "<down> <down> <home>"))
(should (equal (line-number-at-pos) 3))
(should (equal (- (point) (line-beginning-position)) 0))
(execute-kbd-macro (kbd "y <up> <up>"))
(should (equal (line-number-at-pos) 1))
(should (whitespace-tests--faceup "x\n"
"\n"
"y\t\n"
"«:whitespace-empty: »"))
;; Removing the content on line 3 should re-highlight lines 2 and
;; 3.
(execute-kbd-macro (kbd "<down> <down> <home>"))
(should (equal (line-number-at-pos) 3))
(should (equal (- (point) (line-beginning-position)) 0))
(execute-kbd-macro (kbd "<deletechar> <up> <up>"))
(should (equal (line-number-at-pos) 1))
(should (whitespace-tests--faceup "x\n"
"«:whitespace-empty:\n"
"\t\n"
" »"))))
(provide 'whitespace-tests)
;;; whitespace-tests.el ends here