From 0a094fb65ca1392231ef8176f89f936e39f3296e Mon Sep 17 00:00:00 2001 From: dickmao Date: Sun, 20 Mar 2022 11:34:56 -0400 Subject: Rewrite hl-line-mode The fashion of dual global and minor modes, each managing a replica of state, has long been outmoded by globalized minor modes (nee easy-mmode-define-global-mode) around the turn of the century. * lisp/calendar/todo-mode.el (todo-toggle-item-highlighting, todo-hl-line-range, todo-modes-set-2): Adapt to new hl-line-highlight-hook. * lisp/hl-line.el (hl-line-overlay): Rename hl-line--overlay. (global-hl-line-overlay, global-hl-line-overlays, global-hl-line-sticky-flag, hl-line-overlay-buffer, hl-line-range-function): Obsolesce. (hl-line--overlay): Erstwhile hl-line-overlay. (hl-line, hl-line-face): Consolidate. (hl-line-sticky-flag): Say less (Gen Z Hospital). (hl-line-overlay-priority): Make this a custom. (hl-line-highlight-hook): Prefer hook over specialized hl-line-range-function. (hl-line-mode): Say less (Gen Z Hospital). (hl-line-make-overlay): Remove (hl-line-highlight, hl-line-unhighlight): Rewrite. (hl-line-maybe-unhighlight): Remove. (hl-line-turn-on): Necessary for globalized minor mode. (global-hl-line-mode, global-hl-line-highlight, global-hl-line-highlight-all, global-hl-line-unhighlight, global-hl-line-maybe-unhighlight, global-hl-line-unhighlight-all): Prefer globalized minor mode. (hl-line-move, hl-line-unload-function): Remove. * 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): Adapt to consolidated face. --- test/lisp/hl-line-tests.el | 51 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 test/lisp/hl-line-tests.el (limited to 'test/lisp/hl-line-tests.el') diff --git a/test/lisp/hl-line-tests.el b/test/lisp/hl-line-tests.el new file mode 100644 index 00000000000..422d4ddae7d --- /dev/null +++ b/test/lisp/hl-line-tests.el @@ -0,0 +1,51 @@ +;;; hl-line-tests.el --- Test suite for hl-line. -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: +(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))))) + +(provide 'hl-line-tests) + +;;; hl-line-tests.el ends here -- cgit v1.2.3 From 3054e70d76f71876c58497db04f55d7f413663d9 Mon Sep 17 00:00:00 2001 From: dickmao Date: Tue, 22 Mar 2022 15:59:11 +0100 Subject: 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(-) (limited to 'test/lisp/hl-line-tests.el') 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) -- cgit v1.2.3 From 5811741eda764f4711031c90d2e7a3727f27d8a9 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Wed, 23 Mar 2022 20:25:33 +0800 Subject: Fix hl-line tests * lisp/hl-line.el (hl-line-mode): Restore old setter. * test/lisp/hl-line-tests.el (hl-line-tests-verify): Don't rely `cl-some' always returning t on success. (hl-line-tests-sticky-across-frames): Use correct global variable. --- lisp/hl-line.el | 10 +++++++++- test/lisp/hl-line-tests.el | 9 ++++++--- 2 files changed, 15 insertions(+), 4 deletions(-) (limited to 'test/lisp/hl-line-tests.el') diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 20b3f4160fd..e42d1d97d9d 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -102,7 +102,15 @@ This variable has no effect in Global Highlight Line mode. For that, use `global-hl-line-sticky-flag'." :type 'boolean :version "22.1" - :group 'hl-line) + :group 'hl-line + :set (lambda (symbol value) + (set-default symbol value) + (unless value + (let ((selected (window-buffer (selected-window)))) + (dolist (buffer (buffer-list)) + (unless (eq buffer selected) + (with-current-buffer buffer + (hl-line-unhighlight)))))))) (defcustom global-hl-line-sticky-flag nil "Non-nil means the Global HL-Line mode highlight appears in all windows. diff --git a/test/lisp/hl-line-tests.el b/test/lisp/hl-line-tests.el index 6bff09135b2..888351addac 100644 --- a/test/lisp/hl-line-tests.el +++ b/test/lisp/hl-line-tests.el @@ -22,12 +22,15 @@ (require 'hl-line) (defsubst hl-line-tests-verify (_label on-p) - (eq on-p (cl-some (apply-partially #'eq hl-line--overlay) - (overlays-at (point))))) + (if on-p + (cl-some (apply-partially #'eq hl-line-overlay) + (overlays-at (point))) + (not (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) + (customize-set-variable 'global-hl-line-sticky-flag t) (call-interactively #'global-hl-line-mode) (let ((first-frame (selected-frame)) (first-buffer "foo") -- cgit v1.2.3