diff options
| -rw-r--r-- | lisp/whitespace.el | 255 | ||||
| -rw-r--r-- | test/lisp/whitespace-tests.el | 230 |
2 files changed, 385 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>) diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 2a59bfe9d80..792e157ec08 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -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 |