diff options
| author | dickmao | 2022-03-22 15:59:11 +0100 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2022-03-22 15:59:11 +0100 |
| commit | 3054e70d76f71876c58497db04f55d7f413663d9 (patch) | |
| tree | 5529b7fa69e0123d04a9170fd2dc86204e84e653 | |
| parent | 9b47ccd72e107ee43fcd62362e7580dcfa50d008 (diff) | |
| download | emacs-3054e70d76f71876c58497db04f55d7f413663d9.tar.gz emacs-3054e70d76f71876c58497db04f55d7f413663d9.zip | |
Restore hl-line--buffer tracking
* lisp/hl-line.el (hl-line-overlay, hl-line-overlay-buffer):
Correct replacement variable.
(hl-line--overlay): Clearer doc.
(hl-line--buffer): Nee hl-line-overlay-buffer
(hl-line-sticky-flag): Custom initialization is unfathomable.
(hl-line-mode, hl-line-unhighlight): Orthogonalize sticky.
(hl-line-highlight): Remove highlight from previous buffer.
* test/lisp/hl-line-tests.el (hl-line-sticky, hl-line-tests-verify):
(hl-line-tests-sticky-across-frames, hl-line-tests-sticky):
Test (bug#54481).
| -rw-r--r-- | lisp/hl-line.el | 32 | ||||
| -rw-r--r-- | test/lisp/hl-line-tests.el | 108 |
2 files changed, 107 insertions, 33 deletions
diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 70ba0fcfc28..f1c2e1ebf23 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el | |||
| @@ -24,17 +24,26 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Commentary: | 25 | ;;; Commentary: |
| 26 | 26 | ||
| 27 | ;; Proper scuttling of unsticky overlays relies on `post-command-hook` | ||
| 28 | ;; being called on a buffer switch and the stationarity of | ||
| 29 | ;; `hl-line--buffer` across switches. One could easily imagine | ||
| 30 | ;; programatically defeating unsticky overlays by bypassing | ||
| 31 | ;; `post-command-hook`. | ||
| 32 | |||
| 27 | ;;; Code: | 33 | ;;; Code: |
| 28 | 34 | ||
| 29 | (make-obsolete-variable 'hl-line-overlay nil "29.1") | 35 | (make-obsolete-variable 'hl-line-overlay 'hl-line--overlay "29.1") |
| 30 | (make-obsolete-variable 'global-hl-line-overlay nil "29.1") | 36 | (make-obsolete-variable 'global-hl-line-overlay nil "29.1") |
| 31 | (make-obsolete-variable 'global-hl-line-overlays nil "29.1") | 37 | (make-obsolete-variable 'global-hl-line-overlays nil "29.1") |
| 32 | (make-obsolete-variable 'global-hl-line-sticky-flag nil "29.1") | 38 | (make-obsolete-variable 'global-hl-line-sticky-flag nil "29.1") |
| 33 | (make-obsolete-variable 'hl-line-overlay-buffer nil "29.1") | 39 | (make-obsolete-variable 'hl-line-overlay-buffer 'hl-line--buffer "29.1") |
| 34 | (make-obsolete-variable 'hl-line-range-function nil "29.1") | 40 | (make-obsolete-variable 'hl-line-range-function nil "29.1") |
| 35 | 41 | ||
| 36 | (defvar-local hl-line--overlay nil | 42 | (defvar-local hl-line--overlay nil |
| 37 | "Keep state else scan entire buffer in `post-command-hook'.") | 43 | "The prevailing highlighting overlay per buffer.") |
| 44 | |||
| 45 | (defvar hl-line--buffer nil | ||
| 46 | "Used to track last buffer.") | ||
| 38 | 47 | ||
| 39 | ;; 1. define-minor-mode creates buffer-local hl-line--overlay | 48 | ;; 1. define-minor-mode creates buffer-local hl-line--overlay |
| 40 | ;; 2. overlay wiped by kill-all-local-variables | 49 | ;; 2. overlay wiped by kill-all-local-variables |
| @@ -68,6 +77,7 @@ | |||
| 68 | :type 'boolean | 77 | :type 'boolean |
| 69 | :version "22.1" | 78 | :version "22.1" |
| 70 | :group 'hl-line | 79 | :group 'hl-line |
| 80 | :initialize #'custom-initialize-default | ||
| 71 | :set (lambda (symbol value) | 81 | :set (lambda (symbol value) |
| 72 | (set-default symbol value) | 82 | (set-default symbol value) |
| 73 | (unless value | 83 | (unless value |
| @@ -100,14 +110,12 @@ Currently used in calendar/todo-mode." | |||
| 100 | (add-hook 'post-command-hook #'hl-line-highlight nil t)) | 110 | (add-hook 'post-command-hook #'hl-line-highlight nil t)) |
| 101 | (remove-hook 'post-command-hook #'hl-line-highlight t) | 111 | (remove-hook 'post-command-hook #'hl-line-highlight t) |
| 102 | (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) | 112 | (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) |
| 103 | (let (hl-line-sticky-flag) | 113 | (hl-line-unhighlight))) |
| 104 | (hl-line-unhighlight)))) | ||
| 105 | 114 | ||
| 106 | (defun hl-line-unhighlight () | 115 | (defun hl-line-unhighlight () |
| 107 | (unless hl-line-sticky-flag | 116 | (when hl-line--overlay |
| 108 | (when hl-line--overlay | 117 | (delete-overlay hl-line--overlay) |
| 109 | (delete-overlay hl-line--overlay) | 118 | (setq hl-line--overlay nil))) |
| 110 | (setq hl-line--overlay nil)))) | ||
| 111 | 119 | ||
| 112 | (defun hl-line-highlight () | 120 | (defun hl-line-highlight () |
| 113 | (unless (minibufferp) | 121 | (unless (minibufferp) |
| @@ -120,6 +128,12 @@ Currently used in calendar/todo-mode." | |||
| 120 | (move-overlay hl-line--overlay | 128 | (move-overlay hl-line--overlay |
| 121 | (line-beginning-position) | 129 | (line-beginning-position) |
| 122 | (line-beginning-position 2)) | 130 | (line-beginning-position 2)) |
| 131 | (when (and (not (eq hl-line--buffer (current-buffer))) | ||
| 132 | (not hl-line-sticky-flag) | ||
| 133 | (buffer-live-p hl-line--buffer)) | ||
| 134 | (with-current-buffer hl-line--buffer | ||
| 135 | (hl-line-unhighlight))) | ||
| 136 | (setq hl-line--buffer (current-buffer)) | ||
| 123 | (run-hooks 'hl-line-highlight-hook))) | 137 | (run-hooks 'hl-line-highlight-hook))) |
| 124 | 138 | ||
| 125 | (defun hl-line-turn-on () | 139 | (defun hl-line-turn-on () |
diff --git a/test/lisp/hl-line-tests.el b/test/lisp/hl-line-tests.el index 422d4ddae7d..6bff09135b2 100644 --- a/test/lisp/hl-line-tests.el +++ b/test/lisp/hl-line-tests.el | |||
| @@ -21,30 +21,90 @@ | |||
| 21 | (require 'ert) | 21 | (require 'ert) |
| 22 | (require 'hl-line) | 22 | (require 'hl-line) |
| 23 | 23 | ||
| 24 | (ert-deftest hl-line-sticky () | 24 | (defsubst hl-line-tests-verify (_label on-p) |
| 25 | (should hl-line-sticky-flag) | 25 | (eq on-p (cl-some (apply-partially #'eq hl-line--overlay) |
| 26 | (with-temp-buffer | 26 | (overlays-at (point))))) |
| 27 | (let ((from-buffer (current-buffer))) | 27 | |
| 28 | (hl-line-mode 1) | 28 | (ert-deftest hl-line-tests-sticky-across-frames () |
| 29 | (save-excursion | 29 | (skip-unless (display-graphic-p)) |
| 30 | (insert "foo")) | 30 | (customize-set-variable 'hl-line-sticky-flag t) |
| 31 | (hl-line-highlight) | 31 | (call-interactively #'global-hl-line-mode) |
| 32 | (should (cl-some (apply-partially #'eq hl-line--overlay) | 32 | (let ((first-frame (selected-frame)) |
| 33 | (overlays-at (point)))) | 33 | (first-buffer "foo") |
| 34 | (switch-to-buffer (get-buffer-create "*scratch*")) | 34 | (second-buffer "bar") |
| 35 | (hl-line-mode 1) | 35 | second-frame) |
| 36 | (save-excursion | 36 | (unwind-protect |
| 37 | (insert "bar")) | 37 | (progn |
| 38 | (hl-line-highlight) | 38 | (switch-to-buffer first-buffer) |
| 39 | (should (cl-some (apply-partially #'eq hl-line--overlay) | 39 | (save-excursion |
| 40 | (overlays-at (point)))) | 40 | (insert (buffer-name))) |
| 41 | (should (buffer-local-value 'hl-line--overlay from-buffer)) | 41 | (run-hooks 'post-command-hook) |
| 42 | (should-not (eq (buffer-local-value 'hl-line--overlay from-buffer) | 42 | (should (hl-line-tests-verify 111 t)) |
| 43 | hl-line--overlay)) | 43 | (select-frame (setq second-frame (make-frame))) |
| 44 | (customize-set-variable 'hl-line-sticky-flag nil) | 44 | (switch-to-buffer second-buffer) |
| 45 | (should hl-line--overlay) | 45 | (save-excursion |
| 46 | (should (buffer-live-p from-buffer)) | 46 | (insert (buffer-name))) |
| 47 | (should-not (buffer-local-value 'hl-line--overlay from-buffer))))) | 47 | (run-hooks 'post-command-hook) |
| 48 | (should (hl-line-tests-verify 762 t)) | ||
| 49 | (with-current-buffer first-buffer | ||
| 50 | (should (hl-line-tests-verify 534 t))) | ||
| 51 | (call-interactively #'global-hl-line-mode) | ||
| 52 | (should (hl-line-tests-verify 125 nil)) | ||
| 53 | (with-current-buffer first-buffer | ||
| 54 | (should (hl-line-tests-verify 892 nil))) | ||
| 55 | |||
| 56 | ;; now do unsticky | ||
| 57 | (customize-set-variable 'hl-line-sticky-flag nil) | ||
| 58 | (call-interactively #'global-hl-line-mode) | ||
| 59 | (run-hooks 'post-command-hook) | ||
| 60 | (should (hl-line-tests-verify 467 t)) | ||
| 61 | (with-current-buffer first-buffer | ||
| 62 | (should (hl-line-tests-verify 765 nil))) | ||
| 63 | (select-frame first-frame) | ||
| 64 | (should (equal (buffer-name) first-buffer)) | ||
| 65 | (run-hooks 'post-command-hook) | ||
| 66 | (should (hl-line-tests-verify 423 t)) | ||
| 67 | (with-current-buffer second-buffer | ||
| 68 | (should (hl-line-tests-verify 897 nil)))) | ||
| 69 | (let (kill-buffer-query-functions) | ||
| 70 | (ignore-errors (kill-buffer first-buffer)) | ||
| 71 | (ignore-errors (kill-buffer second-buffer)) | ||
| 72 | (ignore-errors (delete-frame second-frame)))))) | ||
| 73 | |||
| 74 | (ert-deftest hl-line-tests-sticky () | ||
| 75 | (customize-set-variable 'hl-line-sticky-flag t) | ||
| 76 | (let ((first-buffer "foo") | ||
| 77 | (second-buffer "bar")) | ||
| 78 | (unwind-protect | ||
| 79 | (progn | ||
| 80 | (switch-to-buffer first-buffer) | ||
| 81 | (hl-line-mode 1) | ||
| 82 | (save-excursion | ||
| 83 | (insert (buffer-name))) | ||
| 84 | (run-hooks 'post-command-hook) | ||
| 85 | (should (hl-line-tests-verify 123 t)) | ||
| 86 | (switch-to-buffer second-buffer) | ||
| 87 | (hl-line-mode 1) | ||
| 88 | (save-excursion | ||
| 89 | (insert (buffer-name))) | ||
| 90 | (run-hooks 'post-command-hook) | ||
| 91 | (should (hl-line-tests-verify 56 t)) | ||
| 92 | (with-current-buffer first-buffer | ||
| 93 | (should (hl-line-tests-verify 67 t))) | ||
| 94 | |||
| 95 | ;; now do unsticky | ||
| 96 | (customize-set-variable 'hl-line-sticky-flag nil) | ||
| 97 | (should (hl-line-tests-verify 234 t)) | ||
| 98 | (with-current-buffer first-buffer | ||
| 99 | (should (hl-line-tests-verify 231 nil))) | ||
| 100 | (switch-to-buffer first-buffer) | ||
| 101 | (run-hooks 'post-command-hook) | ||
| 102 | (should (hl-line-tests-verify 257 t)) | ||
| 103 | (with-current-buffer second-buffer | ||
| 104 | (should (hl-line-tests-verify 999 nil))))) | ||
| 105 | (let (kill-buffer-query-functions) | ||
| 106 | (ignore-errors (kill-buffer first-buffer)) | ||
| 107 | (ignore-errors (kill-buffer second-buffer))))) | ||
| 48 | 108 | ||
| 49 | (provide 'hl-line-tests) | 109 | (provide 'hl-line-tests) |
| 50 | 110 | ||