From 3054e70d76f71876c58497db04f55d7f413663d9 Mon Sep 17 00:00:00 2001 From: dickmao Date: Tue, 22 Mar 2022 15:59:11 +0100 Subject: [PATCH] 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). --- lisp/hl-line.el | 32 +++++++---- 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 @@ ;;; 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 + "Used to track last buffer.") ;; 1. define-minor-mode creates buffer-local hl-line--overlay ;; 2. overlay wiped by kill-all-local-variables @@ -68,6 +77,7 @@ :type 'boolean :version "22.1" :group 'hl-line + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (unless value @@ -100,14 +110,12 @@ Currently used in calendar/todo-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 +128,12 @@ Currently used in calendar/todo-mode." (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/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.39.5