diff options
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>) |