aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordickmao2022-03-22 15:59:11 +0100
committerLars Ingebrigtsen2022-03-22 15:59:11 +0100
commit3054e70d76f71876c58497db04f55d7f413663d9 (patch)
tree5529b7fa69e0123d04a9170fd2dc86204e84e653
parent9b47ccd72e107ee43fcd62362e7580dcfa50d008 (diff)
downloademacs-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.el32
-rw-r--r--test/lisp/hl-line-tests.el108
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