master 5bc84a0c9e4 1/7: Cache UI string for channel modes in ERC

[F. Jason Park]

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

    Cache UI string for channel modes in ERC
    
    * etc/ERC-NEWS: Add entry for more expansive "%m" in header line.
    * lisp/erc/erc-common.el (erc--channel-mode-types): New slot
    `shortargs' for caching truncated mode args.
    * lisp/erc/erc.el (erc--mode-line-chanmodes-arg-len): New internal
    variable for adjusting the truncation length of channel-mode arguments
    as they appear in the header line.
    (erc--mode-line-mode-string): New variable for caching the relevant
    "modestring", if any, in ERC buffers.
    (erc--process-channel-modes): Don't associate args with group 4/D,
    which are all nullary modes.  This fixes a bug in which arguments were
    associated with the wrong letters.  Also, set cached mode string for
    channel.
    (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--parse-user-modes): Set `erc--mode-line-mode-string in server
    buffers.
    (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.
    (erc-update-mode-line-buffer): Use cached verbose representation of
    channel or user modes instead of calling `erc-format-channel-modes'.
    * 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)
---
 etc/ERC-NEWS               |  9 +++++
 lisp/erc/erc-common.el     |  3 +-
 lisp/erc/erc.el            | 98 ++++++++++++++++++++++++++++++++++++++--------
 test/lisp/erc/erc-tests.el | 51 ++++++++++++++++++++++--
 4 files changed, 140 insertions(+), 21 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 3bb9a30cfb2..32272208704 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -253,6 +253,15 @@ whenever ERC rejects prompt input containing 
whitespace-only lines.
 When paired with option 'erc-send-whitespace-lines', ERC echoes a
 tally of blank lines padded and trailing blanks culled.
 
+** A context-dependent mode segment in header and mode lines.
+The "%m" specifier has traditionally expanded to a lone "+" in server
+and query buffers and a string containing all switch modes (plus
+"limit" and "key" args) in channel buffers.  It now becomes a string
+of user modes in server buffers and disappears completely in query
+buffers.  In channels, it's grown to include all letters and their
+possibly truncated arguments, with the exception of stateful list
+modes, like "b".
+
 ** Miscellaneous UX changes.
 Some minor quality-of-life niceties have finally made their way to
 ERC.  For example, fool visibility has become togglable with the new
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index e876afe2644..8daedf9b019 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -116,7 +116,8 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter."
 (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
   "Server-local \"CHANMODES\" data."
   (fallbackp nil :type boolean)
-  (table (make-char-table 'erc--channel-mode-types) :type char-table))
+  (table (make-char-table 'erc--channel-mode-types) :type char-table)
+  (shortargs (make-hash-table :test #'equal)))
 
 ;; After dropping 28, we can use prefixed "erc-autoload" cookies.
 (defun erc--normalize-module-symbol (symbol)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f4c3f77593c..0654da5e16d 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6652,6 +6652,12 @@ or t, for type D.")
   "Possibly stale `erc--channel-mode-types' instance for the server.
 Use the getter of the same name to retrieve the current value.")
 
+(defvar-local erc--mode-line-mode-string nil
+  "Computed mode-line or header-line component for user/channel modes.")
+
+(defvar erc--mode-line-chanmodes-arg-len 10
+  "Max length at which to truncate channel-mode args in header line.")
+
 (defun erc--channel-mode-types ()
   "Return variable `erc--channel-mode-types', possibly initializing it."
   (erc--with-isupport-data CHANMODES erc--channel-mode-types
@@ -6686,13 +6692,16 @@ complement relevant letters in STRING."
                (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)
                (erc-display-message nil '(notice error) (erc-server-buffer)
                                     (format "Unknown channel mode: %S" c))))))
     (setq erc-channel-modes (sort erc-channel-modes #'string<))
+    (setq erc--mode-line-mode-string
+          (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len)))
     (erc-update-mode-line (current-buffer))))
 
 (defvar-local erc--user-modes nil
@@ -6703,16 +6712,60 @@ Analogous to `erc-channel-modes' but chars rather than 
strings.")
   "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 letter keys
+as a list of sorted string.  When it's `string' (singular),
+return keys as a single string.  When it's a number N, return a
+single string consisting of the concatenated and sorted keys
+followed by a space and then their corresponding args, each
+truncated to N chars max.  ERC joins these args together with
+SEP, which defaults to a single space.  Otherwise, return a
+sorted alist of letter and arg pairs.  In all cases that include
+values, respect `erc-show-channel-key-p' and optionally omit the
+secret key associated with the letter k."
+  (and-let* ((modes erc--channel-modes)
+             (tobj (erc--channel-mode-types))
+             (types (erc--channel-mode-types-table tobj)))
+    (let (out)
+      (maphash (lambda (k v)
+                 (unless (eq ?a (aref types k))
+                   (push (cons k
+                               (and (not (eq t v))
+                                    (not (and (eq k ?k)
+                                              (not (bound-and-true-p
+                                                    erc-show-channel-key-p))))
+                                    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 (if (> (length v) c)
+                         (with-memoization
+                             (gethash (list c k v)
+                                      (erc--channel-mode-types-shortargs tobj))
+                           (truncate-string-to-width v c 0 nil t))
+                       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
@@ -6743,11 +6796,14 @@ dropped were they not already absent."
 (defun erc--update-user-modes (string)
   "Update `erc--user-modes' from \"MODE\" STRING.
 Return its value, a list of characters sorted by character code."
-  (setq erc--user-modes
-        (pcase-let ((`(,adding ,dropping)
-                     (erc--parse-user-modes string erc--user-modes)))
-          (sort (seq-difference (nconc erc--user-modes adding) dropping)
-                #'<))))
+  (prog1
+      (setq erc--user-modes
+            (pcase-let ((`(,adding ,dropping)
+                         (erc--parse-user-modes string erc--user-modes)))
+              (sort (seq-difference (nconc erc--user-modes adding) dropping)
+                    #'<)))
+    (setq erc--mode-line-mode-string
+          (concat "+" (erc--user-modes 'string)))))
 
 (defun erc--update-channel-modes (string &rest args)
   "Update `erc-channel-modes' and call individual mode handlers.
@@ -6791,14 +6847,24 @@ expect STATE to be a boolean and ARGUMENT either a 
string or nil."
   (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.
@@ -8231,7 +8297,7 @@ shortened server name instead."
   (with-current-buffer buffer
     (let ((spec `((?a . ,(erc-format-away-status))
                   (?l . ,(erc-format-lag-time))
-                  (?m . ,(erc-format-channel-modes))
+                  (?m . ,(or erc--mode-line-mode-string ""))
                   (?n . ,(or (erc-current-nick) ""))
                   (?N . ,(erc-format-network))
                   (?o . ,(or (erc-controls-strip erc-channel-topic) ""))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8dbe44ce5ed..59ad65d65b4 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,13 +796,57 @@
         (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"))
+
+  ;; Truncation cache populated and used.
+  (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
+        first-run)
+    (should (zerop (hash-table-count cache)))
+    (should (equal (erc--channel-modes 1 ",") "klt h,3"))
+    (should (equal (setq first-run (map-pairs cache)) '(((1 ?k "h2") . "h"))))
+    (cl-letf (((symbol-function 'truncate-string-to-width)
+               (lambda (&rest _) (ert-fail "Shouldn't run"))))
+      (should (equal (erc--channel-modes 1 ",") "klt h,3")))
+    ;; Same key for only entry matches that of first result.
+    (should (pcase (map-pairs cache)
+              ((and '(((1 ?k "h2") . "h")) second-run)
+               (eq (pcase first-run (`((,k . ,_)) k))
+                   (pcase second-run (`((,k . ,_)) k)))))))
+
+  (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 +862,7 @@
   (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)) '(() ())))