Re: bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC

From 70affab11884917814cd4e86c4266f1feeace9ea Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Mon, 20 Nov 2023 19:45:30 -0800
Subject: [PATCH] [5.6] Don't associate type D channel modes with args in ERC

* lisp/erc/erc.el (erc--process-channel-modes): Don't associate args
with group 4/D, which are all nullary modes.
(erc--user-modes): Simplify slightly by removing likely useless
variant for overloaded arg AS-TYPE.  This function is new in ERC 5.6.
(erc--channel-modes):  New function.  A higher-level getter for
current channel mode representation to complement `erc--user-modes'.
(erc--handle-channel-mode): Change model to associate modes of type A
with a running plus/minus tally of state changes since joining the
channel.
* test/lisp/erc/erc-tests.el (erc--update-channel-modes): Update to
reflect new running tally associations for type A modes.
(erc--channel-modes): New test.
(erc--user-modes): Update to reflect parameter simplification.
(Bug#67220)
---
 lisp/erc/erc.el            | 58 +++++++++++++++++++++++++++++++-------
 test/lisp/erc/erc-tests.el | 36 ++++++++++++++++++++---
 2 files changed, 80 insertions(+), 14 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f4c3f77593c..f8053165b8b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6686,7 +6686,8 @@ erc--process-channel-modes
                (erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
               ((and-let* ((group (or (aref table c) (and fallbackp ?d))))
                  (erc--handle-channel-mode group c +p
-                                           (and (or (/= group ?c) +p)
+                                           (and (/= group ?d)
+                                                (or (/= group ?c) +p)
                                                 (pop args)))
                  t))
               ((not fallbackp)
@@ -6703,16 +6704,43 @@ erc--user-modes
   "Return user \"MODE\" letters in a form described by AS-TYPE.
 When AS-TYPE is the symbol `strings' (plural), return a list of
 strings.  When it's `string' (singular), return the same list
