master 2e18ba6302f 07/14: Simplify erc-button movement commands

[F. Jason Park]

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

    Simplify erc-button movement commands
    
    * etc/ERC-NEWS: Mention TAB being bound to new command `erc-tab' and
    `erc-previous-button' now stopping at the start of buttons.
    * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable,
    erc-button-disable): Add and remove `erc-button-next' to
    `erc--tab-functions' hook, which is tantamount to binding the command
    in the read-only area of an ERC buffer.
    (erc-button-next-function): Deprecate and remove from client code path
    because this module doesn't concern itself with prompt input and thus
    no longer needs to conform to the `completion-at-point-functions'
    interface.
    (erc-button--prev-next-predicate-functions): New variable, a hook to
    determine whether to continue searching for a button.  Other modules
    should utilize this as needed.
    (erc-button--end-of-button-p): Add function to serve as default value
    for `erc-button--continue-predicate'.
    (erc--button-next): Add generalized button-movement function.
    (erc-button-next, erc-button-previous): Make `erc-button-previous'
    behave more predictably by having it land at the beginning of buttons.
    And remove roundabout appeal to HOF in `erc-button-next'.
    (erc-button-previous-of-nick): New command to jump to previous
    appearance of nick at point.
    * lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable,
    erc-fill-wrap-disable): Add and remove merge-related hookee from
    `erc-button--prev-next-predicate-functions'.
    (erc-fill--wrap-merged-button-p): New function to detect redundant
    speakers.
    * lisp/erc/erc.el (erc-complete-functions): Quote TAB in doc string.
    (erc-mode-map): Bind `erc-tab' to TAB.
    (erc--tab-functions, erc-tab): Add new command and hook to serve as
    unified dispatch for TAB-related operations.  It calls `c-a-p' in the
    input area and defers to module code in the read-only message area.
    * test/lisp/erc/erc-button-tests.el: New file.
    * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Run
    finalizer for transient keymap timer.
    * test/lisp/erc/erc-tests.el
    (erc-button--display-error-notice-with-keys): Move to new dedicated
    test file for erc-button and fix expected behavior of
    `erc-button-previous'.  (Bug#62834)
---
 etc/ERC-NEWS                      |  18 ++--
 lisp/erc/erc-button.el            |  93 +++++++++++++++-----
 lisp/erc/erc-fill.el              |  10 ++-
 lisp/erc/erc.el                   |  17 +++-
 test/lisp/erc/erc-button-tests.el | 177 ++++++++++++++++++++++++++++++++++++++
 test/lisp/erc/erc-fill-tests.el   |   2 +
 test/lisp/erc/erc-tests.el        |  61 -------------
 7 files changed, 284 insertions(+), 94 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 57dce501760..2cf2743701a 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -128,9 +128,10 @@ renamed 'erc-ensure-target-buffer-on-privmsg'.
 Some minor quality-of-life niceties have finally made their way to
 ERC.  For example, the function 'erc-echo-timestamp' is now
 interactive and can be invoked on any message to view its timestamp in
-the echo area.  Also, the 'irccontrols' module now supports additional
-colors and special handling for "spoilers" (hidden text).  And issuing
-an "/MOTD" now dispatches a purpose-built command handler.
+the echo area.  The command 'erc-button-previous' now moves to the
+beginning instead of the end of buttons.  And the 'irccontrols' module
+now supports additional colors and special handling for "spoilers"
+(hidden text).
 
 ** Changes in the library API.
 
@@ -199,10 +200,13 @@ example, requiring the use of 'insert-before-markers' 
instead of
 changes are encouraged to voice their concerns on the bug list.
 
 *** Miscellaneous changes
