From: F. Jason Park Date: Tue, 21 Nov 2023 03:45:30 +0000 (-0800) Subject: Cache UI string for channel modes in ERC X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5bc84a0c9e4be93eada835ee41951296017c6faa;p=emacs.git Cache UI string for channel modes in ERC * etc/ERC-NEWS: Add entry for more expansive "%m" in header line. * lisp/erc/erc-common.el (erc--channel-mode-types): New slot `shortargs' for caching truncated mode args. * lisp/erc/erc.el (erc--mode-line-chanmodes-arg-len): New internal variable for adjusting the truncation length of channel-mode arguments as they appear in the header line. (erc--mode-line-mode-string): New variable for caching the relevant "modestring", if any, in ERC buffers. (erc--process-channel-modes): Don't associate args with group 4/D, which are all nullary modes. This fixes a bug in which arguments were associated with the wrong letters. Also, set cached mode string for channel. (erc--user-modes): Simplify slightly by removing likely useless variant for overloaded arg AS-TYPE. This function is new in ERC 5.6. (erc--channel-modes): New function. A higher-level getter for current channel mode representation to complement `erc--user-modes'. (erc--parse-user-modes): Set `erc--mode-line-mode-string in server buffers. (erc--handle-channel-mode): Change model to associate modes of type A with a running plus/minus tally of state changes since joining the channel. (erc-update-mode-line-buffer): Use cached verbose representation of channel or user modes instead of calling `erc-format-channel-modes'. * test/lisp/erc/erc-tests.el (erc--update-channel-modes): Update to reflect new running tally associations for type A modes. (erc--channel-modes): New test. (erc--user-modes): Update to reflect parameter simplification. (Bug#67220) --- diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3bb9a30cfb2..32272208704 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -253,6 +253,15 @@ whenever ERC rejects prompt input containing whitespace-only lines. When paired with option 'erc-send-whitespace-lines', ERC echoes a tally of blank lines padded and trailing blanks culled. +** A context-dependent mode segment in header and mode lines. +The "%m" specifier has traditionally expanded to a lone "+" in server +and query buffers and a string containing all switch modes (plus +"limit" and "key" args) in channel buffers. It now becomes a string +of user modes in server buffers and disappears completely in query +buffers. In channels, it's grown to include all letters and their +possibly truncated arguments, with the exception of stateful list +modes, like "b". + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index e876afe2644..8daedf9b019 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -116,7 +116,8 @@ Derived from the advertised \"PREFIX\" ISUPPORT parameter." (cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) "Server-local \"CHANMODES\" data." (fallbackp nil :type boolean) - (table (make-char-table 'erc--channel-mode-types) :type char-table)) + (table (make-char-table 'erc--channel-mode-types) :type char-table) + (shortargs (make-hash-table :test #'equal))) ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f4c3f77593c..0654da5e16d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6652,6 +6652,12 @@ or t, for type D.") "Possibly stale `erc--channel-mode-types' instance for the server. Use the getter of the same name to retrieve the current value.") +(defvar-local erc--mode-line-mode-string nil + "Computed mode-line or header-line component for user/channel modes.") + +(defvar erc--mode-line-chanmodes-arg-len 10 + "Max length at which to truncate channel-mode args in header line.") + (defun erc--channel-mode-types () "Return variable `erc--channel-mode-types', possibly initializing it." (erc--with-isupport-data CHANMODES erc--channel-mode-types @@ -6686,13 +6692,16 @@ complement relevant letters in STRING." (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) (erc--handle-channel-mode group c +p - (and (or (/= group ?c) +p) + (and (/= group ?d) + (or (/= group ?c) +p) (pop args))) t)) ((not fallbackp) (erc-display-message nil '(notice error) (erc-server-buffer) (format "Unknown channel mode: %S" c)))))) (setq erc-channel-modes (sort erc-channel-modes #'string<)) + (setq erc--mode-line-mode-string + (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len))) (erc-update-mode-line (current-buffer)))) (defvar-local erc--user-modes nil @@ -6703,16 +6712,60 @@ Analogous to `erc-channel-modes' but chars rather than strings.") "Return user \"MODE\" letters in a form described by AS-TYPE. When AS-TYPE is the symbol `strings' (plural), return a list of strings. When it's `string' (singular), return the same list -concatenated into a single string. When it's a single char, like -?+, return the same value as `string' but with AS-TYPE prepended. -When AS-TYPE is nil, return a list of chars." +concatenated into a single string. When AS-TYPE is nil, return a +list of chars." (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes)))) (pcase as-type ('strings (mapcar #'char-to-string modes)) ('string (apply #'string modes)) - ((and (pred characterp) c) (apply #'string (cons c modes))) (_ modes)))) +(defun erc--channel-modes (&optional as-type sep) + "Return channel \"MODE\" settings in a form described by AS-TYPE. +When AS-TYPE is the symbol `strings' (plural), return letter keys +as a list of sorted string. When it's `string' (singular), +return keys as a single string. When it's a number N, return a +single string consisting of the concatenated and sorted keys +followed by a space and then their corresponding args, each +truncated to N chars max. ERC joins these args together with +SEP, which defaults to a single space. Otherwise, return a +sorted alist of letter and arg pairs. In all cases that include +values, respect `erc-show-channel-key-p' and optionally omit the +secret key associated with the letter k." + (and-let* ((modes erc--channel-modes) + (tobj (erc--channel-mode-types)) + (types (erc--channel-mode-types-table tobj))) + (let (out) + (maphash (lambda (k v) + (unless (eq ?a (aref types k)) + (push (cons k + (and (not (eq t v)) + (not (and (eq k ?k) + (not (bound-and-true-p + erc-show-channel-key-p)))) + v)) + out))) + modes) + (setq out (cl-sort out #'< :key #'car)) + (pcase as-type + ('strings (mapcar (lambda (o) (char-to-string (car o))) out)) + ('string (apply #'string (mapcar #'car out))) + ((and (pred natnump) c) + (let (keys vals) + (pcase-dolist (`(,k . ,v) out) + (when v + (push (if (> (length v) c) + (with-memoization + (gethash (list c k v) + (erc--channel-mode-types-shortargs tobj)) + (truncate-string-to-width v c 0 nil t)) + v) + vals)) + (push k keys)) + (concat (apply #'string (nreverse keys)) (and vals " ") + (string-join (nreverse vals) (or sep " "))))) + (_ out))))) + (defun erc--parse-user-modes (string &optional current extrap) "Return lists of chars from STRING to add to and drop from CURRENT. Expect STRING to be a so-called \"modestring\", the second @@ -6743,11 +6796,14 @@ dropped were they not already absent." (defun erc--update-user-modes (string) "Update `erc--user-modes' from \"MODE\" STRING. Return its value, a list of characters sorted by character code." - (setq erc--user-modes - (pcase-let ((`(,adding ,dropping) - (erc--parse-user-modes string erc--user-modes))) - (sort (seq-difference (nconc erc--user-modes adding) dropping) - #'<)))) + (prog1 + (setq erc--user-modes + (pcase-let ((`(,adding ,dropping) + (erc--parse-user-modes string erc--user-modes))) + (sort (seq-difference (nconc erc--user-modes adding) dropping) + #'<))) + (setq erc--mode-line-mode-string + (concat "+" (erc--user-modes 'string))))) (defun erc--update-channel-modes (string &rest args) "Update `erc-channel-modes' and call individual mode handlers. @@ -6791,14 +6847,24 @@ expect STATE to be a boolean and ARGUMENT either a string or nil." (erc-log (format "Channel-mode %c (type %s, arg %S) %s" letter type arg (if state 'enabled 'disabled)))) -(cl-defmethod erc--handle-channel-mode :before (_ c state arg) - "Record STATE change and ARG, if enabling, for mode letter C." +(cl-defmethod erc--handle-channel-mode :before (type c state arg) + "Record STATE change for mode letter C. +When STATE is non-nil, add or update C's mapping in +`erc--channel-modes', associating it with ARG if C takes a +parameter and t otherwise. When STATE is nil, forget the +mapping. For type A, add up update a permanent mapping for C, +associating it with an integer indicating a running total of +STATE changes since joining the channel. In most cases, this +won't match the number known to the server." (unless erc--channel-modes (cl-assert (erc--target-channel-p erc--target)) (setq erc--channel-modes (make-hash-table))) - (if state - (puthash c (or arg t) erc--channel-modes) - (remhash c erc--channel-modes))) + (if (= type ?a) + (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1))) + (gethash c erc--channel-modes)) + (if state + (puthash c (or arg t) erc--channel-modes) + (remhash c erc--channel-modes)))) (cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _) "Update `erc-channel-modes' for any character C of nullary type D. @@ -8231,7 +8297,7 @@ shortened server name instead." (with-current-buffer buffer (let ((spec `((?a . ,(erc-format-away-status)) (?l . ,(erc-format-lag-time)) - (?m . ,(erc-format-channel-modes)) + (?m . ,(or erc--mode-line-mode-string "")) (?n . ,(or (erc-current-nick) "")) (?N . ,(erc-format-network)) (?o . ,(or (erc-controls-strip erc-channel-topic) "")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 8dbe44ce5ed..59ad65d65b4 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -796,13 +796,57 @@ (erc--update-channel-modes "+qu" "fool!*@*") (should (equal (pop calls) '(?d ?u t nil))) (should (equal (pop calls) '(?a ?q t "fool!*@*"))) - (should (equal "fool!*@*" (gethash ?q erc--channel-modes))) + (should (equal 1 (gethash ?q erc--channel-modes))) (should (eq t (gethash ?u erc--channel-modes))) (should (equal erc-channel-modes '("u"))) - (should-not (erc-channel-user-owner-p "bob"))) + (should-not (erc-channel-user-owner-p "bob")) + + ;; Remove fool!*@* from list mode "q". + (erc--update-channel-modes "-uq" "fool!*@*") + (should (equal (pop calls) '(?a ?q nil "fool!*@*"))) + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should (equal 0 (gethash ?q erc--channel-modes)))) (should-not calls)))) +(ert-deftest erc--channel-modes () + (setq erc--isupport-params (make-hash-table) + erc--target (erc--target-from-string "#test") + erc-server-parameters + '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz"))) + + (erc-tests--set-fake-server-process "sleep" "1") + + (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore)) + (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2")) + + (should (equal (erc--channel-modes 'string) "klt")) + (should (equal (erc--channel-modes 'strings) '("k" "l" "t"))) + (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t)))) + (should (equal (erc--channel-modes 3 ",") "klt h2,3")) + + ;; Truncation cache populated and used. + (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types)) + first-run) + (should (zerop (hash-table-count cache))) + (should (equal (erc--channel-modes 1 ",") "klt h,3")) + (should (equal (setq first-run (map-pairs cache)) '(((1 ?k "h2") . "h")))) + (cl-letf (((symbol-function 'truncate-string-to-width) + (lambda (&rest _) (ert-fail "Shouldn't run")))) + (should (equal (erc--channel-modes 1 ",") "klt h,3"))) + ;; Same key for only entry matches that of first result. + (should (pcase (map-pairs cache) + ((and '(((1 ?k "h2") . "h")) second-run) + (eq (pcase first-run (`((,k . ,_)) k)) + (pcase second-run (`((,k . ,_)) k))))))) + + (should (equal (erc--channel-modes 0 ",") "klt ,")) + (should (equal (erc--channel-modes 2) "klt h2 3")) + (should (equal (erc--channel-modes 1) "klt h 3")) + (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces + (ert-deftest erc--update-user-modes () (let ((erc--user-modes (list ?a))) (should (equal (erc--update-user-modes "+a") '(?a))) @@ -818,8 +862,7 @@ (let ((erc--user-modes '(?a ?b))) (should (equal (erc--user-modes) '(?a ?b))) (should (equal (erc--user-modes 'string) "ab")) - (should (equal (erc--user-modes 'strings) '("a" "b"))) - (should (equal (erc--user-modes '?+) "+ab")))) + (should (equal (erc--user-modes 'strings) '("a" "b"))))) (ert-deftest erc--parse-user-modes () (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))