master e0df2841fb7 2/3: Allow updating of /IGNORE timeouts in ERC

[F. Jason Park]

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

    Allow updating of /IGNORE timeouts in ERC
    
    * lisp/erc/erc.el (erc--read-time-period, erc--decode-time-period):
    Move body of former, now a superficial wrapper, to latter, a new
    function.
    (erc--format-time-period): New function.
    (erc--get-ignore-timer-args): New function.
    (erc--find-ignore-timer): New function to search through `timer-list'
    to find matching ignore timer.
    (erc-cmd-IGNORE): Refactor and redo doc string.  Add new optional
    `timespec' parameter, primarily to aid in testing.  Update an existing
    timer instead of always creating one, and display time remaining in
    "ignore list" output.  Pass server buffer instead of current buffer to
    timer callbacks because `erc--unignore-user' displays its messages in
    the `active' buffer, not necessarily the issuing one.  Note that doing
    this does discard potentially useful information, so if ever reverting,
    we can change the `cl-find' :test in `erc--find-ignore-timer' to
    something that compares the `erc-server-process' of both buffers.
    ;;
    ;; Something like:
    ;;
    ;; (defun erc--ignore-timers-equal-p (a b)
    ;;   (and (equal (car a) (car b))
    ;;        (eq (buffer-local-value 'erc-server-process (cadr a))
    ;;            (buffer-local-value 'erc-server-process (cadr b)))))
    ;;
    (erc-cmd-UNIGNORE): Pass `erc-ignore-list' member matching `user'
    parameter to `erc--unignore-user' instead of original, raw parameter,
    along with the server buffer.
    (erc--unignore-user): Cancel existing timer and don't bother switching
    to server buffer since we're already there.
    (erc-message-english-ignore-list): New variable.
    * test/lisp/erc/erc-scenarios-ignore.el: New file.
    * test/lisp/erc/erc-tests.el (erc--read-time-period): New test.
    (erc-cmd-UNIGNORE): New test.  (Bug#70127)
---
 lisp/erc/erc.el                       | 92 ++++++++++++++++++++++++++---------
 test/lisp/erc/erc-scenarios-ignore.el | 79 ++++++++++++++++++++++++++++++
 test/lisp/erc/erc-tests.el            | 28 +++++++++++
 3 files changed, 176 insertions(+), 23 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0750463a4e7..4ed77655f19 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4191,8 +4191,11 @@ If there's no letter spec, the input is interpreted as a 
number of seconds.
 
 If input is blank, this function returns nil.  Otherwise it
 returns the time spec converted to a number of seconds."
-  (let ((period (string-trim
-                 (read-string prompt nil 'erc--read-time-period-history))))
+  (erc--decode-time-period
+   (string-trim (read-string prompt nil 'erc--read-time-period-history))))
+
+(defun erc--decode-time-period (period)
+  (progn ; unprogn on next major refactor
     (cond
      ;; Blank input.
      ((zerop (length period))
@@ -4223,36 +4226,76 @@ returns the time spec converted to a number of seconds."
           (user-error "%s is not a valid time period" period))
         (decoded-time-period time))))))
 
-(defun erc-cmd-IGNORE (&optional user)
-  "Ignore USER.  This should be a regexp matching nick!user@host.
-If no USER argument is specified, list the contents of `erc-ignore-list'."
+(defun erc--format-time-period (secs)
+  "Return a string with hour/minute/second labels for duration in SECS."
+  (let* ((hours (floor secs 3600))
+         (minutes (floor (mod secs 3600) 60))
+         (seconds (mod secs 60)))
+    (cond ((>= secs 3600) (format "%dh%dm%ds" hours minutes (floor seconds)))
+          ((>= secs 60) (format "%dm%ds" minutes (floor seconds)))
+          (t (format "%ds" (floor seconds))))))
+
+(defun erc--get-ignore-timer-args (inst)
+  ;; The `cl-struct' `pcase' pattern and `cl-struct-slot-value' emit
+  ;; warnings when compiling because `timer' is un-`:named'.
+  (when (and (timerp inst)
+             (eq (aref inst (cl-struct-slot-offset 'timer 'function))
+                 'erc--unignore-user))
+    (aref inst (cl-struct-slot-offset 'timer 'args))))
+
+(defun erc--find-ignore-timer (&rest args)
+  "Find an existing ignore timer."
+  (cl-find args timer-list :key #'erc--get-ignore-timer-args :test #'equal))
+
+(defun erc-cmd-IGNORE (&optional user timespec)
+  "Drop messages from senders, like nick!user@host, matching regexp USER.
+With human-readable TIMESPEC, ignore messages from matched senders for
+the specified duration, like \"20m\".  Without USER, list the contents
+of `erc-ignore-list'."
   (if user
-      (let ((quoted (regexp-quote user)))
+      (let ((quoted (regexp-quote user))
+            (prompt "Add a timeout? (Blank for no, or a time spec like 2h): ")
+            timeout msg)
         (when (and (not (string= user quoted))
                    (y-or-n-p (format "Use regexp-quoted form (%s) instead? "
                                      quoted)))
           (setq user quoted))
-        (let ((timeout
-               (erc--read-time-period
-                "Add a timeout? (Blank for no, or a time spec like 2h): "))
-              (buffer (current-buffer)))
+        (unless timespec
+          (setq timespec
+                (read-string prompt nil 'erc--read-time-period-history)))
+        (setq timeout (erc--decode-time-period (string-trim timespec))
+              msg (if timeout
+                      (format "Now ignoring %s for %s" user
+                              (erc--format-time-period timeout))
+                    (format "Now ignoring %s" user)))
+        (erc-with-server-buffer
           (when timeout
-            (run-at-time timeout nil
-                         (lambda ()
-                           (erc--unignore-user user buffer))))
-          (erc-display-message nil 'notice 'active
-                               (format "Now ignoring %s" user))
-          (erc-with-server-buffer (add-to-list 'erc-ignore-list user))))
+            (if-let ((existing (erc--find-ignore-timer user (current-buffer))))
+                (timer-set-time existing (timer-relative-time nil timeout))
+              (run-at-time timeout nil #'erc--unignore-user user
+                           (current-buffer))))
+          (erc-display-message nil 'notice 'active msg)
+          (cl-pushnew user erc-ignore-list :test #'equal)))
     (if (null (erc-with-server-buffer erc-ignore-list))
         (erc-display-message nil 'notice 'active "Ignore list is empty")
       (erc-display-message nil 'notice 'active "Ignore list:")
-      (mapc (lambda (item)
-              (erc-display-message nil 'notice 'active item))
-            (erc-with-server-buffer erc-ignore-list))))
+      (erc-with-server-buffer
+        (let ((seen (copy-sequence erc-ignore-list)))
+          (dolist (timer timer-list)
+            (when-let ((args (erc--get-ignore-timer-args timer))
+                       ((eq (current-buffer) (nth 1 args)))
+                       (user (car args))
+                       (delta (- (timer-until timer (current-time))))
+                       (duration (erc--format-time-period delta)))
+              (setq seen (delete user seen))
+              (erc-display-message nil 'notice 'active 'ignore-list
+                                   ?p user ?s duration)))
+          (dolist (pattern seen)
+            (erc-display-message nil 'notice 'active pattern))))))
   t)
 
 (defun erc-cmd-UNIGNORE (user)
-  "Remove the user specified in USER from the ignore list."
+  "Remove the first pattern in `erc-ignore-list' matching USER."
   (let ((ignored-nick (car (erc-with-server-buffer
                              (erc-member-ignore-case (regexp-quote user)
                                                      erc-ignore-list)))))
@@ -4264,16 +4307,18 @@ If no USER argument is specified, list the contents of 
`erc-ignore-list'."
         (erc-display-message nil 'notice 'active
                              (format "%s is not currently ignored!" user))))
     (when ignored-nick
-      (erc--unignore-user user (current-buffer))))
+      (erc--unignore-user ignored-nick (erc-server-buffer))))
   t)
 
 (defun erc--unignore-user (user buffer)
   (when (buffer-live-p buffer)
     (with-current-buffer buffer
+      (cl-assert (erc--server-buffer-p))
       (erc-display-message nil 'notice 'active
                            (format "No longer ignoring %s" user))
-      (erc-with-server-buffer
-        (setq erc-ignore-list (delete user erc-ignore-list))))))
+      (setq erc-ignore-list (delete user erc-ignore-list))
+      (when-let ((existing (erc--find-ignore-timer user buffer)))
+        (cancel-timer existing)))))
 
 (defvar erc--pre-clear-functions nil
   "Abnormal hook run when truncating buffers.
@@ -9299,6 +9344,7 @@ SOFTP, only do so when defined as a variable."
     . "\n\n*** Connection failed!  Re-establishing connection...\n")
    (disconnected-noreconnect
     . "\n\n*** Connection failed!  Not re-establishing connection.\n")
+   (ignore-list . "%-8p %s")
    (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
    (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
    (finished . "\n\n*** ERC finished ***\n")
diff --git a/test/lisp/erc/erc-scenarios-ignore.el 
b/test/lisp/erc/erc-scenarios-ignore.el
new file mode 100644
index 00000000000..1142bbef14d
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-ignore.el
@@ -0,0 +1,79 @@
+;;; erc-scenarios-ignore.el --- /IGNORE scenarios ERC -*- lexical-binding: t 
-*-
+
+;; Copyright (C) 2024 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:
+
+;; TODO add test covering the same ignored speaker in two different
+;; channels on the same server: they should be ignored in both.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+  (let ((load-path (cons (ert-resource-directory) load-path)))
+    (require 'erc-scenarios-common)))
+
+(ert-deftest erc-scenarios-ignore/basic ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/assoc/multi-net")
+       (erc-server-flood-penalty 0.1)
+       (dumb-server-foonet (erc-d-run "localhost" t 'foonet))
+       (dumb-server-barnet (erc-d-run "localhost" t 'barnet))
+       (erc-autojoin-channels-alist '((foonet "#chan") (barnet "#chan")))
+       (port-foonet (process-contact dumb-server-foonet :service))
+       (port-barnet (process-contact dumb-server-barnet :service))
+       (expect (erc-d-t-make-expecter)))
+
+    (ert-info ("Connect to two networks")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port-barnet
+                                :nick "tester"
+                                :password "changeme"
+                                :full-name "tester"))
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port-foonet
+                                :nick "tester"
+                                :password "changeme"
+                                :full-name "tester")
+        (funcall expect 10 "debug mode")))
+
+    (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@foonet"))
+      (funcall expect 10 "<bob> tester, welcome!")
+      (funcall expect 10 "<alice> tester, welcome!")
+      (erc-scenarios-common-say "/ignore alice 1m")
+      (erc-scenarios-common-say "/ignore mike 1h")
+      (funcall expect 10 "ignoring alice for 1m0s")
+      (funcall expect 10 "<bob> alice: Signior Iachimo")
+      (erc-scenarios-common-say "/ignore")
+      (funcall expect 10 "alice    59s")
+      (funcall expect 10 "mike     59m59s")
+      (funcall expect -0.1 "<alice>")
+      (funcall expect 10 "<bob> alice: The ground is bloody")
+      (erc-scenarios-common-say "/unignore alice")
+      (funcall expect 10 "<alice>"))
+
+    ;; No <mike> messages were ignored on network barnet.
+    (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan@barnet"))
+      (funcall expect 10 "<mike> tester, welcome!")
+      (funcall expect 10 "<joe> tester, welcome!")
+      (funcall expect 10 "<mike> joe: Whipp'd")
+      (funcall expect 10 "<mike> joe: Double"))))
+
+;;; erc-scenarios-ignore.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 3e8ddef3731..22432a68034 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -50,6 +50,34 @@
   (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
     (should (equal (erc--read-time-period "foo: ") 86400))))
 
+(ert-deftest erc--format-time-period ()
+  (should (equal (erc--format-time-period 59) "59s"))
+  (should (equal (erc--format-time-period 59.9) "59s"))
+  (should (equal (erc--format-time-period 60) "1m0s"))
+  (should (equal (erc--format-time-period 119) "1m59s"))
+  (should (equal (erc--format-time-period 119.9) "1m59s"))
+  (should (equal (erc--format-time-period 120.9) "2m0s"))
+  (should (equal (erc--format-time-period 3599.9) "59m59s"))
+  (should (equal (erc--format-time-period 3600) "1h0m0s")))
+
+;; This asserts that the first pattern on file matching a supplied
+;; `user' parameter will be removed after confirmation.
+(ert-deftest erc-cmd-UNIGNORE ()
+  ;; XXX these functions mutate `erc-ignore-list' via `delete'.
+  (should (local-variable-if-set-p 'erc-ignore-list))
+  (erc-tests-common-make-server-buf)
+
+  (setq erc-ignore-list (list ".")) ; match anything
+  (ert-simulate-keys (list ?\r)
+    (erc-cmd-IGNORE "abc"))
+  (should (equal erc-ignore-list (list "abc" ".")))
+
+  (cl-letf (((symbol-function 'y-or-n-p) #'always))
+    (erc-cmd-UNIGNORE "abcdef")
+    (should (equal erc-ignore-list (list ".")))
+    (erc-cmd-UNIGNORE "foo"))
+  (should-not erc-ignore-list))
+
 (ert-deftest erc-with-all-buffers-of-server ()
   (let (proc-exnet
         proc-onet