-For autoloading purposes, 'Info-goto-node' has been supplanted by
-plain old 'info' in 'erc-button-alist', and two helper macros from GNU
-ELPA's Compat library are now available to third-party modules as
-'erc-compat-call' and 'erc-compat-function'.
+Two helper macros from GNU ELPA's Compat library are now available to
+third-party modules as 'erc-compat-call' and 'erc-compat-function'.
+In the area of buttons, 'Info-goto-node' has been supplanted by plain
+old 'info' in 'erc-button-alist', primarily for autoloading purposes.
+And the "TAB" key is now bound to a new command, 'erc-tab', that only
+calls 'completion-at-point' when point is in the input area and
+module-specific commands, like 'erc-button-next', otherwise.
 
 
 * Changes in ERC 5.5
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 33e69f3b0b8..e2447deecde 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -55,11 +55,11 @@
   ((erc-button--check-nicknames-entry)
    (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append)
    (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append)
-   (add-hook 'erc-complete-functions #'erc-button-next-function)
+   (add-hook 'erc--tab-functions #'erc-button-next)
    (erc--modify-local-map t "<backtab>" #'erc-button-previous))
   ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons)
    (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons)
-   (remove-hook 'erc-complete-functions #'erc-button-next-function)
+   (remove-hook 'erc--tab-functions #'erc-button-next)
    (erc--modify-local-map nil "<backtab>" #'erc-button-previous)))
 
 ;;; Variables
@@ -529,6 +529,7 @@ call it with the value of the `erc-data' text property."
 (defun erc-button-next-function ()
   "Pseudo completion function that actually jumps to the next button.
 For use on `completion-at-point-functions'."
+  (declare (obsolete erc-nickserv-identify "30.1"))
   ;; FIXME: This is an abuse of completion-at-point-functions.
   (when (< (point) (erc-beg-of-input-line))
     (let ((start (point)))
@@ -546,27 +547,73 @@ For use on `completion-at-point-functions'."
             (error "No next button"))
           t)))))
 
-(defun erc-button-next ()
-  "Go to the next button in this buffer."
-  (interactive)
-  (let ((f (erc-button-next-function)))
-    (if f (funcall f))))
-
-(defun erc-button-previous ()
-  "Go to the previous button in this buffer."
-  (interactive)
-  (let ((here (point)))
-    (when (< here (erc-beg-of-input-line))
-      (while (and (get-text-property here 'erc-callback)
-                  (not (= here (point-min))))
-        (setq here (1- here)))
-      (while (and (not (get-text-property here 'erc-callback))
-                  (not (= here (point-min))))
-        (setq here (1- here)))
-      (if (> here (point-min))
-          (goto-char here)
-        (error "No previous button"))
-      t)))
+(defvar erc-button--prev-next-predicate-functions
+  '(erc-button--end-of-button-p)
+  "Abnormal hook whose members can return non-nil to continue searching.
+Otherwise, if all members return nil, point will stay at the
+current button.  Called with a single arg, a buffer position
+greater than `point-min' with a text property of `erc-callback'.")
+
+(defun erc-button--end-of-button-p (point)
+  (get-text-property (1- point) 'erc-callback))
+
+(defun erc--button-next (arg)
+  (let* ((nextp (prog1 (>= arg 1) (setq arg (max 1 (abs arg)))))
+         (search-fn (if nextp
+                        #'next-single-char-property-change
+                      #'previous-single-char-property-change))
+         (start (point))
+         (p start))
+    (while (progn
+             ;; Break out of current search context.
+             (when-let ((low (max (point-min) (1- (pos-bol))))
+                        (high (min (point-max) (1+ (pos-eol))))
+                        (prop (get-text-property p 'erc-callback))
+                        (q (if nextp
+                               (text-property-not-all p high
+                                                      'erc-callback prop)
+                             (funcall search-fn p 'erc-callback nil low)))
+                        ((< low q high)))
+               (setq p q))
+             ;; Assume that buttons occur frequently enough that
+             ;; omitting LIMIT is acceptable.
+             (while
+                 (and (setq p (funcall search-fn p 'erc-callback))
+                      (if nextp (< p erc-insert-marker) (/= p (point-min)))
+                      (run-hook-with-args-until-success
+                       'erc-button--prev-next-predicate-functions p)))
+             (and arg
+                  (< (point-min) p erc-insert-marker)
+                  (goto-char p)
+                  (not (zerop (cl-decf arg))))))
+    (when (= (point) start)
+      (user-error (if nextp "No next button" "No previous button")))
+    t))
+
+(defun erc-button-next (&optional arg)
+  "Go to the ARGth next button."
+  (declare (advertised-calling-convention (arg) "30.1"))
+  (interactive "p")
+  (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
+  (erc--button-next arg))
+
+(defun erc-button-previous (&optional arg)
+  "Go to ARGth previous button."
+  (declare (advertised-calling-convention (arg) "30.1"))
+  (interactive "p")
+  (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg)))
+  (erc--button-next (- arg)))
+
+(defun erc-button-previous-of-nick (arg)
+  "Go to ARGth previous button for nick at point."
+  (interactive "p")
+  (if-let* ((prop (get-text-property (point) 'erc-data))
+            (erc-button--prev-next-predicate-functions
+             (cons (lambda (p)
+                     (not (equal (get-text-property p 'erc-data) prop)))
+                   erc-button--prev-next-predicate-functions)))
+      (erc--button-next (- arg))
+    (user-error "No nick at point")))
 
 (defun erc-browse-emacswiki (thing)
   "Browse to THING in the emacs-wiki."
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index a56134d8188..bf995a5a5e6 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -300,7 +300,9 @@ of the minor-mode toggles as usual."
            (setq msg (concat msg (and msg " ")
                              (erc-fill--make-module-dependency-msg "button"))))
          (erc-with-server-buffer
-           (erc-button-mode +1))))
+           (erc-button-mode +1)))
+       (add-hook 'erc-button--prev-next-predicate-functions
+                 #'erc-fill--wrap-merged-button-p nil t))
      ;; Set local value of user option (can we avoid this somehow?)
      (unless (eq erc-fill-function #'erc-fill-wrap)
        (setq-local erc-fill-function #'erc-fill-wrap))
@@ -328,6 +330,8 @@ of the minor-mode toggles as usual."
    (kill-local-variable 'erc-fill--wrap-value)
    (kill-local-variable 'erc-fill-function)
    (kill-local-variable 'erc-fill--wrap-visual-keys)
+   (remove-hook 'erc-button--prev-next-predicate-functions
+                #'erc-fill--wrap-merged-button-p t)
    (remove-function (local 'erc-stamp--insert-date-function)
                     #'erc-fill--wrap-stamp-insert-prefixed-date)
    (visual-line-mode -1))
@@ -414,6 +418,10 @@ See `erc-fill-wrap-mode' for details."
                                `((space :width (- erc-fill--wrap-value ,len))
                                  (space :width erc-fill--wrap-value))))))
 
+;; FIXME use own text property to avoid false positives.
+(defun erc-fill--wrap-merged-button-p (point)
+  (equal "" (get-text-property point 'display)))
+
 ;; This is an experimental helper for third-party modules.  You could,
 ;; for example, use this to automatically resize the prefix to a
 ;; fraction of the window's width on some event change.  Another use
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 05b6b5bfd21..a439e2438b0 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -354,7 +354,7 @@ simply because we do not necessarily receive the QUIT 
event."
   :type 'hook)
 
 (defcustom erc-complete-functions nil
-  "These functions get called when the user hits TAB in ERC.
+  "These functions get called when the user hits \\`TAB' in ERC.
 Each function in turn is called until one returns non-nil to
 indicate it has handled the input."
   :group 'erc-hooks
@@ -1231,7 +1231,7 @@ which the local user typed."
     (define-key map "\C-c\C-u" #'erc-kill-input)
     (define-key map "\C-c\C-x" #'erc-quit-server)
     (define-key map "\M-\t" #'ispell-complete-word)
-    (define-key map "\t" #'completion-at-point)
+    (define-key map "\t" #'erc-tab)
 
     ;; Suppress `font-lock-fontify-block' key binding since it
     ;; destroys face properties.
@@ -4675,6 +4675,19 @@ This places `point' just after the prompt, or at the 
beginning of the line."
         (setq erc-input-ring-index nil))
     (kill-line)))
 
+(defvar erc--tab-functions nil
+  "Functions to try when user hits \\`TAB' outside of input area.
+Called with a numeric prefix arg.")
+
+(defun erc-tab (&optional arg)
+  "Call `completion-at-point' when typing in the input area.
+Otherwise call members of `erc--tab-functions' with raw prefix
+ARG until one of them returns non-nil."
+  (interactive "P")
+  (if (>= (point) erc-input-marker)
+      (completion-at-point)
+    (run-hook-with-args-until-success 'erc--tab-functions arg)))
+
 (defun erc-complete-word-at-point ()
   (run-hook-with-args-until-success 'erc-complete-functions))
 
diff --git a/test/lisp/erc/erc-button-tests.el 
b/test/lisp/erc/erc-button-tests.el
new file mode 100644
index 00000000000..ced08d117bc
--- /dev/null
+++ b/test/lisp/erc/erc-button-tests.el
@@ -0,0 +1,177 @@
+;;; erc-button-tests.el --- Tests for erc-button  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'erc-button)
+
+(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts)
+  (declare (indent 1))
+  (let ((msg (erc-format-privmessage speaker
+                                     (apply #'concat msg-parts) nil t)))
+    (erc-display-message nil nil (current-buffer) msg)))
+
+(defun erc-button-tests--populate (test)
+  (let ((inhibit-message noninteractive)
+        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+    (with-current-buffer
+        (cl-letf
+            (((symbol-function 'erc-server-connect)
+              (lambda (&rest _)
+                (setq erc-server-process
+                      (start-process "sleep" (current-buffer) "sleep" "1"))
+                (set-process-query-on-exit-flag erc-server-process nil))))
+
+          (erc-open "localhost" 6667 "tester" "Tester" 'connect
+                    nil nil nil nil nil "tester" 'foonet))
+
+      (with-current-buffer (erc--open-target "#chan")
+        (erc-update-channel-member
+         "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+        (erc-update-channel-member
+         "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+        (erc-display-message
+         nil 'notice (current-buffer)
+         (concat "This server is in debug mode and is logging all user I/O. "
+                 "Blah alice (1) bob (2) blah."))
+
+        (funcall test))
+
+      (when noninteractive
+        (kill-buffer "#chan")
+        (kill-buffer)))))
+
+(ert-deftest erc-button-next ()
+  (erc-button-tests--populate
+   (lambda ()
+     (erc-button-tests--insert-privmsg "alice"
+       "(3) bob (4) come, you are a tedious fool: to the purpose.")
+
+     (erc-button-tests--insert-privmsg "bob"
+       "(5) alice (6) Come me to what was done to her.")
+
+     (should (= erc-input-marker (point)))
+
+     ;; Break out of input area
+     (erc-button-previous 1)
+     (should (looking-at (rx "alice (6)")))
+
+     ;; No next button
+     (should-error (erc-button-next 1) :type 'user-error)
+     (should (looking-at (rx "alice (6)")))
+
+     ;; Next with negative arg is equivalent to previous
+     (erc-button-next -1)
+     (should (looking-at (rx "bob> (5)")))
+
+     ;; One past end of button
+     (forward-char 3)
+     (should (looking-at (rx "> (5)")))
+     (should-not (get-text-property (point) 'erc-callback))
+     (erc-button-previous 1)
+     (should (looking-at (rx "bob> (5)")))
+
+     ;; At end of button
+     (forward-char 2)
+     (should (looking-at (rx "b> (5)")))
+     (erc-button-previous 1)
+     (should (looking-at (rx "bob (4)")))
+
+     ;; Skip multiple buttons back
+     (erc-button-previous 2)
+     (should (looking-at (rx "bob (2)")))
+
+     ;; Skip multiple buttons forward
+     (erc-button-next 2)
+     (should (looking-at (rx "bob (4)")))
+
+     ;; No error as long as some progress made
+     (erc-button-previous 100)
+     (should (looking-at (rx "alice (1)")))
+
+     ;; Error when no progress made
+     (should-error (erc-button-previous 1) :type 'user-error)
+     (should (looking-at (rx "alice (1)"))))))
+
+;; See also `erc-scenarios-networks-announced-missing' in
+;; erc-scenarios-misc.el for a more realistic example.
+(ert-deftest erc-button--display-error-notice-with-keys ()
+  (with-current-buffer (get-buffer-create "*fake*")
+    (let ((mode erc-button-mode)
+          (inhibit-message noninteractive)
+          erc-modules
+          erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+      (erc-mode)
+      (setq erc-server-process
+            (start-process "sleep" (current-buffer) "sleep" "1"))
+      (set-process-query-on-exit-flag erc-server-process nil)
+      (erc--initialize-markers (point) nil)
+      (erc-button-mode +1)
+      (should (equal (erc-button--display-error-notice-with-keys
+                      "If \\[erc-bol] fails, "
+                      "see \\[erc-bug] or `erc-mode-map'.")
+                     "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
+      (goto-char (point-min))
+
+      (ert-info ("Keymap substitution succeeds")
+        (erc-button-next 1)
+        (should (looking-at "C-a"))
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (erc-button-press-button)
+        (with-current-buffer "*Help*"
+          (goto-char (point-min))
+          (should (search-forward "erc-bol" nil t)))
+        (erc-button-next 1)
+        ;; End of interval correct
+        (erc-button-previous 1)
+        (should (looking-at "C-a fails")))
+
+      (ert-info ("Extended command mapping succeeds")
+        (erc-button-next 1)
+        (should (looking-at "M-x erc-bug"))
+        (erc-button-press-button)
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (with-current-buffer "*Help*"
+          (goto-char (point-min))
+          (should (search-forward "erc-bug" nil t))))
+
+      (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
+        (erc-button-next 1)
+        (should (equal (get-text-property (point) 'font-lock-face)
+                       '(erc-button erc-error-face)))
+        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
+        (should (eq erc-button-face 'erc-button))) ; extent evaporates
+
+      (ert-info ("Format when trailing args include non-strings")
+        (should (equal (erc-button--display-error-notice-with-keys
+                        "abc" " %d def" " 45%s" 123 '\6)
+                       "*** abc 123 def 456")))
+
+      (when noninteractive
+        (unless mode
+          (erc-button-mode -1))
+        (kill-buffer "*Help*")
+        (kill-buffer)))))
+
+;;; erc-button-tests.el ends here
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index e8dd25e8ea1..170436ffbaa 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -94,6 +94,8 @@
           ;; Defend against non-local exits from `ert-skip'
           (unwind-protect
               (funcall test)
+            (when set-transient-map-timer
+              (timer-event-handler set-transient-map-timer))
             (set-window-buffer (selected-window) original-window-buffer)
             (when noninteractive
               (while-let ((buf (pop erc-fill-tests--buffers)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 88b9babf206..5aaf7e499e3 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -2110,65 +2110,4 @@ connection."
                       (put 'erc-mname-enable 'definition-name 'mname)
                       (put 'erc-mname-disable 'definition-name 'mname))))))
 
-
-;; XXX move erc-button tests to new file if more added.
-(require 'erc-button)
-
-;; See also `erc-scenarios-networks-announced-missing' in
-;; erc-scenarios-misc.el for a more realistic example.
-(ert-deftest erc-button--display-error-notice-with-keys ()
-  (with-current-buffer (get-buffer-create "*fake*")
-    (let ((mode erc-button-mode)
-          (inhibit-message noninteractive)
-          erc-modules
-          erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
-      (erc-mode)
-      (erc-tests--set-fake-server-process "sleep" "1")
-      (erc--initialize-markers (point) nil)
-      (erc-button-mode +1)
-      (should (equal (erc-button--display-error-notice-with-keys
-                      "If \\[erc-bol] fails, "
-                      "see \\[erc-bug] or `erc-mode-map'.")
-                     "*** If C-a fails, see M-x erc-bug or `erc-mode-map'."))
-      (goto-char (point-min))
-
-      (ert-info ("Keymap substitution succeeds")
-        (erc-button-next)
-        (should (looking-at "C-a"))
-        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
-        (erc-button-press-button)
-        (with-current-buffer "*Help*"
-          (goto-char (point-min))
-          (should (search-forward "erc-bol" nil t)))
-        (erc-button-next)
-        (erc-button-previous) ; end of interval correct
-        (should (looking-at "a fails")))
-
-      (ert-info ("Extended command mapping succeeds")
-        (erc-button-next)
-        (should (looking-at "M-x erc-bug"))
-        (erc-button-press-button)
-        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
-        (with-current-buffer "*Help*"
-          (goto-char (point-min))
-          (should (search-forward "erc-bug" nil t))))
-
-      (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k
-        (erc-button-next)
-        (should (equal (get-text-property (point) 'font-lock-face)
-                       '(erc-button erc-error-face)))
-        (should (eq (get-text-property (point) 'mouse-face) 'highlight))
-        (should (eq erc-button-face 'erc-button))) ; extent evaporates
-
-      (ert-info ("Format when trailing args include non-strings")
-        (should (equal (erc-button--display-error-notice-with-keys
-                        "abc" " %d def" " 45%s" 123 '\6)
-                       "*** abc 123 def 456")))
-
-      (when noninteractive
-        (unless mode
-          (erc-button-mode -1))
-        (kill-buffer "*Help*")
-        (kill-buffer)))))
-
 ;;; erc-tests.el ends here