-concatenated into a single string.  When it's a single char, like
-?+, return the same value as `string' but with AS-TYPE prepended.
-When AS-TYPE is nil, return a list of chars."
+concatenated into a single string.  When AS-TYPE is nil, return a
+list of chars."
   (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes))))
     (pcase as-type
       ('strings (mapcar #'char-to-string modes))
       ('string (apply #'string modes))
-      ((and (pred characterp) c) (apply #'string (cons c modes)))
       (_ modes))))
 
+(defun erc--channel-modes (&optional as-type sep)
+  "Return channel \"MODE\" settings in a form described by AS-TYPE.
+When AS-TYPE is the symbol `strings' (plural), return all keys a
+list of sorted string.  When it's `string' (singular), return
+keys as a single string.  When it's a number, return a single
+string consisting of the concatenated and sorted keys followed by
+their corresponding args, separated by SEP, which defaults to a
+single space.  Otherwise, return a sorted alist of letter/arg
+pairs."
+  (and-let* ((modes erc--channel-modes)
+             (types (erc--channel-mode-types-table (erc--channel-mode-types))))
+    (let (out)
+      (maphash (lambda (k v)
+                 (unless (eq ?a (aref types k))
+                   (push (cons k (and (not (eq t v)) v)) out)))
+               modes)
+      (setq out (cl-sort out #'< :key #'car))
+      (pcase as-type
+        ('strings (mapcar (lambda (o) (char-to-string (car o))) out))
+        ('string (apply #'string (mapcar #'car out)))
+        ((and (pred natnump) c)
+         (let (keys vals)
+           (pcase-dolist (`(,k . ,v) out)
+             (when v (push (substring v 0 (min c (length v))) vals))
+             (push k keys))
+           (concat (apply #'string (nreverse keys)) (and vals " ")
+                   (string-join (nreverse vals) (or sep " ")))))
+        (_ out)))))
+
 (defun erc--parse-user-modes (string &optional current extrap)
   "Return lists of chars from STRING to add to and drop from CURRENT.
 Expect STRING to be a so-called \"modestring\", the second
@@ -6791,14 +6819,24 @@ erc--handle-channel-mode
   (erc-log (format "Channel-mode %c (type %s, arg %S) %s"
                    letter type arg (if state 'enabled 'disabled))))
 
-(cl-defmethod erc--handle-channel-mode :before (_ c state arg)
-  "Record STATE change and ARG, if enabling, for mode letter C."
+(cl-defmethod erc--handle-channel-mode :before (type c state arg)
+  "Record STATE change for mode letter C.
+When STATE is non-nil, add or update C's mapping in
+`erc--channel-modes', associating it with ARG if C takes a
+parameter and t otherwise.  When STATE is nil, forget the
+mapping.  For type A, add up update a permanent mapping for C,
+associating it with an integer indicating a running total of
+STATE changes since joining the channel.  In most cases, this
+won't match the number known to the server."
   (unless erc--channel-modes
     (cl-assert (erc--target-channel-p erc--target))
     (setq erc--channel-modes (make-hash-table)))
-  (if state
-      (puthash c (or arg t) erc--channel-modes)
-    (remhash c erc--channel-modes)))
+  (if (= type ?a)
+      (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1)))
+          (gethash c erc--channel-modes))
+    (if state
+        (puthash c (or arg t) erc--channel-modes)
+      (remhash c erc--channel-modes))))
 
 (cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
   "Update `erc-channel-modes' for any character C of nullary type D.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8dbe44ce5ed..0c03a12864a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,13 +796,42 @@ erc--update-channel-modes
         (erc--update-channel-modes "+qu" "fool!*@*")
         (should (equal (pop calls) '(?d ?u t nil)))
         (should (equal (pop calls) '(?a ?q t "fool!*@*")))
-        (should (equal "fool!*@*" (gethash ?q erc--channel-modes)))
+        (should (equal 1 (gethash ?q erc--channel-modes)))
         (should (eq t (gethash ?u erc--channel-modes)))
         (should (equal erc-channel-modes '("u")))
-        (should-not (erc-channel-user-owner-p "bob")))
+        (should-not (erc-channel-user-owner-p "bob"))
+
+        ;; Remove fool!*@* from list mode "q".
+        (erc--update-channel-modes "-uq" "fool!*@*")
+        (should (equal (pop calls) '(?a ?q nil "fool!*@*")))
+        (should (equal (pop calls) '(?d ?u nil nil)))
+        (should-not (gethash ?u erc--channel-modes))
+        (should-not erc-channel-modes)
+        (should (equal 0 (gethash ?q erc--channel-modes))))
 
       (should-not calls))))
 
+(ert-deftest erc--channel-modes ()
+  (setq erc--isupport-params (make-hash-table)
+        erc--target (erc--target-from-string "#test")
+        erc-server-parameters
+        '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+
+  (erc-tests--set-fake-server-process "sleep" "1")
+
+  (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
+    (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+
+  (should (equal (erc--channel-modes 'string) "klt"))
+  (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
+  (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
+  (should (equal (erc--channel-modes 3 ",") "klt h2,3"))
+  (should (equal (erc--channel-modes 1 ",") "klt h,3"))
+  (should (equal (erc--channel-modes 0 ",") "klt ,"))
+  (should (equal (erc--channel-modes 2) "klt h2 3"))
+  (should (equal (erc--channel-modes 1) "klt h 3"))
+  (should (equal (erc--channel-modes 0) "klt  "))) ; 2 spaces
+
 (ert-deftest erc--update-user-modes ()
   (let ((erc--user-modes (list ?a)))
     (should (equal (erc--update-user-modes "+a") '(?a)))
@@ -818,8 +847,7 @@ erc--user-modes
   (let ((erc--user-modes '(?a ?b)))
     (should (equal (erc--user-modes) '(?a ?b)))
     (should (equal (erc--user-modes 'string) "ab"))
-    (should (equal (erc--user-modes 'strings) '("a" "b")))
-    (should (equal (erc--user-modes '?+) "+ab"))))
+    (should (equal (erc--user-modes 'strings) '("a" "b")))))
 
 (ert-deftest erc--parse-user-modes ()
   (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
-- 
2.41.0