fix/bug-48598 1978c3178c 10/27: Update ISUPPORT handling in ERC

[F. Jason Park]

branch: fix/bug-48598
commit 1978c3178cb628eea2c472c2eca933a6d74e224d
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Update ISUPPORT handling in ERC
    
    * lisp/erc/erc-backend (erc--isupport-params): Add new variable to
    hold a hashmap of parsed `erc-server-parameters' in a more useful
    format.  But keep `erc-server-parameters' around for public use.
    (erc--parse-isupport-value): Add helper function that parses an
    ISUPPORT value and returns the component parts with backslash-x hex
    escapes removed.
    (erc--get-isupport-entry): Add internal getter to look up ISUPPORT
    items.
    (erc--with-memoization): Add compat alias for use in internal ISUPPORT
    getter.  Should be moved to `erc-compat.el' when that library is fully
    reincorporated.
    (erc-server-005): Treat `erc-server-response' "command args" field as
    read-only. Prior to this, this field was set to nil after processing,
    which was unhelpful to other parts of the library. Also call above
    mentioned helper to parse values. And add some bookkeeping to handle
    negation.
    
    * lisp/erc/erc-capab.el (erc-capab-identify-send-messages): Use
    internal ISUPPORT getter.
    
    * lisp/erc/erc.el (erc-cmd-NICK,
    erc-parse-prefix,erc-nickname-in-use): Use internal ISUPPORT getter.
    
    * test/lisp/erc/erc-tests.el: Add tests for the above mentioned
    changes in erc-backend.el.
---
 lisp/erc/erc-backend.el    | 97 +++++++++++++++++++++++++++++++++++++++-------
 lisp/erc/erc-capab.el      |  2 +-
 lisp/erc/erc.el            | 13 +++----
 test/lisp/erc/erc-tests.el | 95 +++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 184 insertions(+), 23 deletions(-)

diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 546b51c282..48045595c7 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -185,6 +185,11 @@ SILENCE=10 - supports the SILENCE command, maximum allowed 
number of entries
 TOPICLEN=160 - maximum allowed topic length
 WALLCHOPS - supports sending messages to all operators in a channel")
 
+(defvar-local erc--isupport-params nil
+  "Hash map of isupport params.
+Keys are symbols.  Values are lists of zero or more strings with hex
+escapes removed.")
+
 ;;; Server and connection state
 
 (defvar erc-server-ping-timer-alist nil
@@ -1619,6 +1624,66 @@ Then display the welcome message."
      ?U (nth 3 (erc-response.command-args parsed))
      ?C (nth 4 (erc-response.command-args parsed)))))
 
