From 0640c127d9242267b3e7f50f02589971f6a578af Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 13 Nov 2023 18:24:59 -0800 Subject: [PATCH 2/3] [5.6] Use caching variant of erc-parse-prefix internally * lisp/erc/erc-common.el (erc--parsed-prefix): New struct for data relevant to working with advertised ISUPPORT PREFIX. * lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability. (erc--parsed-prefix): New variable for caching the result of `erc-parse-prefix' locally. (erc--parse-prefix): New function to cache reversed result of `erc-parse-prefix' in an `erc--parsed-prefix' object. (erc-channel-receive-names): Use `erc--parse-prefix'. * test/lisp/erc/erc-tests.el (erc--parse-prefix): New test. (Bug#67220) --- lisp/erc/erc-common.el | 7 +++++ lisp/erc/erc.el | 48 ++++++++++++++++++++++------------- test/lisp/erc/erc-tests.el | 52 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 90 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 683b05c3543..65cc4630156 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -105,6 +105,13 @@ erc--isupport-data "Abstract class for parsed 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 edcfcf085e6..125d9fcd3a1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6192,22 +6192,36 @@ 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 + "Current `erc--parsed-prefix' struct instance for the server.") + +(defun erc--parsed-prefix () + "Return possibly cached `erc--parsed-prefix' object for the server. +Ensure the returned value describes the most recent \"PREFIX\" +ISUPPORT parameter received from the current server, with the +original ordering intact. If no such parameter has yet arrived, +return a stand-in from the standard 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. @@ -6221,7 +6235,7 @@ erc-channel-receive-names 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..b61a601143a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -643,6 +643,58 @@ erc-parse-user (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"))) -- 2.41.0