From 27d1629000236f036988a0cbc768e71846880775 Mon Sep 17 00:00:00 2001 From: dickmao Date: Tue, 22 Mar 2022 09:58:09 -0400 Subject: [PATCH] I broke hl-line-sticky-flag Turns out `hl-line--buffer` (nee `hl-line-overlay-buffer`) wasn't cruft. It was the poor man's previous-buffer tracker, of which the rich man's version is some highly nontrivial inference from `window-prev-buffers`, the details of which I've yet to elicit. * 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/calendar/todo-mode-tests.el (todo-test-item-highlighting, todo-test-done-items-separator06-bol, todo-test-done-items-separator06-eol, todo-test-done-items-separator07): Fallout f36d929. * test/lisp/hl-line-tests.el (hl-line-sticky, hl-line-tests-verify): (hl-line-tests-sticky-across-frames, hl-line-tests-sticky): Test. --- lisp/hl-line.el | 33 +++++--- test/lisp/calendar/todo-mode-tests.el | 10 +-- test/lisp/hl-line-tests.el | 108 ++++++++++++++++++++------ 3 files changed, 113 insertions(+), 38 deletions(-) diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 70ba0fcfc28..3faa2946115 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -24,17 +24,27 @@ ;;; Commentary: +;; Proper scuttling of unsticky overlays relies on `post-command-hook` +;; being called on a buffer switch and the stationarity of +;; `hl-line--buffer` across switches. One could easily imagine +;; programatically defeating unsticky overlays by bypassing +;; `post-command-hook`. + ;;; Code: -(make-obsolete-variable 'hl-line-overlay nil "29.1") +(make-obsolete-variable 'hl-line-overlay 'hl-line--overlay "29.1") (make-obsolete-variable 'global-hl-line-overlay nil "29.1") (make-obsolete-variable 'global-hl-line-overlays nil "29.1") (make-obsolete-variable 'global-hl-line-sticky-flag nil "29.1") -(make-obsolete-variable 'hl-line-overlay-buffer nil "29.1") +(make-obsolete-variable 'hl-line-overlay-buffer 'hl-line--buffer "29.1") (make-obsolete-variable 'hl-line-range-function nil "29.1") (defvar-local hl-line--overlay nil - "Keep state else scan entire buffer in `post-command-hook'.") + "The prevailing highlighting overlay per buffer.") + +(defvar hl-line--buffer nil + "Track last buffer in lieu of nontrivial inference from +`window-prev-buffers`.") ;; 1. define-minor-mode creates buffer-local hl-line--overlay ;; 2. overlay wiped by kill-all-local-variables @@ -68,6 +78,7 @@ hl-line-sticky-flag :type 'boolean :version "22.1" :group 'hl-line + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (unless value @@ -100,14 +111,12 @@ hl-line-mode (add-hook 'post-command-hook #'hl-line-highlight nil t)) (remove-hook 'post-command-hook #'hl-line-highlight t) (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t) - (let (hl-line-sticky-flag) - (hl-line-unhighlight)))) + (hl-line-unhighlight))) (defun hl-line-unhighlight () - (unless hl-line-sticky-flag - (when hl-line--overlay - (delete-overlay hl-line--overlay) - (setq hl-line--overlay nil)))) + (when hl-line--overlay + (delete-overlay hl-line--overlay) + (setq hl-line--overlay nil))) (defun hl-line-highlight () (unless (minibufferp) @@ -120,6 +129,12 @@ hl-line-highlight (move-overlay hl-line--overlay (line-beginning-position) (line-beginning-position 2)) + (when (and (not (eq hl-line--buffer (current-buffer))) + (not hl-line-sticky-flag) + (buffer-live-p hl-line--buffer)) + (with-current-buffer hl-line--buffer + (hl-line-unhighlight))) + (setq hl-line--buffer (current-buffer)) (run-hooks 'hl-line-highlight-hook))) (defun hl-line-turn-on () diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 8715a32b883..0102b62c10f 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -130,8 +130,8 @@ todo-test-item-highlighting (todo-toggle-item-highlighting) (let ((end (1- (todo-item-end))) (beg (todo-item-start))) - (should (eq (get-char-property beg 'face) 'hl-line-face)) - (should (eq (get-char-property end 'face) 'hl-line-face)) + (should (eq (get-char-property beg 'face) 'hl-line)) + (should (eq (get-char-property end 'face) 'hl-line)) (should (> (count-lines beg end) 1)) (should (eq (next-single-char-property-change beg 'face) (1+ end)))) (todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun). @@ -736,7 +736,7 @@ todo-test-done-items-separator06-bol (todo-test--done-items-separator) (call-interactively #'todo-toggle-item-highlighting) (ert-simulate-command '(todo-previous-item)) - (should (eq 'hl-line-face (get-char-property (point) 'face))))) + (should (eq 'hl-line (get-char-property (point) 'face))))) (ert-deftest todo-test-done-items-separator06-eol () ; bug#32343 "Test enabling item highlighting at EOL of done items separator. @@ -746,7 +746,7 @@ todo-test-done-items-separator06-eol (todo-toggle-item-highlighting) (forward-line -1) (ert-simulate-command '(todo-previous-item)) - (should (eq 'hl-line-face (get-char-property (point) 'face))))) + (should (eq 'hl-line (get-char-property (point) 'face))))) (ert-deftest todo-test-done-items-separator07 () ; bug#32343 "Test item highlighting when crossing done items separator. @@ -758,7 +758,7 @@ todo-test-done-items-separator07 (todo-next-item) ; Now on empty line above separator. (forward-line) ; Now on separator. (ert-simulate-command '(forward-line)) ; Now on first done item. - (should (eq 'hl-line-face (get-char-property (point) 'face))))) + (should (eq 'hl-line (get-char-property (point) 'face))))) (ert-deftest todo-test-current-file-in-edit-mode () ; bug#32437 "Test the value of todo-current-todo-file in todo-edit-mode." 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 @@ (require 'ert) (require 'hl-line) -(ert-deftest hl-line-sticky () - (should hl-line-sticky-flag) - (with-temp-buffer - (let ((from-buffer (current-buffer))) - (hl-line-mode 1) - (save-excursion - (insert "foo")) - (hl-line-highlight) - (should (cl-some (apply-partially #'eq hl-line--overlay) - (overlays-at (point)))) - (switch-to-buffer (get-buffer-create "*scratch*")) - (hl-line-mode 1) - (save-excursion - (insert "bar")) - (hl-line-highlight) - (should (cl-some (apply-partially #'eq hl-line--overlay) - (overlays-at (point)))) - (should (buffer-local-value 'hl-line--overlay from-buffer)) - (should-not (eq (buffer-local-value 'hl-line--overlay from-buffer) - hl-line--overlay)) - (customize-set-variable 'hl-line-sticky-flag nil) - (should hl-line--overlay) - (should (buffer-live-p from-buffer)) - (should-not (buffer-local-value 'hl-line--overlay from-buffer))))) +(defsubst hl-line-tests-verify (_label on-p) + (eq on-p (cl-some (apply-partially #'eq hl-line--overlay) + (overlays-at (point))))) + +(ert-deftest hl-line-tests-sticky-across-frames () + (skip-unless (display-graphic-p)) + (customize-set-variable 'hl-line-sticky-flag t) + (call-interactively #'global-hl-line-mode) + (let ((first-frame (selected-frame)) + (first-buffer "foo") + (second-buffer "bar") + second-frame) + (unwind-protect + (progn + (switch-to-buffer first-buffer) + (save-excursion + (insert (buffer-name))) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 111 t)) + (select-frame (setq second-frame (make-frame))) + (switch-to-buffer second-buffer) + (save-excursion + (insert (buffer-name))) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 762 t)) + (with-current-buffer first-buffer + (should (hl-line-tests-verify 534 t))) + (call-interactively #'global-hl-line-mode) + (should (hl-line-tests-verify 125 nil)) + (with-current-buffer first-buffer + (should (hl-line-tests-verify 892 nil))) + + ;; now do unsticky + (customize-set-variable 'hl-line-sticky-flag nil) + (call-interactively #'global-hl-line-mode) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 467 t)) + (with-current-buffer first-buffer + (should (hl-line-tests-verify 765 nil))) + (select-frame first-frame) + (should (equal (buffer-name) first-buffer)) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 423 t)) + (with-current-buffer second-buffer + (should (hl-line-tests-verify 897 nil)))) + (let (kill-buffer-query-functions) + (ignore-errors (kill-buffer first-buffer)) + (ignore-errors (kill-buffer second-buffer)) + (ignore-errors (delete-frame second-frame)))))) + +(ert-deftest hl-line-tests-sticky () + (customize-set-variable 'hl-line-sticky-flag t) + (let ((first-buffer "foo") + (second-buffer "bar")) + (unwind-protect + (progn + (switch-to-buffer first-buffer) + (hl-line-mode 1) + (save-excursion + (insert (buffer-name))) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 123 t)) + (switch-to-buffer second-buffer) + (hl-line-mode 1) + (save-excursion + (insert (buffer-name))) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 56 t)) + (with-current-buffer first-buffer + (should (hl-line-tests-verify 67 t))) + + ;; now do unsticky + (customize-set-variable 'hl-line-sticky-flag nil) + (should (hl-line-tests-verify 234 t)) + (with-current-buffer first-buffer + (should (hl-line-tests-verify 231 nil))) + (switch-to-buffer first-buffer) + (run-hooks 'post-command-hook) + (should (hl-line-tests-verify 257 t)) + (with-current-buffer second-buffer + (should (hl-line-tests-verify 999 nil))))) + (let (kill-buffer-query-functions) + (ignore-errors (kill-buffer first-buffer)) + (ignore-errors (kill-buffer second-buffer))))) (provide 'hl-line-tests) -- 2.26.2