+(defun erc--parse-isupport-value (value)
+  "Return list of unescaped components from an \"ISUPPORT\" VALUE."
+  ;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2
+  ;;
+  ;; > The server SHOULD send "X", not "X="; this is the normalised form.
+  ;;
+  ;; Note: for now, assume the server will only send non-empty values,
+  ;; possibly with printable ASCII escapes.  Though in practice, the
+  ;; only two escapes we're likely to see are backslash and space,
+  ;; meaning the pattern is too liberal.
+  (let (case-fold-search)
+    (mapcar
+     (lambda (v)
+       (let ((start 0)
+             m
+             c)
+         (while (and (< start (length v))
+                     (string-match "[\\]x[0-9A-F][0-9A-F]" v start))
+           (setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
+                 c (string-to-number m 16))
+           (if (<= ?\  c ?~)
+               (setq v (concat (substring v 0 (match-beginning 0))
+                               (string c)
+                               (substring v (match-end 0)))
+                     start (- (match-end 0) 3))
+             (setq start (match-end 0))))
+         v))
+     (if (if (>= emacs-major-version 28)
+             (string-search "," value)
+           (string-match-p "," value))
+         (split-string value ",")
+       (list value)))))
+
+;; FIXME move to erc-compat (once it's been fully reinstated)
+(defalias 'erc--with-memoization
+  (cond
+   ((fboundp 'with-memoization) #'with-memoization) ; 29.1
+   ((fboundp 'cl--generic-with-memoization) #'cl--generic-with-memoization)
+   (t (lambda (_ v) v))))
+
+(defun erc--get-isupport-entry (key &optional single)
+  "Return an item for \"ISUPPORT\" token KEY, a symbol.
+When a lookup fails return nil.  Otherwise return a list whose CAR is
+KEY and whose CDR is zero or more strings.  With SINGLE, just return the
+first value, if any.  This is potentially ambiguous and only useful for
+tokens supporting a single primitive value."
+  (if-let* ((table (or erc--isupport-params
+                       (erc-with-server-buffer erc--isupport-params)))
+            (value (erc--with-memoization (gethash key table)
+                     (when-let ((v (assoc (symbol-name key)
+                                          erc-server-parameters)))
+                       (if (cdr v)
+                           (erc--parse-isupport-value (cdr v))
+                         '--empty--)))))
+      (pcase value
+        ('--empty-- (unless single (list key)))
+        (`(,head . ,_) (if single head (cons key value))))
+    (when table
+      (remhash key table))))
+
 (define-erc-response-handler (005)
   "Set the variable `erc-server-parameters' and display the received message.
 
@@ -1630,21 +1695,25 @@ certain commands are accepted and more.  See 
documentation for
 
 A server may send more than one 005 message."
   nil
-  (let ((line (mapconcat #'identity
-                         (setf (erc-response.command-args parsed)
-                               (cdr (erc-response.command-args parsed)))
-                         " ")))
-    (while (erc-response.command-args parsed)
-      (let ((section (pop (erc-response.command-args parsed))))
-        ;; fill erc-server-parameters
-        (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\([A-Z]+\\)$"
+  (unless erc--isupport-params
+    (setq erc--isupport-params (make-hash-table)))
+  (let* ((args (cdr (erc-response.command-args parsed)))
+         (line (string-join args " ")))
+    (while args
+      (let ((section (pop args))
+            key
+            value
+            negated)
+        (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$"
                             section)
-          (add-to-list 'erc-server-parameters
-                       `(,(or (match-string 1 section)
-                              (match-string 3 section))
-                         .
-                         ,(match-string 2 section))))))
-    (erc-display-message parsed 'notice proc line)))
+          (setq key (or (match-string 1 section) (match-string 4 section))
+                value (match-string 2 section)
+                negated (and (match-string 3 section) '-))
+          (setf (alist-get key erc-server-parameters '- 'remove #'equal)
+                (or value negated))
+          (remhash (intern key) erc--isupport-params))))
+    (erc-display-message parsed 'notice proc line)
+    nil))
 
 (define-erc-response-handler (221)
   "Display the current user modes." nil
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 8d0f40af99..c590b45fd2 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -137,7 +137,7 @@ These arguments are sent to this function when called as a 
hook in
              ;; could possibly check for '("IRCD" . "dancer") in
              ;; `erc-server-parameters' instead of looking for a specific name
              ;; in `erc-server-version'
-             (assoc "CAPAB" erc-server-parameters))
+             (erc--get-isupport-entry 'CAPAB))
     (erc-log "Sending CAPAB IDENTIFY-MSG and IDENTIFY-CTCP")
     (erc-server-send "CAPAB IDENTIFY-MSG")
     (erc-server-send "CAPAB IDENTIFY-CTCP")
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6688a547d4..8fb84e418b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -141,7 +141,6 @@
 (defvar erc-server-current-nick)
 (defvar erc-server-lag)
 (defvar erc-server-last-sent-time)
-(defvar erc-server-parameters)
 (defvar erc-server-process)
 (defvar erc-server-quitting)
 (defvar erc-server-reconnect-count)
@@ -3555,8 +3554,8 @@ The rest of LINE is the message to send."
 (defun erc-cmd-NICK (nick)
   "Change current nickname to NICK."
   (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
-  (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
-                                         erc-server-parameters)))))
+  (let ((nicklen (erc-with-server-buffer
+                   (erc--get-isupport-entry 'NICKLEN 'single))))
     (and nicklen (> (length nick) (string-to-number nicklen))
          (erc-display-message
           nil 'notice 'active 'nick-too-long
@@ -4432,9 +4431,8 @@ See also `erc-display-error-notice'."
        (format "Nickname %s is %s, try another." nick reason))
     (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
     (let ((newnick (nth 1 erc-default-nicks))
-          (nicklen (cdr (assoc "NICKLEN"
-                               (erc-with-server-buffer
-                                 erc-server-parameters)))))
+          (nicklen (erc-with-server-buffer
+                     (erc--get-isupport-entry 'NICKLEN 'single))))
       (setq erc-bad-nick t)
       ;; try to use a different nick
       (if erc-default-nicks
@@ -5038,8 +5036,7 @@ 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 (cdr (assoc "PREFIX" (erc-with-server-buffer
-                                        erc-server-parameters)))
+  (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t))
                  ;; provide a sane default
                  "(qaohv)~&@%+"))
         types chars)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 688942c779..3766202fe5 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -304,6 +304,101 @@
     (setq erc-lurker-ignore-chars "_-`") ; set of chars, not character alts
     (should (string= "nick" (erc-lurker-maybe-trim "nick-_`")))))
 
+(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")))
+
+  (should (equal (erc--parse-isupport-value "abc") '("abc")))
+  (should (equal (erc--parse-isupport-value "\\x20foo") '(" foo")))
+  (should (equal (erc--parse-isupport-value "foo\\x20") '("foo ")))
+  (should (equal (erc--parse-isupport-value "a\\x20b\\x20c") '("a b c")))
+  (should (equal (erc--parse-isupport-value "a\\x20b\\x20c\\x20") '("a b c ")))
+  (should (equal (erc--parse-isupport-value "\\x20a\\x20b\\x20c") '(" a b c")))
+  (should (equal (erc--parse-isupport-value "a\\x20\\x20c") '("a  c")))
+  (should (equal (erc--parse-isupport-value "\\x20\\x20\\x20") '("   ")))
+  (should (equal (erc--parse-isupport-value "\\x5Co/") '("\\o/")))
+  (should (equal (erc--parse-isupport-value "\\x7F,\\x19") '("\\x7F" "\\x19")))
+  (should (equal (erc--parse-isupport-value "a\\x2Cb,c") '("a,b" "c"))))
+
+(ert-deftest erc--get-isupport-entry ()
+  (let ((erc--isupport-params (make-hash-table))
+        (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
+        (items (lambda ()
+                 (cl-loop for k being the hash-keys of erc--isupport-params
+                          using (hash-values v) collect (cons k v)))))
+
+    (should-not (erc--get-isupport-entry 'FAKE))
+    (should-not (erc--get-isupport-entry 'FAKE 'single))
+    (should (zerop (hash-table-count erc--isupport-params)))
+
+    (should (equal (erc--get-isupport-entry 'BAR) '(BAR)))
+    (should-not (erc--get-isupport-entry 'BAR 'single))
+    (should (= 1 (hash-table-count erc--isupport-params)))
+
+    (should (equal (erc--get-isupport-entry 'BAZ) '(BAZ "A" "B" "C")))
+    (should (equal (erc--get-isupport-entry 'BAZ 'single) "A"))
+    (should (= 2 (hash-table-count erc--isupport-params)))
+
+    (should (equal (erc--get-isupport-entry 'FOO 'single) "1"))
+    (should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
+
+    (should (equal (funcall items)
+                   '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
+
+(ert-deftest erc-server-005 ()
+  (let* ((erc-server-005-functions (copy-sequence erc-server-005-functions))
+         (hooked 0)
+         (verify #'ignore)
+         (hook (lambda (_ _) (funcall verify) (cl-incf hooked)))
+         erc-server-parameters
+         erc--isupport-params
+         erc-timer-hook
+         calls
+         args
+         parsed)
+    (add-hook 'erc-server-005-functions hook 90)
+    (should (eq (cadr erc-server-005-functions) hook))
+    (cl-letf (((symbol-function 'erc-display-message)
+               (lambda (_ _ _ line) (push line calls))))
+
+      (ert-info ("Baseline")
+        (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
+              parsed (make-erc-response :command-args args :command "005"))
+
+        (setq verify
+              (lambda ()
+                (should (equal erc-server-parameters
+                               '(("PREFIX" . "(ov)@+") ("EXCEPTS")
+                                 ("BOT" . "B"))))
+                (should (zerop (hash-table-count erc--isupport-params)))
+                (should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
+                (should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
+                (should (equal "B" (erc--get-isupport-entry 'BOT t)))
+                (should (string= (pop calls)
+                                 "BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
+                (should (equal args (erc-response.command-args parsed)))))
+
+        (erc-call-hooks nil parsed))
+
+      (ert-info ("Negated, updated")
+        (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
+              parsed (make-erc-response :command-args args :command "005"))
+
+        (setq verify
+              (lambda ()
+                (should (equal erc-server-parameters
+                               '(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
+                (should (string= (pop calls)
+                                 "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
+                (should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
+                (should (equal "B" (erc--get-isupport-entry 'BOT t)))
+                (should-not (erc--get-isupport-entry 'EXCEPTS))
+                (should (equal args (erc-response.command-args parsed)))))
+
+        (erc-call-hooks nil parsed))
+      (should (= hooked 2))))
+  (should-not (cadr erc-server-005-functions)))
+
 (ert-deftest erc-ring-previous-command-base-case ()
   (ert-info ("Create ring when nonexistent and do nothing")
     (let (erc-input-ring