From: dick <dick.r.chiang@gmail.com>
To: Michael Heerdegen <michael_heerdegen@web.de>
Cc: 54481@debbugs.gnu.org
Subject: bug#54481: 29.0.50; [PATCH] Rewrite hl-line
Date: Tue, 22 Mar 2022 10:12:30 -0400 [thread overview]
Message-ID: <87bkxy3wkx.fsf@dick> (raw)
In-Reply-To: <87lex2vfux.fsf@web.de> (Michael Heerdegen's message of "Tue, 22 Mar 2022 04:13:58 +0100")
[-- Attachment #1: Type: text/plain, Size: 63 bytes --]
I seem to have broken hl-line-sticky-flag. Sorry about that.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-I-broke-hl-line-sticky-flag.patch --]
[-- Type: text/x-diff, Size: 11056 bytes --]
From 27d1629000236f036988a0cbc768e71846880775 Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@gmail.com>
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
next prev parent reply other threads:[~2022-03-22 14:12 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-03-20 15:52 bug#54481: 29.0.50; [PATCH] Rewrite hl-line dick
2022-03-21 15:09 ` Lars Ingebrigtsen
2022-03-22 0:25 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-03-23 8:48 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-03-23 11:35 ` dick
2022-03-23 11:55 ` Lars Ingebrigtsen
2022-03-23 13:02 ` Eli Zaretskii
2022-03-22 3:13 ` Michael Heerdegen
2022-03-22 14:12 ` dick [this message]
2022-03-22 14:12 ` dick
2022-03-22 14:59 ` Lars Ingebrigtsen
2022-03-22 14:14 ` Lars Ingebrigtsen
2022-03-22 14:24 ` dick
2022-03-22 14:35 ` Lars Ingebrigtsen
2022-03-23 2:21 ` Michael Heerdegen
2022-03-24 3:23 ` Michael Heerdegen
2022-03-24 3:39 ` Michael Heerdegen
2022-03-24 3:53 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-03-24 4:42 ` Michael Heerdegen
2022-03-24 4:55 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-03-24 5:13 ` Michael Heerdegen
2022-03-24 5:51 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-03-25 3:45 ` Michael Heerdegen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87bkxy3wkx.fsf@dick \
--to=dick.r.chiang@gmail.com \
--cc=54481@debbugs.gnu.org \
--cc=michael_heerdegen@web.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.