master e7fa460e1da 4/5: Use caching variant of erc-parse-prefix internally

[F. Jason Park]

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

    Use caching variant of erc-parse-prefix internally
    
    * lisp/erc/erc-common.el (erc--parsed-prefix): New struct to help with
    tasks that depends on the advertised "PREFIX" parameter.
    * lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability.
    (erc--parsed-prefix): New variable and function of the same name for
    caching the reversed result of `erc-parse-prefix' locally per server.
    (erc-channel-receive-names): Use value stored in `erc--parsed-prefix'.
    * test/lisp/erc/erc-tests.el (erc-with-server-buffer): Only activate
    spy around actual test case forms.
    (erc--parse-prefix): New test.  (Bug#67220)
---
 lisp/erc/erc-common.el     |  7 +++++
 lisp/erc/erc.el            | 50 +++++++++++++++++++++++------------
 test/lisp/erc/erc-tests.el | 66 +++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 102 insertions(+), 21 deletions(-)

diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index b020c612b7d..0beae4f9f23 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -106,6 +106,13 @@
 For use with the macro `erc--with-isupport-data'."
   (key nil :type (or null cons)))
 
+(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data))
+  "Server-local data for recognized membership-status prefixes.
+Derived from the advertised \"PREFIX\" ISUPPORT parameter."
+  (letters "qaohv" :type string)
+  (statuses "~&@%+" :type string)
+  (alist nil :type (list-of cons)))
+
 ;; After dropping 28, we can use prefixed "erc-autoload" cookies.
 (defun erc--normalize-module-symbol (symbol)
   "Return preferred SYMBOL for `erc--modules'."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2abbbaa3578..7977bcb69e3 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6193,22 +6193,38 @@ See also `erc-channel-begin-receiving-names'."
 
 (defun erc-parse-prefix ()
   "Return an alist of valid prefix character types and their representations.
-Example: (operator) o => @, (voiced) v => +."
-  (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t))
-                 ;; provide a sane default
-                 "(qaohv)~&@%+"))
-        types chars)
-    (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
-      (setq types (match-string 1 str)
-            chars (match-string 2 str))
-      (let ((len (min (length types) (length chars)))
-            (i 0)
-            (alist nil))
-        (while (< i len)
-          (setq alist (cons (cons (elt types i) (elt chars i))
-                            alist))
-          (setq i (1+ i)))
-        alist))))
+For example, if the current ISUPPORT \"PREFIX\" is \"(ov)@+\",
+return an alist `equal' to ((?v . ?+) (?o . ?@)).  For historical
+reasons, ensure the ordering of the returned alist is opposite
+that of the advertised parameter."
+  (let* ((str (or (erc--get-isupport-entry 'PREFIX t) "(qaohv)~&@%+"))
+         (i 0)
+         (j (string-search ")" str))
+         collected)
+    (when j
+      (while-let ((u (aref str (cl-incf i)))
+                  ((not (=  ?\) u))))
+        (push (cons u (aref str (cl-incf j))) collected)))
+    collected))
+
+(defvar-local erc--parsed-prefix nil
+  "Possibly stale `erc--parsed-prefix' struct instance for the server.
+Use the \"getter\" function of the same name to obtain the current
+value.")
+
+(defun erc--parsed-prefix ()
+  "Return possibly cached `erc--parsed-prefix' object for the server.
+Ensure the returned value describes the most recent \"PREFIX\"
+parameter advertised by the current server, with the original
+ordering intact.  If no such parameter has yet arrived, return a
+stand-in from the fallback value \"(qaohv)~&@%+\"."
+  (erc--with-isupport-data PREFIX erc--parsed-prefix
+    (let ((alist (nreverse (erc-parse-prefix))))
+      (make-erc--parsed-prefix
+       :key key
+       :letters (apply #'string (map-keys alist))
+       :statuses (apply #'string (map-values alist))
+       :alist alist))))
 
 (defcustom erc-channel-members-changed-hook nil
   "This hook is called every time the variable `channel-members' changes.
@@ -6222,7 +6238,7 @@ The buffer where the change happened is current while 
this hook is called."
 Update `erc-channel-users' according to NAMES-STRING.
 NAMES-STRING is a string listing some of the names on the
 channel."
-  (let* ((prefix (erc-parse-prefix))
+  (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix)))
          (voice-ch (cdr (assq ?v prefix)))
          (op-ch (cdr (assq ?o prefix)))
          (hop-ch (cdr (assq ?h prefix)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index e7422d330c0..b4a3c89b27c 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -115,14 +115,20 @@
   (setq erc-away 1)
   (erc-tests--set-fake-server-process "sleep" "1")
 
-  (let (calls)
-    (advice-add 'buffer-local-value :after (lambda (&rest r) (push r calls))
+  (let (mockingp calls)
+    (advice-add 'buffer-local-value :after
+                (lambda (&rest r) (when mockingp (push r calls)))
                 '((name . erc-with-server-buffer)))
 
-    (should (= 1 (erc-with-server-buffer erc-away)))
+    (should (= 1 (prog2 (setq mockingp t)
+                     (erc-with-server-buffer erc-away)
+                   (setq mockingp nil))))
+
     (should (equal (pop calls) (list 'erc-away (current-buffer))))
 
-    (should (= 1 (erc-with-server-buffer (ignore 'me) erc-away)))
+    (should (= 1 (prog2 (setq mockingp t)
+                     (erc-with-server-buffer (ignore 'me) erc-away)
+                   (setq mockingp nil))))
     (should-not calls)
 
     (advice-remove 'buffer-local-value 'erc-with-server-buffer)))
@@ -643,6 +649,58 @@
 
       (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
 
+(ert-deftest erc--parsed-prefix ()
+  (erc-mode)
+  (erc-tests--set-fake-server-process "sleep" "1")
+  (setq erc--isupport-params (make-hash-table))
+
+  ;; Uses fallback values when no PREFIX parameter yet received, thus
+  ;; ensuring caller can use slot accessors immediately intead of
+  ;; checking if null beforehand.
+  (should-not erc--parsed-prefix)
+  (should (equal (erc--parsed-prefix)
+                 #s(erc--parsed-prefix nil "qaohv" "~&@%+"
+                                       ((?q . ?~) (?a . ?&)
+                                        (?o . ?@) (?h . ?%) (?v . ?+)))))
+  (let ((cached (should erc--parsed-prefix)))
+    (should (eq (erc--parsed-prefix) cached)))
+
+  ;; Cache broken.  (Notice not setting `erc--parsed-prefix' to nil).
+  (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))
+
+  (let ((proc erc-server-process)
+        (expected '((?Y . ?!) (?q . ?~) (?a . ?&)
+                    (?o . ?@) (?h . ?%) (?v . ?+)))
+        cached)
+
+    (with-temp-buffer
+      (erc-mode)
+      (setq erc-server-process proc)
+      (should (equal expected
+                     (erc--parsed-prefix-alist (erc--parsed-prefix)))))
+
+    (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
+    (setq cached erc--parsed-prefix)
+    (should (equal cached
+                   #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+"
+                                         ((?Y . ?!) (?q . ?~) (?a . ?&)
+                                          (?o . ?@) (?h . ?%) (?v . ?+)))))
+    ;; Second target buffer reuses cached value.
+    (with-temp-buffer
+      (erc-mode)
+      (setq erc-server-process proc)
+      (should (eq cached (erc--parsed-prefix))))
+
+    ;; New value computed when cache broken.
+    (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params)
+    (with-temp-buffer
+      (erc-mode)
+      (setq erc-server-process proc)
+      (should-not (eq cached (erc--parsed-prefix)))
+      (should (equal (erc--parsed-prefix-alist
+                      (erc-with-server-buffer erc--parsed-prefix))
+                     expected)))))
+
 (ert-deftest erc--parse-isupport-value ()
   (should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
   (should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))