From: F. Jason Park Date: Tue, 14 Nov 2023 02:24:59 +0000 (-0800) Subject: Use caching variant of erc-parse-prefix internally X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e7fa460e1da3847456f03b9f508c6f6e5c09e450;p=emacs.git 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) --- 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")))