procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Cache UI string for channel modes in ERC

Browse source 
* 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)
This commit is contained in:
F. Jason Park 2023-11-20 19:45:30 -08:00
parent 2fca889cfb
commit 5bc84a0c9e
4 changed files with 140 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
etc/ERC-NEWS
View file

@ -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

3
lisp/erc/erc-common.el
View file

@ -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)

98
lisp/erc/erc.el
View file

@ -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) ""))

51
test/lisp/erc/erc-tests.el
View file

@ -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)) '(() ())))