From 2716dd13cedb41f677be6481414a9710dfcc1857 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 12 Jul 2023 23:53:06 -0700 Subject: [PATCH] Decouple keep-place-indicator from global ERC module * etc/ERC-NEWS: Let users know that `keep-place-indicator' is a wholly separate module from `keep-place'. * lisp/erc/erc-goodies.el (erc-keep-place-indicator-setup): Perform some housekeeping on `erc-keep-place-mode'. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable, erc-keep-place-indicator-disable): Take precautions to work around the activation state of global module `keep-place', but no longer depend on it. (erc--keep-place-indicator-on-global-module): New function to ensure `erc-keep-place' runs exactly once on `erc-insert-pre-hook', regardless of whether module `keep-place' is active. * test/lisp/erc/erc-goodies-tests.el (erc-goodies-tests--assert-kp-indicator-on, erc-goodies-tests--assert-kp-indicator-off, erc-goodies-tests--kp-indicator-populate, erc-goodies-tests--keep-place-indicator): New helper functions. (erc-keep-place-indicator-mode, erc-keep-place-indicator-mode--no-global): Factor out some common logic and rename former to latter. (erc-keep-place-indicator-mode--global): New test. (Bug#59943) --- etc/ERC-NEWS | 7 +- lisp/erc/erc-goodies.el | 40 +++-- test/lisp/erc/erc-goodies-tests.el | 226 +++++++++++++++++++++-------- 3 files changed, 192 insertions(+), 81 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 65fee9e05cd..cd0b8e5f823 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -14,13 +14,12 @@ GNU Emacs since Emacs version 22.1. * Changes in ERC 5.6 -** Module 'keep-place' now offers a visual indicator. +** Module 'keep-place' has gained a more flamboyant cousin. Remember your place in ERC buffers a bit more easily while retaining the freedom to look around. Optionally sync the indicator to any progress made when you haven't yet caught up to the live stream. See -options 'erc-keep-place-indicator-style' and friends and new module -'keep-place-indicator', which for now must be added manually to -'erc-modules'. +options 'erc-keep-place-indicator-style' and friends, and try M-x +keep-place-indicator-mode to see it in action. ** Module 'fill' now offers a style based on 'visual-line-mode'. This fill style mimics the "hanging indent" look of 'erc-fill-static' diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 96083de2c22..d9ededa8e68 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -208,6 +208,8 @@ the active frame." (require 'fringe) (erc--restore-initialize-priors erc-keep-place-indicator-mode erc--keep-place-indicator-overlay (make-overlay 0 0)) + (add-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module nil t) (add-hook 'window-configuration-change-hook #'erc--keep-place-indicator-on-window-configuration-change nil t) (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) @@ -223,27 +225,39 @@ the active frame." ;;;###autoload(put 'keep-place-indicator 'erc--feature 'erc-goodies) (define-erc-module keep-place-indicator nil - "`keep-place' with a fringe arrow and/or highlighted face." - ((unless erc-keep-place-mode - (unless (memq 'keep-place erc-modules) - (erc--warn-once-before-connect 'erc-keep-place-mode - "Local module `keep-place-indicator' needs module `keep-place'." - " Enabling now. This will affect \C-]all\C-] ERC sessions." - " Add `keep-place' to `erc-modules' to silence this message.")) - (erc-keep-place-mode +1)) + "Buffer-local `keep-place' with fringe arrow and/or highlighted face. +Play nice with global module `keep-place' but don't depend on it. +Expect that users may want different combinations of `keep-place' +and `keep-place-indicator' in different buffers." + ((cond (erc-keep-place-mode) + ((memq 'keep-place erc-modules) + (erc-keep-place-mode +1)) + ;; Enable a local version of `keep-place-mode'. + (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t))) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) ('t t)) (erc--keep-place-indicator-setup) - (setq erc-keep-place-indicator-mode nil))) + (erc-keep-place-indicator-mode -1))) ((when erc--keep-place-indicator-overlay - (delete-overlay erc--keep-place-indicator-overlay) - (remove-hook 'window-configuration-change-hook - #'erc--keep-place-indicator-on-window-configuration-change t) - (kill-local-variable 'erc--keep-place-indicator-overlay))) + (delete-overlay erc--keep-place-indicator-overlay)) + (remove-hook 'window-configuration-change-hook + #'erc--keep-place-indicator-on-window-configuration-change t) + (remove-hook 'erc-keep-place-mode-hook + #'erc--keep-place-indicator-on-global-module t) + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) + (kill-local-variable 'erc--keep-place-indicator-overlay)) 'local) +(defun erc--keep-place-indicator-on-global-module () + "Ensure `keep-place-indicator' can cope with `erc-keep-place-mode'. +That is, ensure the local module can survive a user toggling the +global one." + (if erc-keep-place-mode + (remove-hook 'erc-insert-pre-hook #'erc-keep-place t) + (add-hook 'erc-insert-pre-hook #'erc-keep-place 90 t))) + (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. For use with `keep-place-indicator' module. When called diff --git a/test/lisp/erc/erc-goodies-tests.el b/test/lisp/erc/erc-goodies-tests.el index 7acacb319f1..cdf861e2018 100644 --- a/test/lisp/erc/erc-goodies-tests.el +++ b/test/lisp/erc/erc-goodies-tests.el @@ -245,81 +245,179 @@ ;; minor-mode toggle is allowed to disable its mode variable as ;; needed. -(ert-deftest erc-keep-place-indicator-mode () +(defun erc-goodies-tests--assert-kp-indicator-on () + (should erc--keep-place-indicator-overlay) + (should (local-variable-p 'window-configuration-change-hook)) + (should window-configuration-change-hook) + (should (memq 'erc-keep-place erc-insert-pre-hook)) + (should (eq erc-keep-place-mode + (not (local-variable-p 'erc-insert-pre-hook))))) + +(defun erc-goodies-tests--assert-kp-indicator-off () + (should-not (local-variable-p 'erc-insert-pre-hook)) + (should-not (local-variable-p 'window-configuration-change-hook)) + (should-not erc--keep-place-indicator-overlay)) + +(defun erc-goodies-tests--kp-indicator-populate () + (erc-display-message nil 'notice (current-buffer) + "This buffer is for text that is not saved") + (erc-display-message nil 'notice (current-buffer) + "and for lisp evaluation") + (should (search-forward "saved" nil t)) + (erc-keep-place-move nil) + (goto-char erc-input-marker)) + +(defun erc-goodies-tests--keep-place-indicator (test) (with-current-buffer (get-buffer-create "*erc-keep-place-indicator-mode*") (erc-mode) (erc--initialize-markers (point) nil) (setq erc-server-process (start-process "sleep" (current-buffer) "sleep" "1")) (set-process-query-on-exit-flag erc-server-process nil) - (let ((assert-off - (lambda () - (should-not erc-keep-place-indicator-mode) - (should-not (local-variable-p 'window-configuration-change-hook)) - (should-not erc--keep-place-indicator-overlay))) - (assert-on - (lambda () - (should erc--keep-place-indicator-overlay) - (should (local-variable-p 'window-configuration-change-hook)) - (should window-configuration-change-hook) - (should erc-keep-place-mode))) - ;; - erc-insert-pre-hook - erc-connect-pre-hook + (let (erc-connect-pre-hook erc-modules) - (funcall assert-off) + (ert-info ("Clean slate") + (erc-goodies-tests--assert-kp-indicator-off) + (should-not erc-keep-place-mode) + (should-not (memq 'keep-place erc-modules))) - (ert-info ("Value t") - (should (eq erc-keep-place-indicator-buffer-type t)) - (erc-keep-place-indicator-mode +1) - (funcall assert-on) - (goto-char (point-min)) - (should (search-forward "Enabling" nil t)) - (should (memq 'keep-place erc-modules))) - - (erc-keep-place-indicator-mode -1) - (funcall assert-off) - - (ert-info ("Value `target'") - (let ((erc-keep-place-indicator-buffer-type 'target)) - (erc-keep-place-indicator-mode +1) - (funcall assert-off) - (setq erc--target (erc--target-from-string "#chan")) - (erc-keep-place-indicator-mode +1) - (funcall assert-on))) - - (erc-keep-place-indicator-mode -1) - (funcall assert-off) - - (ert-info ("Value `server'") - (let ((erc-keep-place-indicator-buffer-type 'server)) - (erc-keep-place-indicator-mode +1) - (funcall assert-off) - (setq erc--target nil) - (erc-keep-place-indicator-mode +1) - (funcall assert-on))) - - ;; Populate buffer - (erc-display-message nil 'notice (current-buffer) - "This buffer is for text that is not saved") - (erc-display-message nil 'notice (current-buffer) - "and for lisp evaluation") - (should (search-forward "saved" nil t)) - (erc-keep-place-move nil) - (goto-char erc-input-marker) - - (ert-info ("Indicator survives reconnect") - (let ((erc--server-reconnecting (buffer-local-variables))) - (cl-letf (((symbol-function 'erc-server-connect) #'ignore)) - (erc-open "localhost" 6667 "tester" "Tester" 'connect - nil nil nil nil nil "tester" nil))) - (funcall assert-on) - (should (= (point) erc-input-marker)) - (goto-char (overlay-start erc--keep-place-indicator-overlay)) - (should (looking-at (rx "*** This buffer is for text"))))) + (funcall test)) (when noninteractive + (erc-keep-place-indicator-mode -1) + (erc-keep-place-mode -1) + (should-not (member 'erc-keep-place + (default-value 'erc-insert-pre-hook))) + (should-not (local-variable-p 'erc-insert-pre-hook)) (kill-buffer)))) +(ert-deftest erc-keep-place-indicator-mode--no-global () + (erc-goodies-tests--keep-place-indicator + (lambda () + + (ert-info ("Value t") + (should (eq erc-keep-place-indicator-buffer-type t)) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on) + (goto-char (point-min))) + + (erc-keep-place-indicator-mode -1) + (erc-goodies-tests--assert-kp-indicator-off) + + (ert-info ("Value `target'") + (let ((erc-keep-place-indicator-buffer-type 'target)) + ;; No-op because server buffer. + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-off) + ;; Spoof target buffer (no longer no-op). + (setq erc--target (erc--target-from-string "#chan")) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on))) + + (erc-keep-place-indicator-mode -1) + (erc-goodies-tests--assert-kp-indicator-off) + + (ert-info ("Value `server'") + (let ((erc-keep-place-indicator-buffer-type 'server)) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-off) + (setq erc--target nil) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on))) + + ;; Populate buffer + (erc-goodies-tests--kp-indicator-populate) + + (ert-info ("Indicator survives reconnect") + (let ((erc--server-reconnecting (buffer-local-variables))) + (cl-letf (((symbol-function 'erc-server-connect) #'ignore)) + (erc-open "localhost" 6667 "tester" "Tester" 'connect + nil nil nil nil nil "tester" nil))) + (erc-goodies-tests--assert-kp-indicator-on) + (should (= (point) erc-input-marker)) + (goto-char (overlay-start erc--keep-place-indicator-overlay)) + (should (looking-at (rx "*** This buffer is for text"))))))) + +(ert-deftest erc-keep-place-indicator-mode--global () + (erc-goodies-tests--keep-place-indicator + (lambda () + + (push 'keep-place erc-modules) + + (ert-info ("Value t") + (should (eq erc-keep-place-indicator-buffer-type t)) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on) + ;; Local module activates global `keep-place'. + (should erc-keep-place-mode) + ;; Does not register local version of hook (otherwise would run + ;; twice). + (should-not (local-variable-p 'erc-insert-pre-hook)) + (goto-char (point-min))) + + (erc-keep-place-indicator-mode -1) + (erc-goodies-tests--assert-kp-indicator-off) + (should erc-keep-place-mode) + (should (member 'erc-keep-place erc-insert-pre-hook)) + + (ert-info ("Value `target'") + (let ((erc-keep-place-indicator-buffer-type 'target)) + ;; No-op because server buffer. + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-off) + ;; Does not interfere with global activation state. + (should erc-keep-place-mode) + (should (member 'erc-keep-place erc-insert-pre-hook)) + ;; Morph into a target buffer (no longer no-op). + (setq erc--target (erc--target-from-string "#chan")) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on) + ;; Does not register local version of hook. + (should-not (local-variable-p 'erc-insert-pre-hook)))) + + (erc-keep-place-indicator-mode -1) + (erc-goodies-tests--assert-kp-indicator-off) + (should erc-keep-place-mode) + (should (member 'erc-keep-place erc-insert-pre-hook)) + + (ert-info ("Value `server'") + (let ((erc-keep-place-indicator-buffer-type 'server)) + ;; No-op because we're now a target buffer. + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-off) + (should erc-keep-place-mode) + (should (member 'erc-keep-place erc-insert-pre-hook)) + ;; Back to server. + (setq erc--target nil) + (erc-keep-place-indicator-mode +1) + (erc-goodies-tests--assert-kp-indicator-on) + (should-not (local-variable-p 'erc-insert-pre-hook)))) + + (ert-info ("Local adapts to global toggle") + (erc-keep-place-mode -1) + (should-not (member 'erc-keep-place + (default-value 'erc-insert-pre-hook))) + (should (member 'erc-keep-place erc-insert-pre-hook)) + (erc-goodies-tests--assert-kp-indicator-on) + (erc-keep-place-mode +1) + (should (member 'erc-keep-place (default-value 'erc-insert-pre-hook))) + (should-not (local-variable-p 'erc-insert-pre-hook)) + (erc-goodies-tests--assert-kp-indicator-on)) + + ;; Populate buffer + (erc-goodies-tests--kp-indicator-populate) + + (ert-info ("Indicator survives reconnect") + (let ((erc--server-reconnecting (buffer-local-variables))) + (cl-letf (((symbol-function 'erc-server-connect) #'ignore)) + (erc-open "localhost" 6667 "tester" "Tester" 'connect + nil nil nil nil nil "tester" nil))) + (erc-goodies-tests--assert-kp-indicator-on) + (should erc-keep-place-mode) + (should (member 'erc-keep-place erc-insert-pre-hook)) + (should (= (point) erc-input-marker)) + (goto-char (overlay-start erc--keep-place-indicator-overlay)) + (should (looking-at (rx "*** This buffer is for text"))))))) + ;;; erc-goodies-tests.el ends here -- 2.39.2