master 2716dd13ced 15/15: Decouple keep-place-indicator from global ERC module

[F. Jason Park]

branch: master
commit 2716dd13cedb41f677be6481414a9710dfcc1857
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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