From 77ac1ba798d1896408fab2e25e57efd32596aa18 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Nov 2023 18:24:59 -0800
Subject: [PATCH 1/3] [5.6] Use caching variant of erc-parse-prefix internally

* lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability.
(erc--parsed-prefix): New variable and struct for caching the result
of `erc-parse-prefix' locally.
(erc--parse-prefix): New function to cache reversed result of
`erc-parse-prefix'.
* test/lisp/erc/erc-tests.el (erc--parse-prefix): New test.
---
 lisp/erc/erc.el            | 63 ++++++++++++++++++++++++++++----------
 test/lisp/erc/erc-tests.el | 39 +++++++++++++++++++++++
 2 files changed, 86 insertions(+), 16 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index edcfcf085e6..bbbbc405526 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6192,22 +6192,53 @@ erc-channel-end-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
+  "Cons of latest advertised PREFIX and its parsed alist.
+Only usable for the current server session.")
+
+;; As of ERC 5.6, `erc-channel-receive-names' is the only caller, and
+;; it runs infrequently.  In the future, extensions, like
+;; `multi-prefix', may benefit more from a two-way translation table.
+(cl-defstruct erc--parsed-prefix
+  "Server-local channel-membership-prefix data."
+  (key nil :type (or null string))
+  (letters "qaohv" :type string)
+  (statuses "~&@%+" :type string)
+  (alist nil :type (list-of cons)))
+
+(defun erc--parse-prefix ()
+  "Return (possibly cached) status prefix translation alist for the server.
+Ensure the returned value describes the most recent \"PREFIX\"
+ISUPPORT parameter received from the current server and that the
+original ordering is preserved."
+  (erc-with-server-buffer
+    (let ((key (erc--get-isupport-entry 'PREFIX)))
+      (or (and key
+               erc--parsed-prefix
+               (eq (cdr key) (erc--parsed-prefix-key erc--parsed-prefix))
+               (erc--parsed-prefix-alist erc--parsed-prefix))
+          (let ((alist (nreverse (erc-parse-prefix))))
+            (setq erc--parsed-prefix
+                  (make-erc--parsed-prefix
+                   :key (cdr key)
+                   :letters (apply #'string (map-keys alist))
+                   :statuses (apply #'string (map-values alist))
+                   :alist alist))
+            alist)))))
 
 (defcustom erc-channel-members-changed-hook nil
   "This hook is called every time the variable `channel-members' changes.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index e7422d330c0..28bf1fbcccc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -643,6 +643,45 @@ erc-parse-user
 
       (should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
 
+(ert-deftest erc--parse-prefix ()
+  (erc-mode)
+  (erc-tests--set-fake-server-process "sleep" "1")
+  (setq erc--isupport-params (make-hash-table)
+        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--parse-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 (erc--parsed-prefix-alist cached) (erc--parse-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 (erc--parsed-prefix-alist cached) (erc--parse-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")))
-- 
2.41.0