* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
@ 2023-11-16 2:13 J.P.
2023-11-17 18:30 ` J.P.
[not found] ` <87zfzcnsg1.fsf@neverwas.me>
0 siblings, 2 replies; 5+ messages in thread
From: J.P. @ 2023-11-16 2:13 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5235 bytes --]
Tags: patch
In the early days of IRC, parsing a "MODE" command from the server was
comparatively straightforward. There were a few well known letters, some
taking a single argument, and a standard set of status prefixes. But
somewhere along the line, things got more complicated, and it seems ERC
never got the memo. While it may appear obvious that sticking to a
hard-coded, heuristics based approach doesn't really accommodate ERC's
core tenet of extensibility, the risk of shifting toward something more
parameter driven was probably never justifiable without a vocal demand.
Or an obvious bug.
From emacs -Q:
1. Connect to Libera.Chat
2. Create ##mychan
3. /mode ##mychan +Qu
debugger entered--Lisp error: (wrong-type-argument char-or-string-p nil)
erc-downcase(nil)
erc-update-current-channel-member(nil nil nil nil nil nil nil on ...)
erc-update-channel-member("#libera" nil nil nil nil nil nil nil on)
erc-update-modes("##mychan" "+Qu" "mynick" "user/foo" "Hi!")
The issue here is that ERC doesn't account for ISUPPORT parameters when
parsing MODE commands and dispatching handlers. Instead, it simply
assumes that +q (or +Q) means someone has just been promoted to a
channel owner.
I'll admit that although I've been aware of this basic issue for quite
some time, I've been hesitant to cross this bridge until 5.7+ because of
the potential pitfalls involved. In any case, with a concrete bug having
surfaced (courtesy of Corwin), the issue has been forced, and it's one
that can't really be papered over responsibly just to avoid holding up
the current release. My proposed means of addressing this is mainly
contained in the last of the attached patches. The approach comes down
to rewriting the most important bits and providing adapters to reroute
the rest accordingly. Comments welcome, as always. Thanks.
In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
3.24.38, cairo version 1.17.6) of 2023-11-15 built on localhost
Repository revision: ff1f82cbe3fa9aee354581f2798faaae7163ea44
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 37 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
'CFLAGS=-O0 -g3'
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
minibuffer-regexp-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config gnus-util
text-property-search time-date mm-decode mm-bodies mm-encode mail-parse
rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045
ietf-drums mm-util mail-prsvr mail-utils erc derived auth-source eieio
eieio-core password-cache json map format-spec erc-backend erc-networks
easy-mmode byte-opt bytecomp byte-compile erc-common inline erc-compat
cl-seq cl-macs gv pcase rx subr-x cl-loaddefs cl-lib erc-loaddefs rmc
iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook
vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win
term/common-win x-dnd touch-screen tool-bar dnd fontset image regexp-opt
fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode
register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select
scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors
frame minibuffer nadvice seq simple cl-generic indonesian philippine
cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao
korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech
european ethiopic indian cyrillic chinese composite emoji-zwj charscript
charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure
cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp
files window text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget keymap hashtable-print-readable backquote
threads dbusbind inotify lcms2 dynamic-setting system-font-setting
font-render-setting cairo gtk x-toolkit xinput2 x multi-tty move-toolbar
make-network-process emacs)
Memory information:
((conses 16 123590 9232) (symbols 48 10137 0) (strings 32 24791 2241)
(string-bytes 1 837965) (vectors 16 14517)
(vector-slots 8 204449 15354) (floats 8 24 31) (intervals 56 245 0)
(buffers 984 10))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Use-caching-variant-of-erc-parse-prefix-internal.patch --]
[-- Type: text/x-patch, Size: 5855 bytes --]
From 77ac1ba798d1896408fab2e25e57efd32596aa18 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Nov 2023 18:24:59 -0800
Subject: [PATCH 1/3] [5.6] Use caching variant of erc-parse-prefix internally
* lisp/erc/erc.el (erc-parse-prefix): Rework slightly for readability.
(erc--parsed-prefix): New variable and struct for caching the result
of `erc-parse-prefix' locally.
(erc--parse-prefix): New function to cache reversed result of
`erc-parse-prefix'.
* test/lisp/erc/erc-tests.el (erc--parse-prefix): New test.
---
lisp/erc/erc.el | 63 ++++++++++++++++++++++++++++----------
test/lisp/erc/erc-tests.el | 39 +++++++++++++++++++++++
2 files changed, 86 insertions(+), 16 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index edcfcf085e6..bbbbc405526 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6192,22 +6192,53 @@ 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
+ "Cons of latest advertised PREFIX and its parsed alist.
+Only usable for the current server session.")
+
+;; As of ERC 5.6, `erc-channel-receive-names' is the only caller, and
+;; it runs infrequently. In the future, extensions, like
+;; `multi-prefix', may benefit more from a two-way translation table.
+(cl-defstruct erc--parsed-prefix
+ "Server-local channel-membership-prefix data."
+ (key nil :type (or null string))
+ (letters "qaohv" :type string)
+ (statuses "~&@%+" :type string)
+ (alist nil :type (list-of cons)))
+
+(defun erc--parse-prefix ()
+ "Return (possibly cached) status prefix translation alist for the server.
+Ensure the returned value describes the most recent \"PREFIX\"
+ISUPPORT parameter received from the current server and that the
+original ordering is preserved."
+ (erc-with-server-buffer
+ (let ((key (erc--get-isupport-entry 'PREFIX)))
+ (or (and key
+ erc--parsed-prefix
+ (eq (cdr key) (erc--parsed-prefix-key erc--parsed-prefix))
+ (erc--parsed-prefix-alist erc--parsed-prefix))
+ (let ((alist (nreverse (erc-parse-prefix))))
+ (setq erc--parsed-prefix
+ (make-erc--parsed-prefix
+ :key (cdr key)
+ :letters (apply #'string (map-keys alist))
+ :statuses (apply #'string (map-values alist))
+ :alist alist))
+ alist)))))
(defcustom erc-channel-members-changed-hook nil
"This hook is called every time the variable `channel-members' changes.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index e7422d330c0..28bf1fbcccc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -643,6 +643,45 @@ erc-parse-user
(should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
+(ert-deftest erc--parse-prefix ()
+ (erc-mode)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc--isupport-params (make-hash-table)
+ 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--parse-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 (erc--parsed-prefix-alist cached) (erc--parse-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 (erc--parsed-prefix-alist cached) (erc--parse-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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Fix-ISUPPORT-cache-misses-in-ERC-target-buffers.patch --]
[-- Type: text/x-patch, Size: 1863 bytes --]
From cb01fdb193755cf470bc1193ca89168f47d40641 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Nov 2023 18:24:59 -0800
Subject: [PATCH 2/3] [5.6] Fix ISUPPORT cache misses in ERC target buffers
* lisp/erc/erc-backend.el (erc--get-isupport-entry): Check server for
`erc-server-parameters' if it's empty in the current buffer.
* test/lisp/erc/erc-scenarios-display-message.el: Remove stray
`require'.
---
lisp/erc/erc-backend.el | 4 +++-
test/lisp/erc/erc-scenarios-display-message.el | 2 --
2 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9281c107d06..2242b40e9a4 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -2096,7 +2096,9 @@ erc--get-isupport-entry
(erc-with-server-buffer erc--isupport-params)))
(value (with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
- erc-server-parameters)))
+ (or erc-server-parameters
+ (erc-with-server-buffer
+ erc-server-parameters)))))
(if (cdr v)
(erc--parse-isupport-value (cdr v))
'--empty--)))))
diff --git a/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
index 51bdf305ad5..5751a32212d 100644
--- a/test/lisp/erc/erc-scenarios-display-message.el
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -59,6 +59,4 @@ erc-scenarios-display-message--multibuf
(erc-cmd-QUIT "")))
-(eval-when-compile (require 'erc-join))
-
;;; erc-scenarios-display-message.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Rework-MODE-handling-in-ERC.patch --]
[-- Type: text/x-patch, Size: 30142 bytes --]
From b57325022457ad86ae990f8cd6275a284c4912f0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 14 Nov 2023 21:10:39 -0800
Subject: [PATCH 3/3] [5.6] Rework MODE handling in ERC
* etc/ERC-NEWS: Mention shift toward CHANMODES ISUPPORT parameter for
dictating parsing behavior.
* lisp/erc/erc-backend.el (erc--init-channel-modes, erc-update-modes,
erc-set-modes, erc-update-modes): Forward declarations, the last two
being removals.
(erc-server-MODE, erc-server-221): Call `erc--update-modes' instead of
`erc-update-modes'.
(erc-server-324): Call `erc--init-channel-modes' instead of
`erc-set-modes'.
* lisp/erc/erc.el (erc-channel-modes): Fix doc string.
(erc-set-initial-user-mode): Display a local notice when requesting
redundant user MODE operations.
(erc-set-modes, erc-parse-modes, erc-update-modes): Deprecate.
(erc--update-membership-prefix): New function, a helper for specifying
unruly `erc-update-current-channel-member' parameters.
(erc--update-channel-modes-omit-status-p): New internal variable.
(erc--update-channel-modes): New function to replace
much of `erc-update-modes'.
(erc--user-modes): New local variable for remembering user modes per
server. New function of the same name, a getter for that variable.
(erc--parse-user-modes): New function to parse user modes only.
(erc--merge-user-modes): New function, a helper for deduping
`erc--user-modes' after adding or removing.
(erc--update-modes): New function to dispatch correct parsing and
updating function for the current buffer context.
(erc--init-channel-modes): New function to update channel mode letters
while skipping status prefixes.
(erc--handle-channel-mode): New internal generic function, a
placeholder for eventual API to handle specific unary modes.
(erc-update-channel-limit): Update doc string.
(erc-message-english-user-mode-redundant-add,
erc-message-english-user-mode-redundant-drop): New English catalog
messages.
* test/lisp/erc/erc-scenarios-base-chan-modes.el: New file.
* test/lisp/erc/erc-tests.el (erc-parse-modes,
erc--update-channel-modes): New tests.
* test/lisp/erc/resources/base/modes/chan-changed.eld: New file.
---
etc/ERC-NEWS | 11 ++
lisp/erc/erc-backend.el | 11 +-
lisp/erc/erc.el | 171 +++++++++++++++++-
.../lisp/erc/erc-scenarios-base-chan-modes.el | 84 +++++++++
test/lisp/erc/erc-tests.el | 86 +++++++++
.../erc/resources/base/modes/chan-changed.eld | 55 ++++++
6 files changed, 402 insertions(+), 16 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-chan-modes.el
create mode 100644 test/lisp/erc/resources/base/modes/chan-changed.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 04b11fc19f0..3bb9a30cfb2 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -480,6 +480,17 @@ release lacks a similar solution for detecting "joinedness" directly,
but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target'
as a makeshift kludge.
+*** Channel-mode handling has become stricter and more predictable.
+ERC has always processed channel modes using "standardized" letters
+and popular status prefixes. Starting with this release, ERC will
+begin preferring advertised "CHANMODES" when interpreting letters and
+their arguments. To facilitate this transition, the functions
+'erc-set-modes', 'erc-parse-modes', and 'erc-update-modes', have all
+been provisionally deprecated. Expect a new, replacement API for
+handling specific "MODE" types and letters in coming releases. If
+you'd like a say in shaping how this transpires, please share your
+ideas and use cases on the tracker.
+
*** Miscellaneous changes
Two helper macros from GNU ELPA's Compat library are now available to
third-party modules as 'erc-compat-call' and 'erc-compat-function'.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 2242b40e9a4..ace46cf84f5 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -132,8 +132,10 @@ erc-reuse-buffers
(defvar erc-verbose-server-ping)
(defvar erc-whowas-on-nosuchnick)
+(declare-function erc--init-channel-modes "erc" (channel raw-args))
(declare-function erc--open-target "erc" (target))
(declare-function erc--target-from-string "erc" (string))
+(declare-function erc--update-modes "erc" (raw-args))
(declare-function erc-active-buffer "erc" nil)
(declare-function erc-add-default-channel "erc" (channel))
(declare-function erc-banlist-update "erc" (proc parsed))
@@ -179,7 +181,6 @@ erc-whowas-on-nosuchnick
(declare-function erc-server-buffer "erc" nil)
(declare-function erc-set-active-buffer "erc" (buffer))
(declare-function erc-set-current-nick "erc" (nick))
-(declare-function erc-set-modes "erc" (tgt mode-string))
(declare-function erc-time-diff "erc" (t1 t2))
(declare-function erc-trim-string "erc" (s))
(declare-function erc-update-mode-line "erc" (&optional buffer))
@@ -194,8 +195,6 @@ erc-whowas-on-nosuchnick
(proc parsed nick login host msg))
(declare-function erc-update-channel-topic "erc"
(channel topic &optional modify))
-(declare-function erc-update-modes "erc"
- (tgt mode-string &optional _nick _host _login))
(declare-function erc-update-user-nick "erc"
(nick &optional new-nick host login full-name info))
(declare-function erc-open "erc"
@@ -1802,7 +1801,7 @@ erc--server-determine-join-display-context
(t (erc-get-buffer tgt)))))
(with-current-buffer (or buf
(current-buffer))
- (erc-update-modes tgt mode nick host login))
+ (erc--update-modes (cdr (erc-response.command-args parsed))))
(if (or (string= login "") (string= host ""))
(erc-display-message parsed 'notice buf
'MODE-nick ?n nick
@@ -2144,7 +2143,7 @@ erc--get-isupport-entry
(let* ((nick (car (erc-response.command-args parsed)))
(modes (mapconcat #'identity
(cdr (erc-response.command-args parsed)) " ")))
- (erc-set-modes nick modes)
+ (erc--update-modes (cdr (erc-response.command-args parsed)))
(erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
(define-erc-response-handler (252)
@@ -2310,7 +2309,7 @@ erc-server-322-message
(let ((channel (cadr (erc-response.command-args parsed)))
(modes (mapconcat #'identity (cddr (erc-response.command-args parsed))
" ")))
- (erc-set-modes channel modes)
+ (erc--init-channel-modes channel (cddr (erc-response.command-args parsed)))
(erc-display-message
parsed 'notice (erc-get-buffer channel proc)
's324 ?c channel ?m modes)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index bbbbc405526..8a74414cb0c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -732,9 +732,9 @@ erc-channel-topic
"A topic string for the channel. Should only be used in channel-buffers.")
(defvar-local erc-channel-modes nil
- "List of strings representing channel modes.
-E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
-\(not sure the ban list will be here, but why not)")
+ "List of letters, as strings, representing channel modes.
+For example, (\"i\" \"m\" \"s\"). Modes that take accompanying
+parameters are not included.")
(defvar-local erc-insert-marker nil
"The place where insertion of new text in erc buffers should happen.")
@@ -4552,6 +4552,10 @@ erc--send-message-nested
(erc--send-input-lines (erc--run-send-hooks lines-obj)))
t)
+;; FIXME if the user types /MODE<RET>, LINE becomes "\n", which
+;; matches the pattern, so "\n" is sent to the server. Perhaps
+;; instead of `do-not-parse-args', this should just join &rest
+;; arguments.
(defun erc-cmd-MODE (line)
"Change or display the mode value of a channel or user.
The first word specifies the target. The rest is the mode string
@@ -5914,9 +5918,19 @@ erc-set-initial-user-mode
The server buffer is given by BUFFER."
(with-current-buffer buffer
(when erc-user-mode
- (let ((mode (if (functionp erc-user-mode)
- (funcall erc-user-mode)
- erc-user-mode)))
+ (let* ((mode (if (functionp erc-user-mode)
+ (funcall erc-user-mode)
+ erc-user-mode))
+ (as-pair (erc--parse-user-modes mode))
+ (have (erc--user-modes))
+ (redundant-want (seq-intersection (car as-pair) have))
+ (redundant-drop (seq-difference (cadr as-pair) have)))
+ (when redundant-want
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-add
+ ?m (apply #'string redundant-want)))
+ (when redundant-drop
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-drop
+ ?m (apply #'string redundant-drop)))
(when (stringp mode)
(erc-log (format "changing mode for %s to %s" nick mode))
(erc-server-send (format "MODE %s %s" nick mode)))))))
@@ -6488,7 +6502,9 @@ erc-update-channel-topic
(defun erc-set-modes (tgt mode-string)
"Set the modes for the TGT provided as MODE-STRING."
- (let* ((modes (erc-parse-modes mode-string))
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
;; list of triples: (mode-char 'on/'off argument)
(arg-modes (nth 2 modes)))
@@ -6534,6 +6550,7 @@ erc-parse-modes
arg-modes is a list of triples of the form:
(MODE-CHAR ON/OFF ARGUMENT)."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
(let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
;; arguments in channel modes
@@ -6578,8 +6595,10 @@ erc-update-modes
"Update the mode information for TGT, provided as MODE-STRING.
Optional arguments: NICK, HOST and LOGIN - the attributes of the
person who changed the modes."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
;; FIXME: neither of nick, host, and login are used!
- (let* ((modes (erc-parse-modes mode-string))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
(remove-modes (nth 1 modes))
;; list of triples: (mode-char 'on/'off argument)
@@ -6628,9 +6647,137 @@ erc-update-modes
;; nick modes - ignored at this point
(t nil))))
+(defun erc--update-membership-prefix (nick letter state)
+ "Update status prefixes for NICK in current channel buffer.
+Expect LETTER to be a status char and STATE to be a boolean."
+ (erc-update-current-channel-member nick nil nil
+ (and (= letter ?v) state)
+ (and (= letter ?h) state)
+ (and (= letter ?o) state)
+ (and (= letter ?a) state)
+ (and (= letter ?q) state)))
+
+(defvar erc--update-channel-modes-omit-status-p nil)
+
+(defun erc--update-channel-modes (string &rest args)
+ "Update `erc-channel-modes' and dispatch individual mode handlers.
+Also update status prefixes, as needed. Expect STRING to be a
+\"modestring\" and ARGS to match mode-specific parameters. When
+`erc--update-channel-modes-omit-status-p' is non-nil, forgo
+setting status prefixes for channel members."
+ (cl-assert erc-server-process)
+ (cl-assert erc--target)
+ (cl-assert (erc--target-channel-p erc--target))
+ (pcase-let* ((status-letters
+ (and (not erc--update-channel-modes-omit-status-p)
+ (or (erc-with-server-buffer
+ (erc--parse-prefix)
+ (erc--parsed-prefix-letters erc--parsed-prefix))
+ "qaovhbQAOVHB")))
+ (`(,type-a ,type-b ,type-c ,type-d)
+ (or (cdr (erc--get-isupport-entry 'CHANMODES))
+ '(nil "Kk" "Ll" nil)))
+ (+p t))
+ (dolist (c (append string nil))
+ (let ((letter (char-to-string c)))
+ (cond ((= ?+ c) (setq +p t))
+ ((= ?- c) (setq +p nil))
+ ((and status-letters (string-search letter status-letters))
+ (erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
+ ((and type-a (string-search letter type-a))
+ (erc--handle-channel-mode 'a c +p (pop args)))
+ ((string-search letter type-b)
+ (erc--handle-channel-mode 'b c +p (pop args)))
+ ((string-search letter type-c)
+ (erc--handle-channel-mode 'c c +p (and +p (pop args))))
+ ((or (null type-d) (string-search letter type-d))
+ (setq erc-channel-modes
+ (if +p
+ (cl-pushnew letter erc-channel-modes :test #'equal)
+ (delete letter erc-channel-modes))))
+ (type-d ; OK to print error because server buffer exists
+ (erc-display-message nil '(notice error) (erc-server-buffer)
+ (format "Unknown channel mode: %S" c))))))
+ (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
+ (erc-update-mode-line (current-buffer))))
+
+(defvar-local erc--user-modes nil
+ "List of current user modes, analogous to `erc-channel-modes'.")
+
+(defun erc--user-modes (&optional as-string-p)
+ "Return user mode letters as chars or, with AS-STRING-P, a single string."
+ (let ((modes (erc-with-server-buffer erc--user-modes)))
+ (if as-string-p
+ (apply #'string (if (memq as-string-p '(+ ?+)) (cons '?+ modes) modes))
+ modes)))
+
+(defun erc--parse-user-modes (string)
+ "Return a list of mode chars to add and remove, based on STRING."
+ (let ((addp t)
+ add-modes remove-modes)
+ (seq-doseq (c string)
+ (pcase c
+ (?+ (setq addp t))
+ (?- (setq addp nil))
+ (_ (push c (if addp add-modes remove-modes)))))
+ (list (nreverse add-modes)
+ (nreverse remove-modes))))
+
+(defun erc--merge-user-modes (adding dropping)
+ "Update `erc--user-modes' with chars ADDING and DROPPING."
+ (sort (seq-difference (seq-union erc--user-modes adding) dropping) #'-))
+
+;; XXX this comment is referenced elsewhere (grep before deleting).
+;;
+;; The function `erc-update-modes' was deprecated in ERC 5.6 with no
+;; immediate public replacement. Third parties needing such a thing
+;; are encouraged to write to emacs-erc@gnu.org with ideas for a
+;; mode-handler API, possibly one incorporating mode-letter specific
+;; handlers, like `erc--handle-channel-mode' below.
+(defun erc--update-modes (raw-args)
+ "Handle user or channel mode update from server.
+Expect RAW-ARGS to be a \"modestring\" followed by mode-specific
+arguments."
+ (if (and erc--target (erc--target-channel-p erc--target))
+ (apply #'erc--update-channel-modes raw-args)
+ (setq erc--user-modes
+ (apply #'erc--merge-user-modes
+ (erc--parse-user-modes (car raw-args))))))
+
+(defun erc--init-channel-modes (channel raw-args)
+ "Set CHANNEL modes from RAW-ARGS."
+ (let ((erc--update-channel-modes-omit-status-p t))
+ (erc-with-buffer (channel)
+ (apply #'erc--update-channel-modes raw-args))))
+
+(cl-defgeneric erc--handle-channel-mode (type letter state arg)
+ "Handle a STATE change for mode LETTER of TYPE with ARG.
+Expect to be called in the affected target buffer. Expect TYPE
+to be a symbol, namely, one of `a', `b', `c', or `d'. Expect
+LETTER to be a character, STATE to be a boolean, and ARGUMENT to
+be either a string or nil."
+ (erc-log (format "Channel-mode %c (type %s, arg %S) %s"
+ letter type arg (if state 'enabled 'disabled))))
+
+;; We could specialize on (eql 'c), but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
+ (erc-update-channel-limit (erc--target-string erc--target)
+ (if state 'on 'off)
+ arg))
+
+;; We could specialize on (eql 'b), but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg)
+ ;; Mimic old parsing behavior in which an ARG of "*" was discarded
+ ;; even though `erc-update-channel-limit' checks STATE first.
+ (erc-update-channel-key (erc--target-string erc--target)
+ (if state 'on 'off)
+ (if (equal arg "*") nil arg)))
+
(defun erc-update-channel-limit (channel onoff n)
- ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
- "Update CHANNEL's user limit to N."
+ "Update CHANNEL's user limit to N.
+Expect ONOFF to be `on' when the mode is being enabled and `off'
+otherwise. And because this mode is of \"type C\", expect N to
+be non-nil only when enabling."
(if (or (not (eq onoff 'on))
(and (stringp n) (string-match "^[0-9]+$" n)))
(erc-with-buffer
@@ -8306,6 +8453,10 @@ erc-define-catalog
(ops . "%i operator%s: %o")
(ops-none . "No operators in this channel.")
(undefined-ctcp . "Undefined CTCP query received. Silently ignored")
+ (user-mode-redundant-add
+ . "Already have user mode(s): %m. Requesting again anyway.")
+ (user-mode-redundant-drop
+ . "Already without user mode(s): %m. Requesting removal anyway.")
(variable-not-bound . "Variable not bound!")
(ACTION . "* %n %a")
(CTCP-CLIENTINFO . "Client info for %n: %m")
diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el
new file mode 100644
index 00000000000..9c63d8aff8e
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el
@@ -0,0 +1,84 @@
+;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; This asserts that a bug present in ERC 5.4+ is now absent.
+;; Previously, ERC would attempt to parse a nullary channel mode as if
+;; it were a status prefix update, which led to a wrong-type error.
+;; This test does not address similar collisions with unary modes,
+;; such as "MODE +q foo!*@*", but it should.
+(ert-deftest erc-scenarios-base-chan-modes--plus-q ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'chan-changed))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to Libera.Chat")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "changed mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+
+ (ert-info ("Receive notice that mode has changed")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ (erc-scenarios-common-say "ready before")
+ (funcall expect 10 "<Chad> before")
+ (funcall expect 10 " has changed mode for #chan to +Qu")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Key stored locally")
+ (erc-scenarios-common-say "ready key")
+ (funcall expect 10 "<Chad> doing key")
+ (funcall expect 10 " has changed mode for #chan to +k hunter2")
+ (should (equal erc-channel-key "hunter2")))
+
+ (ert-info ("Limit stored locally")
+ (erc-scenarios-common-say "ready limit")
+ (funcall expect 10 "<Chad> doing limit")
+ (funcall expect 10 " has changed mode for #chan to +l 3")
+ (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
+ (should (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Modes removed and local state deletion succeeds")
+ (erc-scenarios-common-say "ready drop")
+ (funcall expect 10 "<Chad> dropping")
+ (funcall expect 10 " has changed mode for #chan to -lu")
+ (funcall expect 10 " has changed mode for #chan to -Qk *")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))))
+
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+ (funcall expect 10 "<Chad> after"))))
+
+;;; erc-scenarios-base-chan-modes.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 28bf1fbcccc..1ff5f4890a8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -682,6 +682,92 @@ erc--parse-prefix
(erc-with-server-buffer erc--parsed-prefix))
expected)))))
+;; This tests exists to prove legacy behavior in order to incorporate
+;; it as a fallback in the 5.6+ replacement.
+(ert-deftest erc-parse-modes ()
+ (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (should (equal (erc-parse-modes "+u") '(("u") nil nil)))
+ (should (equal (erc-parse-modes "-u") '(nil ("u") nil)))
+ (should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob")))))
+ (should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+uo-tv bob alice")
+ '(("u") ("t") (("o" on "bob") ("v" off "alice")))))
+
+ (ert-info ("Modes of type B are always grouped as unary")
+ (should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2")))))
+ ;; Channel key args are thrown away.
+ (should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil))))))
+
+ (ert-info ("Modes of type C are grouped as unary even when disabling")
+ (should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3")))))
+ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
+
+(ert-deftest erc--update-channel-modes ()
+ (erc-mode)
+ (setq erc-channel-users (make-hash-table :test #'equal)
+ erc-server-users (make-hash-table :test #'equal)
+ erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test"))
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (let (calls)
+ (cl-letf (((symbol-function 'erc--handle-channel-mode)
+ (lambda (&rest r) (push r calls)))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+
+ (ert-info ("Unknown user not created")
+ (erc--update-channel-modes "+o" "bob")
+ (should-not (erc-get-channel-user "bob")))
+
+ (ert-info ("Status updated when user known")
+ (puthash "bob" (cons (erc-add-server-user
+ "bob" (make-erc-server-user :nickname "bob"))
+ (make-erc-channel-user))
+ erc-channel-users)
+ ;; Also asserts fallback behavior for traditional prefixes.
+ (should-not (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "+o" "bob")
+ (should (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "-o" "bob") ; status revoked
+ (should-not (erc-channel-user-op-p "bob")))
+
+ (ert-info ("Unknown nullary added and removed")
+ (should-not erc-channel-modes)
+ (erc--update-channel-modes "+u")
+ (should (equal erc-channel-modes '("u")))
+ (erc--update-channel-modes "-u")
+ (should-not erc-channel-modes)
+ (should-not calls))
+
+ (ert-info ("Fallback for Type B includes mode letter k")
+ (erc--update-channel-modes "+k" "h2")
+ (should (equal (pop calls) '(b ?k t "h2")))
+ (should-not erc-channel-modes)
+ (erc--update-channel-modes "-k" "*")
+ (should (equal (pop calls) '(b ?k nil "*")))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Fallback for Type C includes mode letter l")
+ (erc--update-channel-modes "+l" "3")
+ (should (equal (pop calls) '(c ?l t "3")))
+ (should-not erc-channel-modes)
+ (erc--update-channel-modes "-l" nil)
+ (should (equal (pop calls) '(c ?l nil nil)))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Advertised supersedes heuristics")
+ (setq erc-server-parameters
+ '(("PREFIX" . "(ov)@+")
+ ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+ (erc--update-channel-modes "+qu" "fool!*@*")
+ (should (equal (pop calls) '(a ?q t "fool!*@*")))
+ (should (equal erc-channel-modes '("u")))
+ (should-not (erc-channel-user-owner-p "bob")))
+
+ (should-not calls))))
+
(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")))
diff --git a/test/lisp/erc/resources/base/modes/chan-changed.eld b/test/lisp/erc/resources/base/modes/chan-changed.eld
new file mode 100644
index 00000000000..6cf6596b0b2
--- /dev/null
+++ b/test/lisp/erc/resources/base/modes/chan-changed.eld
@@ -0,0 +1,55 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
+ (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
+ (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC")
+ (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
+ (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers")
+ (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
+ (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
+ (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
+ (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
+ (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187")
+ (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827")
+ (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)")
+ (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ")
+ (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)")
+ (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
+ (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat")
+ (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
+ (0.00 ":tester MODE tester :+Ziw"))
+
+((mode-tester 10 "MODE tester +i"))
+
+((join-chan 10 "JOIN #chan")
+ (0.09 ":tester!~tester@127.0.0.1 JOIN #chan"))
+
+((mode-chan 10 "MODE #chan")
+ (0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy")
+ (0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.")
+ (0.00 ":cadmium.libera.chat 324 tester #chan +nt")
+ (0.01 ":cadmium.libera.chat 329 tester #chan 1621432263"))
+
+((privmsg-before 10 "PRIVMSG #chan :ready before")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu"))
+
+((privmsg-key 10 "PRIVMSG #chan :ready key")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2"))
+
+((privmsg-limit 10 "PRIVMSG #chan :ready limit")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3"))
+
+((privmsg-drop 10 "PRIVMSG #chan :ready drop")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after"))
+
+((drop 0 DROP))
--
2.41.0
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
2023-11-16 2:13 bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC J.P.
@ 2023-11-17 18:30 ` J.P.
[not found] ` <87zfzcnsg1.fsf@neverwas.me>
1 sibling, 0 replies; 5+ messages in thread
From: J.P. @ 2023-11-17 18:30 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 238 bytes --]
v2. Account for nonstandard CHANMODES beyond type D. Make mode-letter
handling more extensible and modular. Provide convenience macro for
caching processed data originating from ISUPPORT values. Retain original
parsed channel-mode data.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 27552 bytes --]
From 8f7f44aeca735a988c9eb0a18aca3497f07c8480 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 17 Nov 2023 06:58:44 -0800
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Make wrangling ISUPPORT data more convenient in ERC
[5.6] Use caching variant of erc-parse-prefix internally
[5.6] Rework MODE processing in ERC
etc/ERC-NEWS | 11 +
lisp/erc/erc-backend.el | 27 +-
lisp/erc/erc-common.el | 16 +
lisp/erc/erc.el | 279 ++++++++++++++++--
.../lisp/erc/erc-scenarios-base-chan-modes.el | 84 ++++++
.../lisp/erc/erc-scenarios-display-message.el | 2 -
test/lisp/erc/erc-tests.el | 198 +++++++++++++
.../erc/resources/base/modes/chan-changed.eld | 55 ++++
8 files changed, 636 insertions(+), 36 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-chan-modes.el
create mode 100644 test/lisp/erc/resources/base/modes/chan-changed.eld
Interdiff:
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index ace46cf84f5..7b5d1e35189 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -2107,6 +2107,18 @@ erc--get-isupport-entry
(when table
(remhash key table))))
+(defmacro erc--with-isupport-data (param var &rest body)
+ "Return processed data for \"ISUPPORT\" PARAM value stored VAR.
+Expect VAR's value to be an instance of an object whose \"class\"
+inherits from `erc--isupport-data'. If VAR is uninitialized or
+stale, evaluate BODY and assign the result to VAR."
+ (declare (indent defun))
+ `(erc-with-server-buffer
+ (pcase-let (((,@(list '\` (list param '\, 'key)))
+ (erc--get-isupport-entry ',param)))
+ (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var)
+ (setq ,var (progn ,@body))))))
+
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 930e8032f6d..48d29883d8f 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -101,6 +101,22 @@ erc--target
(contents "" :type string)
(tags '() :type list))
+(cl-defstruct 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)))
+
+(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))
+
;; 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 8a74414cb0c..78a4f363af2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5921,10 +5921,10 @@ erc-set-initial-user-mode
(let* ((mode (if (functionp erc-user-mode)
(funcall erc-user-mode)
erc-user-mode))
- (as-pair (erc--parse-user-modes mode))
- (have (erc--user-modes))
- (redundant-want (seq-intersection (car as-pair) have))
- (redundant-drop (seq-difference (cadr as-pair) have)))
+ (groups (erc--parse-user-modes mode (erc--user-modes) t))
+ (superfluous (last groups 2))
+ (redundant-want (car superfluous))
+ (redundant-drop (cadr superfluous)))
(when redundant-want
(erc-display-message nil 'notice buffer 'user-mode-redundant-add
?m (apply #'string redundant-want)))
@@ -6221,38 +6221,21 @@ erc-parse-prefix
collected))
(defvar-local erc--parsed-prefix nil
- "Cons of latest advertised PREFIX and its parsed alist.
-Only usable for the current server session.")
-
-;; As of ERC 5.6, `erc-channel-receive-names' is the only caller, and
-;; it runs infrequently. In the future, extensions, like
-;; `multi-prefix', may benefit more from a two-way translation table.
-(cl-defstruct erc--parsed-prefix
- "Server-local channel-membership-prefix data."
- (key nil :type (or null string))
- (letters "qaohv" :type string)
- (statuses "~&@%+" :type string)
- (alist nil :type (list-of cons)))
-
-(defun erc--parse-prefix ()
- "Return (possibly cached) status prefix translation alist for the server.
+ "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 and that the
-original ordering is preserved."
- (erc-with-server-buffer
- (let ((key (erc--get-isupport-entry 'PREFIX)))
- (or (and key
- erc--parsed-prefix
- (eq (cdr key) (erc--parsed-prefix-key erc--parsed-prefix))
- (erc--parsed-prefix-alist erc--parsed-prefix))
- (let ((alist (nreverse (erc-parse-prefix))))
- (setq erc--parsed-prefix
- (make-erc--parsed-prefix
- :key (cdr key)
- :letters (apply #'string (map-keys alist))
- :statuses (apply #'string (map-values alist))
- :alist alist))
- alist)))))
+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.
@@ -6266,7 +6249,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)))
@@ -6657,115 +6640,175 @@ erc--update-membership-prefix
(and (= letter ?a) state)
(and (= letter ?q) state)))
-(defvar erc--update-channel-modes-omit-status-p nil)
-
-(defun erc--update-channel-modes (string &rest args)
- "Update `erc-channel-modes' and dispatch individual mode handlers.
-Also update status prefixes, as needed. Expect STRING to be a
-\"modestring\" and ARGS to match mode-specific parameters. When
-`erc--update-channel-modes-omit-status-p' is non-nil, forgo
-setting status prefixes for channel members."
- (cl-assert erc-server-process)
- (cl-assert erc--target)
+(defvar-local erc--channel-modes nil
+ "When non-nil, a hash table of current channel modes.
+Keys are characters. Values are either a string, for types A-C,
+or t, for type D.")
+
+(defvar-local erc--channel-mode-types nil
+ "Current `erc--channel-mode-types' instance for the server.")
+
+(defun erc--channel-mode-types ()
+ "Return `erc--channel-mode-types', possibly creating it."
+ (erc--with-isupport-data CHANMODES erc--channel-mode-types
+ (let ((types (or key '(nil "Kk" "Ll" nil)))
+ (ct (make-char-table 'erc--channel-mode-types))
+ (type ?a))
+ (dolist (cs types)
+ (seq-doseq (c cs)
+ (aset ct c type))
+ (cl-incf type))
+ (make-erc--channel-mode-types :key key
+ :fallbackp (null key)
+ :table ct))))
+
+(defun erc--process-channel-modes (string args &optional status-letters)
+ "Parse channel \"MODE\" changes and call unary letter handlers.
+Update `erc-channel-modes' and `erc--channel-modes'. With
+STATUS-LETTERS, also update channel membership prefixes. Expect
+STRING to be the second argument from an incoming \"MODE\"
+command and ARGS to be the remaining arguments, which should
+complement relevant letters in STRING."
(cl-assert (erc--target-channel-p erc--target))
- (pcase-let* ((status-letters
- (and (not erc--update-channel-modes-omit-status-p)
- (or (erc-with-server-buffer
- (erc--parse-prefix)
- (erc--parsed-prefix-letters erc--parsed-prefix))
- "qaovhbQAOVHB")))
- (`(,type-a ,type-b ,type-c ,type-d)
- (or (cdr (erc--get-isupport-entry 'CHANMODES))
- '(nil "Kk" "Ll" nil)))
- (+p t))
+ (let* ((obj (erc--channel-mode-types))
+ (table (erc--channel-mode-types-table obj))
+ (fallbackp (erc--channel-mode-types-fallbackp obj))
+ (+p t))
(dolist (c (append string nil))
(let ((letter (char-to-string c)))
(cond ((= ?+ c) (setq +p t))
((= ?- c) (setq +p nil))
((and status-letters (string-search letter status-letters))
(erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
- ((and type-a (string-search letter type-a))
- (erc--handle-channel-mode 'a c +p (pop args)))
- ((string-search letter type-b)
- (erc--handle-channel-mode 'b c +p (pop args)))
- ((string-search letter type-c)
- (erc--handle-channel-mode 'c c +p (and +p (pop args))))
- ((or (null type-d) (string-search letter type-d))
- (setq erc-channel-modes
- (if +p
- (cl-pushnew letter erc-channel-modes :test #'equal)
- (delete letter erc-channel-modes))))
- (type-d ; OK to print error because server buffer exists
+ ((and-let* ((group (or (aref table c) (and fallbackp ?d))))
+ (erc--handle-channel-mode group c +p
+ (and (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 (erc-sort-strings erc-channel-modes))
+ (setq erc-channel-modes (sort erc-channel-modes #'string<))
(erc-update-mode-line (current-buffer))))
(defvar-local erc--user-modes nil
- "List of current user modes, analogous to `erc-channel-modes'.")
-
-(defun erc--user-modes (&optional as-string-p)
- "Return user mode letters as chars or, with AS-STRING-P, a single string."
- (let ((modes (erc-with-server-buffer erc--user-modes)))
- (if as-string-p
- (apply #'string (if (memq as-string-p '(+ ?+)) (cons '?+ modes) modes))
- modes)))
-
-(defun erc--parse-user-modes (string)
- "Return a list of mode chars to add and remove, based on STRING."
+ "Sorted list of current user \"MODE\" letters.
+Analogous to `erc-channel-modes' but chars rather than strings.")
+
+(defun erc--user-modes (&optional as-type)
+ "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."
+ (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--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
+parameter of a \"MODE\" command, here containing only valid
+user-mode letters. Expect CURRENT to be a list of chars
+resembling those found in `erc--user-modes'. With EXTRAP, return
+two additional lists of chars: those that would be added were
+they not already present in CURRENT and those that would be
+dropped were they not already absent."
(let ((addp t)
- add-modes remove-modes)
+ ;;
+ redundant-add redundant-drop adding dropping)
(seq-doseq (c string)
(pcase c
(?+ (setq addp t))
(?- (setq addp nil))
- (_ (push c (if addp add-modes remove-modes)))))
- (list (nreverse add-modes)
- (nreverse remove-modes))))
+ (_ (push c (let ((hasp (and current (memq c current))))
+ (if addp
+ (if hasp redundant-add adding)
+ (if hasp dropping redundant-drop)))))))
+ (if extrap
+ (list (nreverse adding) (nreverse dropping)
+ (nreverse redundant-add) (nreverse redundant-drop))
+ (list (nreverse adding) (nreverse dropping)))))
+
+(defun erc--update-user-modes (string)
+ "Update `erc--user-modes' from \"MODE\" STRING.
+Return 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)
+ #'<))))
-(defun erc--merge-user-modes (adding dropping)
- "Update `erc--user-modes' with chars ADDING and DROPPING."
- (sort (seq-difference (seq-union erc--user-modes adding) dropping) #'-))
+(defun erc--update-channel-modes (string &rest args)
+ "Update `erc-channel-modes' and call individual mode handlers.
+Also update membership prefixes, as needed. Expect STRING to be
+a \"modestring\" and ARGS to match mode-specific parameters."
+ (let ((status-letters (or (erc-with-server-buffer
+ (erc--parsed-prefix-letters
+ (erc--parsed-prefix)))
+ "qaovhbQAOVHB")))
+ (erc--process-channel-modes string args status-letters)))
;; XXX this comment is referenced elsewhere (grep before deleting).
;;
;; The function `erc-update-modes' was deprecated in ERC 5.6 with no
;; immediate public replacement. Third parties needing such a thing
;; are encouraged to write to emacs-erc@gnu.org with ideas for a
-;; mode-handler API, possibly one incorporating mode-letter specific
-;; handlers, like `erc--handle-channel-mode' below.
+;; mode-handler API, possibly one incorporating letter-specific
+;; handlers, like `erc--handle-channel-mode' (below), which only
+;; handles mode types A-C.
(defun erc--update-modes (raw-args)
- "Handle user or channel mode update from server.
-Expect RAW-ARGS to be a \"modestring\" followed by mode-specific
-arguments."
+ "Handle user or channel \"MODE\" update from server.
+Expect RAW-ARGS be a list consisting of a \"modestring\" followed
+by mode-specific arguments."
(if (and erc--target (erc--target-channel-p erc--target))
(apply #'erc--update-channel-modes raw-args)
- (setq erc--user-modes
- (apply #'erc--merge-user-modes
- (erc--parse-user-modes (car raw-args))))))
+ (erc--update-user-modes (car raw-args))))
(defun erc--init-channel-modes (channel raw-args)
- "Set CHANNEL modes from RAW-ARGS."
- (let ((erc--update-channel-modes-omit-status-p t))
- (erc-with-buffer (channel)
- (apply #'erc--update-channel-modes raw-args))))
+ "Set CHANNEL modes from RAW-ARGS.
+Expect RAW-ARGS to be a \"modestring\" without any status-prefix
+chars, followed by applicable arguments."
+ (erc-with-buffer (channel)
+ (erc--process-channel-modes (car raw-args) (cdr raw-args))))
(cl-defgeneric erc--handle-channel-mode (type letter state arg)
"Handle a STATE change for mode LETTER of TYPE with ARG.
Expect to be called in the affected target buffer. Expect TYPE
-to be a symbol, namely, one of `a', `b', `c', or `d'. Expect
-LETTER to be a character, STATE to be a boolean, and ARGUMENT to
-be either a string or nil."
+to be a character, like ?a, representing an advertised
+\"CHANMODES\" group. Expect LETTER to also be a character, and
+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))))
-;; We could specialize on (eql 'c), but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode :before (_ c state arg)
+ "Record STATE change and ARG, if enabling, for mode letter C."
+ (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)))
+
+(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
+ "Update `erc-channel-modes' for any character C of nullary type D.
+Remember when STATE is non-nil and forget otherwise."
+ (setq erc-channel-modes
+ (if state
+ (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
+ (delete (char-to-string c) erc-channel-modes))))
+
+;; We could specialize on type C, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
(erc-update-channel-limit (erc--target-string erc--target)
(if state 'on 'off)
arg))
-;; We could specialize on (eql 'b), but that may be too brittle.
+;; We could specialize on type B, but that may be too brittle.
(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg)
;; Mimic old parsing behavior in which an ARG of "*" was discarded
;; even though `erc-update-channel-limit' checks STATE first.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 1ff5f4890a8..b7a0b29d06d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -643,11 +643,24 @@ erc-parse-user
(should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
-(ert-deftest erc--parse-prefix ()
+(ert-deftest erc--parsed-prefix ()
(erc-mode)
(erc-tests--set-fake-server-process "sleep" "1")
- (setq erc--isupport-params (make-hash-table)
- erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))
+ (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 . ?&)
@@ -657,33 +670,33 @@ erc--parse-prefix
(with-temp-buffer
(erc-mode)
(setq erc-server-process proc)
- (should (equal expected (erc--parse-prefix))))
+ (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" "!~&@%+"
+ #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 (erc--parsed-prefix-alist cached) (erc--parse-prefix))))
+ (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 (erc--parsed-prefix-alist cached) (erc--parse-prefix)))
+ (should-not (eq cached (erc--parsed-prefix)))
(should (equal (erc--parsed-prefix-alist
(erc-with-server-buffer erc--parsed-prefix))
expected)))))
-;; This tests exists to prove legacy behavior in order to incorporate
-;; it as a fallback in the 5.6+ replacement.
+;; This exists as a reference to assert legacy behavior in order to
+;; preserve and incorporate it as a fallback in the 5.6+ replacement.
(ert-deftest erc-parse-modes ()
(with-suppressed-warnings ((obsolete erc-parse-modes))
(should (equal (erc-parse-modes "+u") '(("u") nil nil)))
@@ -712,9 +725,10 @@ erc--update-channel-modes
erc--target (erc--target-from-string "#test"))
(erc-tests--set-fake-server-process "sleep" "1")
- (let (calls)
+ (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
+ calls)
(cl-letf (((symbol-function 'erc--handle-channel-mode)
- (lambda (&rest r) (push r calls)))
+ (lambda (&rest r) (push r calls) (apply orig-handle-fn r)))
((symbol-function 'erc-update-mode-line) #'ignore))
(ert-info ("Unknown user not created")
@@ -734,40 +748,99 @@ erc--update-channel-modes
(should-not (erc-channel-user-op-p "bob")))
(ert-info ("Unknown nullary added and removed")
+ (should-not erc--channel-modes)
(should-not erc-channel-modes)
(erc--update-channel-modes "+u")
(should (equal erc-channel-modes '("u")))
+ (should (eq t (gethash ?u erc--channel-modes)))
+ (should (equal (pop calls) '(?d ?u t nil)))
(erc--update-channel-modes "-u")
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
(should-not erc-channel-modes)
(should-not calls))
(ert-info ("Fallback for Type B includes mode letter k")
(erc--update-channel-modes "+k" "h2")
- (should (equal (pop calls) '(b ?k t "h2")))
+ (should (equal (pop calls) '(?b ?k t "h2")))
(should-not erc-channel-modes)
+ (should (equal "h2" (gethash ?k erc--channel-modes)))
(erc--update-channel-modes "-k" "*")
- (should (equal (pop calls) '(b ?k nil "*")))
+ (should (equal (pop calls) '(?b ?k nil "*")))
+ (should-not calls)
+ (should-not (gethash ?k erc--channel-modes))
(should-not erc-channel-modes))
(ert-info ("Fallback for Type C includes mode letter l")
(erc--update-channel-modes "+l" "3")
- (should (equal (pop calls) '(c ?l t "3")))
+ (should (equal (pop calls) '(?c ?l t "3")))
(should-not erc-channel-modes)
+ (should (equal "3" (gethash ?l erc--channel-modes)))
(erc--update-channel-modes "-l" nil)
- (should (equal (pop calls) '(c ?l nil nil)))
+ (should (equal (pop calls) '(?c ?l nil nil)))
+ (should-not (gethash ?l erc--channel-modes))
(should-not erc-channel-modes))
(ert-info ("Advertised supersedes heuristics")
(setq erc-server-parameters
'(("PREFIX" . "(ov)@+")
- ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+ ;; Add phony 5th type for this CHANMODES value for
+ ;; robustness in case some server gets creative.
+ ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE")))
(erc--update-channel-modes "+qu" "fool!*@*")
- (should (equal (pop calls) '(a ?q t "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 (eq t (gethash ?u erc--channel-modes)))
(should (equal erc-channel-modes '("u")))
(should-not (erc-channel-user-owner-p "bob")))
(should-not calls))))
+(ert-deftest erc--update-user-modes ()
+ (let ((erc--user-modes (list ?a)))
+ (should (equal (erc--update-user-modes "+a") '(?a)))
+ (should (equal (erc--update-user-modes "-b") '(?a)))
+ (should (equal erc--user-modes '(?a))))
+
+ (let ((erc--user-modes (list ?b)))
+ (should (equal (erc--update-user-modes "+ac") '(?a ?b ?c)))
+ (should (equal (erc--update-user-modes "+a-bc") '(?a)))
+ (should (equal erc--user-modes '(?a)))))
+
+(ert-deftest erc--user-modes ()
+ (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"))))
+
+(ert-deftest erc--parse-user-modes ()
+ (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '()) '(() ())))
+ (should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a))))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b))))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c))))
+
+ ;; Param `extrap' returns groups of redundant chars.
+ (should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a))))
+ (should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ())))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ())))
+ (should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ()))))
+
(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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Make-wrangling-ISUPPORT-data-more-convenient-in-.patch --]
[-- Type: text/x-patch, Size: 3495 bytes --]
From b05b60a0d79aad70cb71681b4b9f1f519bba40e4 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 13 Nov 2023 18:24:59 -0800
Subject: [PATCH 1/3] [5.6] Make wrangling ISUPPORT data more convenient in ERC
* lisp/erc/erc-backend.el (erc--get-isupport-entry): Check server for
`erc-server-parameters' if it's empty in the current buffer. This is
a bug fix.
(erc--with-isupport-data): New macro for accessing and caching data
derived from some ISUPPORT value.
* lisp/erc/erc-common.el (erc--isupport-data): New type for storing
cached ISUPPORT data.
* test/lisp/erc/erc-scenarios-display-message.el: Remove stray
`require'. (Bug#67220)
---
lisp/erc/erc-backend.el | 16 +++++++++++++++-
lisp/erc/erc-common.el | 4 ++++
test/lisp/erc/erc-scenarios-display-message.el | 2 --
3 files changed, 19 insertions(+), 3 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 9281c107d06..573079272e6 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -2096,7 +2096,9 @@ erc--get-isupport-entry
(erc-with-server-buffer erc--isupport-params)))
(value (with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
- erc-server-parameters)))
+ (or erc-server-parameters
+ (erc-with-server-buffer
+ erc-server-parameters)))))
(if (cdr v)
(erc--parse-isupport-value (cdr v))
'--empty--)))))
@@ -2106,6 +2108,18 @@ erc--get-isupport-entry
(when table
(remhash key table))))
+(defmacro erc--with-isupport-data (param var &rest body)
+ "Return processed data for \"ISUPPORT\" PARAM value stored VAR.
+Expect VAR's value to be an instance of an object whose \"class\"
+inherits from `erc--isupport-data'. If VAR is uninitialized or
+stale, evaluate BODY and assign the result to VAR."
+ (declare (indent defun))
+ `(erc-with-server-buffer
+ (pcase-let (((,@(list '\` (list param '\, 'key)))
+ (erc--get-isupport-entry ',param)))
+ (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var)
+ (setq ,var (progn ,@body))))))
+
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 930e8032f6d..683b05c3543 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -101,6 +101,10 @@ erc--target
(contents "" :type string)
(tags '() :type list))
+(cl-defstruct erc--isupport-data
+ "Abstract class for parsed ISUPPORT data."
+ (key nil :type (or null 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/test/lisp/erc/erc-scenarios-display-message.el b/test/lisp/erc/erc-scenarios-display-message.el
index 51bdf305ad5..5751a32212d 100644
--- a/test/lisp/erc/erc-scenarios-display-message.el
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -59,6 +59,4 @@ erc-scenarios-display-message--multibuf
(erc-cmd-QUIT "")))
-(eval-when-compile (require 'erc-join))
-
;;; erc-scenarios-display-message.el ends here
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Use-caching-variant-of-erc-parse-prefix-internal.patch --]
[-- Type: text/x-patch, Size: 7101 bytes --]
From 0640c127d9242267b3e7f50f02589971f6a578af Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Rework-MODE-processing-in-ERC.patch --]
[-- Type: text/x-patch, Size: 37490 bytes --]
From 8f7f44aeca735a988c9eb0a18aca3497f07c8480 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 14 Nov 2023 21:10:39 -0800
Subject: [PATCH 3/3] [5.6] Rework MODE processing in ERC
* etc/ERC-NEWS: Mention shift toward CHANMODES ISUPPORT parameter for
dictating parsing behavior.
* lisp/erc/erc-backend.el (erc--init-channel-modes, erc-update-modes,
erc-set-modes, erc-update-modes): Forward declarations, the last two
being removals.
(erc-server-MODE, erc-server-221): Use `erc--update-modes' instead of
`erc-update-modes'.
(erc-server-324): Use `erc--init-channel-modes' instead of
`erc-set-modes'.
* lisp/erc/erc-common.el (erc--channel-mode-types): New type for
stashing processed \"CHANMODES\" data for the current server.
* lisp/erc/erc.el (erc-channel-modes): Fix doc string.
(erc-set-initial-user-mode): Display a local notice when requesting
redundant user MODE operations.
(erc-set-modes, erc-parse-modes, erc-update-modes): Deprecate.
(erc--update-membership-prefix): New function, a helper for specifying
arguments to the rather unruly `erc-update-current-channel-member'.
(erc--channel-modes): New variable to record channel-mode state in a
hash table.
(erc--channel-mode-types): New variable to store server-local instance
of struct of the same name.
(erc--process-channel-modes): New function to parse channel-mode
changes, dispatch handlers for unary modes, and update the local
variable `erc-channel-modes'.
(erc--user-modes): New local variable for remembering user modes per
server. New function of the same name, a getter for that variable.
(erc--parse-user-modes): New function to parse user modes only.
(erc--update-user-modes): New function to update and sort
`erc--user-modes'.
(erc--update-channel-modes): New function to replace much of
`erc-update-modes', currently a thin wrapper around
`erc--process-channel-modes' to ensure it updates status prefixes.
(erc--update-modes): New function to call appropriate mode-updating
function for the current buffer.
(erc--init-channel-modes): New function to update channel mode letters
without status prefixes.
(erc--handle-channel-mode): New generic function, a placeholder for an
eventual API to handle specific "unary" mode letters, meaning those
that specify a single parameter for setting or unsetting.
(erc-update-channel-limit): Update doc string.
(erc-message-english-user-mode-redundant-add,
erc-message-english-user-mode-redundant-drop): New English catalog
messages.
* test/lisp/erc/erc-scenarios-base-chan-modes.el: New file.
* test/lisp/erc/erc-tests.el (erc-parse-modes,
erc--update-channel-modes, erc--update-user-modes, erc--user-modes,
erc--parse-user-modes): New tests.
* test/lisp/erc/resources/base/modes/chan-changed.eld: New file.
(Bug#67220)
---
etc/ERC-NEWS | 11 +
lisp/erc/erc-backend.el | 11 +-
lisp/erc/erc-common.el | 5 +
lisp/erc/erc.el | 231 +++++++++++++++++-
.../lisp/erc/erc-scenarios-base-chan-modes.el | 84 +++++++
test/lisp/erc/erc-tests.el | 146 +++++++++++
.../erc/resources/base/modes/chan-changed.eld | 55 +++++
7 files changed, 527 insertions(+), 16 deletions(-)
create mode 100644 test/lisp/erc/erc-scenarios-base-chan-modes.el
create mode 100644 test/lisp/erc/resources/base/modes/chan-changed.eld
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 04b11fc19f0..3bb9a30cfb2 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -480,6 +480,17 @@ release lacks a similar solution for detecting "joinedness" directly,
but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target'
as a makeshift kludge.
+*** Channel-mode handling has become stricter and more predictable.
+ERC has always processed channel modes using "standardized" letters
+and popular status prefixes. Starting with this release, ERC will
+begin preferring advertised "CHANMODES" when interpreting letters and
+their arguments. To facilitate this transition, the functions
+'erc-set-modes', 'erc-parse-modes', and 'erc-update-modes', have all
+been provisionally deprecated. Expect a new, replacement API for
+handling specific "MODE" types and letters in coming releases. If
+you'd like a say in shaping how this transpires, please share your
+ideas and use cases on the tracker.
+
*** Miscellaneous changes
Two helper macros from GNU ELPA's Compat library are now available to
third-party modules as 'erc-compat-call' and 'erc-compat-function'.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 573079272e6..7b5d1e35189 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -132,8 +132,10 @@ erc-reuse-buffers
(defvar erc-verbose-server-ping)
(defvar erc-whowas-on-nosuchnick)
+(declare-function erc--init-channel-modes "erc" (channel raw-args))
(declare-function erc--open-target "erc" (target))
(declare-function erc--target-from-string "erc" (string))
+(declare-function erc--update-modes "erc" (raw-args))
(declare-function erc-active-buffer "erc" nil)
(declare-function erc-add-default-channel "erc" (channel))
(declare-function erc-banlist-update "erc" (proc parsed))
@@ -179,7 +181,6 @@ erc-whowas-on-nosuchnick
(declare-function erc-server-buffer "erc" nil)
(declare-function erc-set-active-buffer "erc" (buffer))
(declare-function erc-set-current-nick "erc" (nick))
-(declare-function erc-set-modes "erc" (tgt mode-string))
(declare-function erc-time-diff "erc" (t1 t2))
(declare-function erc-trim-string "erc" (s))
(declare-function erc-update-mode-line "erc" (&optional buffer))
@@ -194,8 +195,6 @@ erc-whowas-on-nosuchnick
(proc parsed nick login host msg))
(declare-function erc-update-channel-topic "erc"
(channel topic &optional modify))
-(declare-function erc-update-modes "erc"
- (tgt mode-string &optional _nick _host _login))
(declare-function erc-update-user-nick "erc"
(nick &optional new-nick host login full-name info))
(declare-function erc-open "erc"
@@ -1802,7 +1801,7 @@ erc--server-determine-join-display-context
(t (erc-get-buffer tgt)))))
(with-current-buffer (or buf
(current-buffer))
- (erc-update-modes tgt mode nick host login))
+ (erc--update-modes (cdr (erc-response.command-args parsed))))
(if (or (string= login "") (string= host ""))
(erc-display-message parsed 'notice buf
'MODE-nick ?n nick
@@ -2156,7 +2155,7 @@ erc--with-isupport-data
(let* ((nick (car (erc-response.command-args parsed)))
(modes (mapconcat #'identity
(cdr (erc-response.command-args parsed)) " ")))
- (erc-set-modes nick modes)
+ (erc--update-modes (cdr (erc-response.command-args parsed)))
(erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
(define-erc-response-handler (252)
@@ -2322,7 +2321,7 @@ erc-server-322-message
(let ((channel (cadr (erc-response.command-args parsed)))
(modes (mapconcat #'identity (cddr (erc-response.command-args parsed))
" ")))
- (erc-set-modes channel modes)
+ (erc--init-channel-modes channel (cddr (erc-response.command-args parsed)))
(erc-display-message
parsed 'notice (erc-get-buffer channel proc)
's324 ?c channel ?m modes)))
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 65cc4630156..48d29883d8f 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -112,6 +112,11 @@ erc--isupport-data
(statuses "~&@%+" :type string)
(alist nil :type (list-of cons)))
+(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))
+
;; 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 125d9fcd3a1..78a4f363af2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -732,9 +732,9 @@ erc-channel-topic
"A topic string for the channel. Should only be used in channel-buffers.")
(defvar-local erc-channel-modes nil
- "List of strings representing channel modes.
-E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
-\(not sure the ban list will be here, but why not)")
+ "List of letters, as strings, representing channel modes.
+For example, (\"i\" \"m\" \"s\"). Modes that take accompanying
+parameters are not included.")
(defvar-local erc-insert-marker nil
"The place where insertion of new text in erc buffers should happen.")
@@ -4552,6 +4552,10 @@ erc--send-message-nested
(erc--send-input-lines (erc--run-send-hooks lines-obj)))
t)
+;; FIXME if the user types /MODE<RET>, LINE becomes "\n", which
+;; matches the pattern, so "\n" is sent to the server. Perhaps
+;; instead of `do-not-parse-args', this should just join &rest
+;; arguments.
(defun erc-cmd-MODE (line)
"Change or display the mode value of a channel or user.
The first word specifies the target. The rest is the mode string
@@ -5914,9 +5918,19 @@ erc-set-initial-user-mode
The server buffer is given by BUFFER."
(with-current-buffer buffer
(when erc-user-mode
- (let ((mode (if (functionp erc-user-mode)
- (funcall erc-user-mode)
- erc-user-mode)))
+ (let* ((mode (if (functionp erc-user-mode)
+ (funcall erc-user-mode)
+ erc-user-mode))
+ (groups (erc--parse-user-modes mode (erc--user-modes) t))
+ (superfluous (last groups 2))
+ (redundant-want (car superfluous))
+ (redundant-drop (cadr superfluous)))
+ (when redundant-want
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-add
+ ?m (apply #'string redundant-want)))
+ (when redundant-drop
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-drop
+ ?m (apply #'string redundant-drop)))
(when (stringp mode)
(erc-log (format "changing mode for %s to %s" nick mode))
(erc-server-send (format "MODE %s %s" nick mode)))))))
@@ -6471,7 +6485,9 @@ erc-update-channel-topic
(defun erc-set-modes (tgt mode-string)
"Set the modes for the TGT provided as MODE-STRING."
- (let* ((modes (erc-parse-modes mode-string))
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
;; list of triples: (mode-char 'on/'off argument)
(arg-modes (nth 2 modes)))
@@ -6517,6 +6533,7 @@ erc-parse-modes
arg-modes is a list of triples of the form:
(MODE-CHAR ON/OFF ARGUMENT)."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
(let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
;; arguments in channel modes
@@ -6561,8 +6578,10 @@ erc-update-modes
"Update the mode information for TGT, provided as MODE-STRING.
Optional arguments: NICK, HOST and LOGIN - the attributes of the
person who changed the modes."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
;; FIXME: neither of nick, host, and login are used!
- (let* ((modes (erc-parse-modes mode-string))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
(remove-modes (nth 1 modes))
;; list of triples: (mode-char 'on/'off argument)
@@ -6611,9 +6630,197 @@ erc-update-modes
;; nick modes - ignored at this point
(t nil))))
+(defun erc--update-membership-prefix (nick letter state)
+ "Update status prefixes for NICK in current channel buffer.
+Expect LETTER to be a status char and STATE to be a boolean."
+ (erc-update-current-channel-member nick nil nil
+ (and (= letter ?v) state)
+ (and (= letter ?h) state)
+ (and (= letter ?o) state)
+ (and (= letter ?a) state)
+ (and (= letter ?q) state)))
+
+(defvar-local erc--channel-modes nil
+ "When non-nil, a hash table of current channel modes.
+Keys are characters. Values are either a string, for types A-C,
+or t, for type D.")
+
+(defvar-local erc--channel-mode-types nil
+ "Current `erc--channel-mode-types' instance for the server.")
+
+(defun erc--channel-mode-types ()
+ "Return `erc--channel-mode-types', possibly creating it."
+ (erc--with-isupport-data CHANMODES erc--channel-mode-types
+ (let ((types (or key '(nil "Kk" "Ll" nil)))
+ (ct (make-char-table 'erc--channel-mode-types))
+ (type ?a))
+ (dolist (cs types)
+ (seq-doseq (c cs)
+ (aset ct c type))
+ (cl-incf type))
+ (make-erc--channel-mode-types :key key
+ :fallbackp (null key)
+ :table ct))))
+
+(defun erc--process-channel-modes (string args &optional status-letters)
+ "Parse channel \"MODE\" changes and call unary letter handlers.
+Update `erc-channel-modes' and `erc--channel-modes'. With
+STATUS-LETTERS, also update channel membership prefixes. Expect
+STRING to be the second argument from an incoming \"MODE\"
+command and ARGS to be the remaining arguments, which should
+complement relevant letters in STRING."
+ (cl-assert (erc--target-channel-p erc--target))
+ (let* ((obj (erc--channel-mode-types))
+ (table (erc--channel-mode-types-table obj))
+ (fallbackp (erc--channel-mode-types-fallbackp obj))
+ (+p t))
+ (dolist (c (append string nil))
+ (let ((letter (char-to-string c)))
+ (cond ((= ?+ c) (setq +p t))
+ ((= ?- c) (setq +p nil))
+ ((and status-letters (string-search letter status-letters))
+ (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)
+ (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<))
+ (erc-update-mode-line (current-buffer))))
+
+(defvar-local erc--user-modes nil
+ "Sorted list of current user \"MODE\" letters.
+Analogous to `erc-channel-modes' but chars rather than strings.")
+
+(defun erc--user-modes (&optional as-type)
+ "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."
+ (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--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
+parameter of a \"MODE\" command, here containing only valid
+user-mode letters. Expect CURRENT to be a list of chars
+resembling those found in `erc--user-modes'. With EXTRAP, return
+two additional lists of chars: those that would be added were
+they not already present in CURRENT and those that would be
+dropped were they not already absent."
+ (let ((addp t)
+ ;;
+ redundant-add redundant-drop adding dropping)
+ (seq-doseq (c string)
+ (pcase c
+ (?+ (setq addp t))
+ (?- (setq addp nil))
+ (_ (push c (let ((hasp (and current (memq c current))))
+ (if addp
+ (if hasp redundant-add adding)
+ (if hasp dropping redundant-drop)))))))
+ (if extrap
+ (list (nreverse adding) (nreverse dropping)
+ (nreverse redundant-add) (nreverse redundant-drop))
+ (list (nreverse adding) (nreverse dropping)))))
+
+(defun erc--update-user-modes (string)
+ "Update `erc--user-modes' from \"MODE\" STRING.
+Return 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)
+ #'<))))
+
+(defun erc--update-channel-modes (string &rest args)
+ "Update `erc-channel-modes' and call individual mode handlers.
+Also update membership prefixes, as needed. Expect STRING to be
+a \"modestring\" and ARGS to match mode-specific parameters."
+ (let ((status-letters (or (erc-with-server-buffer
+ (erc--parsed-prefix-letters
+ (erc--parsed-prefix)))
+ "qaovhbQAOVHB")))
+ (erc--process-channel-modes string args status-letters)))
+
+;; XXX this comment is referenced elsewhere (grep before deleting).
+;;
+;; The function `erc-update-modes' was deprecated in ERC 5.6 with no
+;; immediate public replacement. Third parties needing such a thing
+;; are encouraged to write to emacs-erc@gnu.org with ideas for a
+;; mode-handler API, possibly one incorporating letter-specific
+;; handlers, like `erc--handle-channel-mode' (below), which only
+;; handles mode types A-C.
+(defun erc--update-modes (raw-args)
+ "Handle user or channel \"MODE\" update from server.
+Expect RAW-ARGS be a list consisting of a \"modestring\" followed
+by mode-specific arguments."
+ (if (and erc--target (erc--target-channel-p erc--target))
+ (apply #'erc--update-channel-modes raw-args)
+ (erc--update-user-modes (car raw-args))))
+
+(defun erc--init-channel-modes (channel raw-args)
+ "Set CHANNEL modes from RAW-ARGS.
+Expect RAW-ARGS to be a \"modestring\" without any status-prefix
+chars, followed by applicable arguments."
+ (erc-with-buffer (channel)
+ (erc--process-channel-modes (car raw-args) (cdr raw-args))))
+
+(cl-defgeneric erc--handle-channel-mode (type letter state arg)
+ "Handle a STATE change for mode LETTER of TYPE with ARG.
+Expect to be called in the affected target buffer. Expect TYPE
+to be a character, like ?a, representing an advertised
+\"CHANMODES\" group. Expect LETTER to also be a character, and
+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."
+ (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)))
+
+(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
+ "Update `erc-channel-modes' for any character C of nullary type D.
+Remember when STATE is non-nil and forget otherwise."
+ (setq erc-channel-modes
+ (if state
+ (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
+ (delete (char-to-string c) erc-channel-modes))))
+
+;; We could specialize on type C, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
+ (erc-update-channel-limit (erc--target-string erc--target)
+ (if state 'on 'off)
+ arg))
+
+;; We could specialize on type B, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg)
+ ;; Mimic old parsing behavior in which an ARG of "*" was discarded
+ ;; even though `erc-update-channel-limit' checks STATE first.
+ (erc-update-channel-key (erc--target-string erc--target)
+ (if state 'on 'off)
+ (if (equal arg "*") nil arg)))
+
(defun erc-update-channel-limit (channel onoff n)
- ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
- "Update CHANNEL's user limit to N."
+ "Update CHANNEL's user limit to N.
+Expect ONOFF to be `on' when the mode is being enabled and `off'
+otherwise. And because this mode is of \"type C\", expect N to
+be non-nil only when enabling."
(if (or (not (eq onoff 'on))
(and (stringp n) (string-match "^[0-9]+$" n)))
(erc-with-buffer
@@ -8289,6 +8496,10 @@ erc-define-catalog
(ops . "%i operator%s: %o")
(ops-none . "No operators in this channel.")
(undefined-ctcp . "Undefined CTCP query received. Silently ignored")
+ (user-mode-redundant-add
+ . "Already have user mode(s): %m. Requesting again anyway.")
+ (user-mode-redundant-drop
+ . "Already without user mode(s): %m. Requesting removal anyway.")
(variable-not-bound . "Variable not bound!")
(ACTION . "* %n %a")
(CTCP-CLIENTINFO . "Client info for %n: %m")
diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el
new file mode 100644
index 00000000000..9c63d8aff8e
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el
@@ -0,0 +1,84 @@
+;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; This asserts that a bug present in ERC 5.4+ is now absent.
+;; Previously, ERC would attempt to parse a nullary channel mode as if
+;; it were a status prefix update, which led to a wrong-type error.
+;; This test does not address similar collisions with unary modes,
+;; such as "MODE +q foo!*@*", but it should.
+(ert-deftest erc-scenarios-base-chan-modes--plus-q ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'chan-changed))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to Libera.Chat")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "changed mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+
+ (ert-info ("Receive notice that mode has changed")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ (erc-scenarios-common-say "ready before")
+ (funcall expect 10 "<Chad> before")
+ (funcall expect 10 " has changed mode for #chan to +Qu")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Key stored locally")
+ (erc-scenarios-common-say "ready key")
+ (funcall expect 10 "<Chad> doing key")
+ (funcall expect 10 " has changed mode for #chan to +k hunter2")
+ (should (equal erc-channel-key "hunter2")))
+
+ (ert-info ("Limit stored locally")
+ (erc-scenarios-common-say "ready limit")
+ (funcall expect 10 "<Chad> doing limit")
+ (funcall expect 10 " has changed mode for #chan to +l 3")
+ (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
+ (should (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Modes removed and local state deletion succeeds")
+ (erc-scenarios-common-say "ready drop")
+ (funcall expect 10 "<Chad> dropping")
+ (funcall expect 10 " has changed mode for #chan to -lu")
+ (funcall expect 10 " has changed mode for #chan to -Qk *")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))))
+
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+ (funcall expect 10 "<Chad> after"))))
+
+;;; erc-scenarios-base-chan-modes.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b61a601143a..b7a0b29d06d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -695,6 +695,152 @@ erc--parsed-prefix
(erc-with-server-buffer erc--parsed-prefix))
expected)))))
+;; This exists as a reference to assert legacy behavior in order to
+;; preserve and incorporate it as a fallback in the 5.6+ replacement.
+(ert-deftest erc-parse-modes ()
+ (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (should (equal (erc-parse-modes "+u") '(("u") nil nil)))
+ (should (equal (erc-parse-modes "-u") '(nil ("u") nil)))
+ (should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob")))))
+ (should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+uo-tv bob alice")
+ '(("u") ("t") (("o" on "bob") ("v" off "alice")))))
+
+ (ert-info ("Modes of type B are always grouped as unary")
+ (should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2")))))
+ ;; Channel key args are thrown away.
+ (should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil))))))
+
+ (ert-info ("Modes of type C are grouped as unary even when disabling")
+ (should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3")))))
+ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
+
+(ert-deftest erc--update-channel-modes ()
+ (erc-mode)
+ (setq erc-channel-users (make-hash-table :test #'equal)
+ erc-server-users (make-hash-table :test #'equal)
+ erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test"))
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
+ calls)
+ (cl-letf (((symbol-function 'erc--handle-channel-mode)
+ (lambda (&rest r) (push r calls) (apply orig-handle-fn r)))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+
+ (ert-info ("Unknown user not created")
+ (erc--update-channel-modes "+o" "bob")
+ (should-not (erc-get-channel-user "bob")))
+
+ (ert-info ("Status updated when user known")
+ (puthash "bob" (cons (erc-add-server-user
+ "bob" (make-erc-server-user :nickname "bob"))
+ (make-erc-channel-user))
+ erc-channel-users)
+ ;; Also asserts fallback behavior for traditional prefixes.
+ (should-not (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "+o" "bob")
+ (should (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "-o" "bob") ; status revoked
+ (should-not (erc-channel-user-op-p "bob")))
+
+ (ert-info ("Unknown nullary added and removed")
+ (should-not erc--channel-modes)
+ (should-not erc-channel-modes)
+ (erc--update-channel-modes "+u")
+ (should (equal erc-channel-modes '("u")))
+ (should (eq t (gethash ?u erc--channel-modes)))
+ (should (equal (pop calls) '(?d ?u t nil)))
+ (erc--update-channel-modes "-u")
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
+ (should-not erc-channel-modes)
+ (should-not calls))
+
+ (ert-info ("Fallback for Type B includes mode letter k")
+ (erc--update-channel-modes "+k" "h2")
+ (should (equal (pop calls) '(?b ?k t "h2")))
+ (should-not erc-channel-modes)
+ (should (equal "h2" (gethash ?k erc--channel-modes)))
+ (erc--update-channel-modes "-k" "*")
+ (should (equal (pop calls) '(?b ?k nil "*")))
+ (should-not calls)
+ (should-not (gethash ?k erc--channel-modes))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Fallback for Type C includes mode letter l")
+ (erc--update-channel-modes "+l" "3")
+ (should (equal (pop calls) '(?c ?l t "3")))
+ (should-not erc-channel-modes)
+ (should (equal "3" (gethash ?l erc--channel-modes)))
+ (erc--update-channel-modes "-l" nil)
+ (should (equal (pop calls) '(?c ?l nil nil)))
+ (should-not (gethash ?l erc--channel-modes))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Advertised supersedes heuristics")
+ (setq erc-server-parameters
+ '(("PREFIX" . "(ov)@+")
+ ;; Add phony 5th type for this CHANMODES value for
+ ;; robustness in case some server gets creative.
+ ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE")))
+ (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 (eq t (gethash ?u erc--channel-modes)))
+ (should (equal erc-channel-modes '("u")))
+ (should-not (erc-channel-user-owner-p "bob")))
+
+ (should-not calls))))
+
+(ert-deftest erc--update-user-modes ()
+ (let ((erc--user-modes (list ?a)))
+ (should (equal (erc--update-user-modes "+a") '(?a)))
+ (should (equal (erc--update-user-modes "-b") '(?a)))
+ (should (equal erc--user-modes '(?a))))
+
+ (let ((erc--user-modes (list ?b)))
+ (should (equal (erc--update-user-modes "+ac") '(?a ?b ?c)))
+ (should (equal (erc--update-user-modes "+a-bc") '(?a)))
+ (should (equal erc--user-modes '(?a)))))
+
+(ert-deftest erc--user-modes ()
+ (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"))))
+
+(ert-deftest erc--parse-user-modes ()
+ (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '()) '(() ())))
+ (should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a))))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b))))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c))))
+
+ ;; Param `extrap' returns groups of redundant chars.
+ (should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a))))
+ (should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ())))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ())))
+ (should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ()))))
+
(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")))
diff --git a/test/lisp/erc/resources/base/modes/chan-changed.eld b/test/lisp/erc/resources/base/modes/chan-changed.eld
new file mode 100644
index 00000000000..6cf6596b0b2
--- /dev/null
+++ b/test/lisp/erc/resources/base/modes/chan-changed.eld
@@ -0,0 +1,55 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet Relay Chat Network tester")
+ (0.02 ":cadmium.libera.chat 002 tester :Your host is cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
+ (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25 2023 at 10:22:45 UTC")
+ (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
+ (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+ MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459 NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR: EXTBAN=$,ajrxz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996 invisible on 28 servers")
+ (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
+ (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
+ (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
+ (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
+ (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499, max 4187")
+ (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users 43066, max 51827")
+ (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187 clients) (319420 connections received)")
+ (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the Day - ")
+ (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach Dilemma (www.m-d.net)")
+ (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC network for")
+ (0.00 ":cadmium.libera.chat 372 tester :- Email: support@libera.chat")
+ (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
+ (0.00 ":tester MODE tester :+Ziw"))
+
+((mode-tester 10 "MODE tester +i"))
+
+((join-chan 10 "JOIN #chan")
+ (0.09 ":tester!~tester@127.0.0.1 JOIN #chan"))
+
+((mode-chan 10 "MODE #chan")
+ (0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy")
+ (0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.")
+ (0.00 ":cadmium.libera.chat 324 tester #chan +nt")
+ (0.01 ":cadmium.libera.chat 329 tester #chan 1621432263"))
+
+((privmsg-before 10 "PRIVMSG #chan :ready before")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu"))
+
+((privmsg-key 10 "PRIVMSG #chan :ready key")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2"))
+
+((privmsg-limit 10 "PRIVMSG #chan :ready limit")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3"))
+
+((privmsg-drop 10 "PRIVMSG #chan :ready drop")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after"))
+
+((drop 0 DROP))
--
2.41.0
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <87zfzcnsg1.fsf@neverwas.me>
@ 2023-11-18 22:14 ` J.P.
[not found] ` <87il5yogj7.fsf@neverwas.me>
1 sibling, 0 replies; 5+ messages in thread
From: J.P. @ 2023-11-18 22:14 UTC (permalink / raw)
To: 67220-done; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v2. Account for nonstandard CHANMODES beyond type D. Make mode-letter
> handling more extensible and modular. Provide convenience macro for
> caching processed data originating from ISUPPORT values. Retain original
> parsed channel-mode data.
This has been installed as
cca7956c82d * Favor ISUPPORT params for MODE processing in ERC
Closing for now.
^ permalink raw reply [flat|nested] 5+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <87il5yogj7.fsf@neverwas.me>
@ 2023-11-21 14:30 ` J.P.
[not found] ` <87il5vfab9.fsf@neverwas.me>
1 sibling, 0 replies; 5+ messages in thread
From: J.P. @ 2023-11-21 14:30 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 787 bytes --]
"J.P." <jp@neverwas.me> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> v2. Account for nonstandard CHANMODES beyond type D. Make mode-letter
>> handling more extensible and modular. Provide convenience macro for
>> caching processed data originating from ISUPPORT values. Retain original
>> parsed channel-mode data.
>
> This has been installed as
>
> cca7956c82d * Favor ISUPPORT params for MODE processing in ERC
>
> Closing for now.
Unfortunately, this latest round of changes messed up a pretty basic but
important aspect of channel-mode parsing. As a result, the ERC on HEAD
confuses modes that take parameters with those that don't. Worst case is
thought to be that strange values may be assigned to the variables
`erc-channel-user-limit' and `erc-channel-key'. Fix attached.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Don-t-associate-type-D-channel-modes-with-args-i.patch --]
[-- Type: text/x-patch, Size: 8357 bytes --]
From 70affab11884917814cd4e86c4266f1feeace9ea Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 20 Nov 2023 19:45:30 -0800
Subject: [PATCH] [5.6] Don't associate type D channel modes with args in ERC
* lisp/erc/erc.el (erc--process-channel-modes): Don't associate args
with group 4/D, which are all nullary modes.
(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--handle-channel-mode): Change model to associate modes of type A
with a running plus/minus tally of state changes since joining the
channel.
* 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)
---
lisp/erc/erc.el | 58 +++++++++++++++++++++++++++++++-------
test/lisp/erc/erc-tests.el | 36 ++++++++++++++++++++---
2 files changed, 80 insertions(+), 14 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f4c3f77593c..f8053165b8b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6686,7 +6686,8 @@ erc--process-channel-modes
(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)
@@ -6703,16 +6704,43 @@ erc--user-modes
"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 all keys a
+list of sorted string. When it's `string' (singular), return
+keys as a single string. When it's a number, return a single
+string consisting of the concatenated and sorted keys followed by
+their corresponding args, separated by SEP, which defaults to a
+single space. Otherwise, return a sorted alist of letter/arg
+pairs."
+ (and-let* ((modes erc--channel-modes)
+ (types (erc--channel-mode-types-table (erc--channel-mode-types))))
+ (let (out)
+ (maphash (lambda (k v)
+ (unless (eq ?a (aref types k))
+ (push (cons k (and (not (eq t v)) 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 (substring v 0 (min c (length 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
@@ -6791,14 +6819,24 @@ erc--handle-channel-mode
(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.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8dbe44ce5ed..0c03a12864a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -796,13 +796,42 @@ erc--update-channel-modes
(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"))
+ (should (equal (erc--channel-modes 1 ",") "klt h,3"))
+ (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 +847,7 @@ erc--user-modes
(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)) '(() ())))
--
2.41.0
^ permalink raw reply related [flat|nested] 5+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <87il5vfab9.fsf@neverwas.me>
@ 2023-11-24 22:13 ` J.P.
0 siblings, 0 replies; 5+ messages in thread
From: J.P. @ 2023-11-24 22:13 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> Unfortunately, this latest round of changes messed up a pretty basic but
> important aspect of channel-mode parsing. As a result, the ERC on HEAD
> confuses modes that take parameters with those that don't. Worst case is
> thought to be that strange values may be assigned to the variables
> `erc-channel-user-limit' and `erc-channel-key'. Fix attached.
The remedial changes mentioned have been lumped in with this commit:
5bc84a0c9e4 * Cache UI string for channel modes in ERC
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2023-11-24 22:13 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-16 2:13 bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC J.P.
2023-11-17 18:30 ` J.P.
[not found] ` <87zfzcnsg1.fsf@neverwas.me>
2023-11-18 22:14 ` J.P.
[not found] ` <87il5yogj7.fsf@neverwas.me>
2023-11-21 14:30 ` J.P.
[not found] ` <87il5vfab9.fsf@neverwas.me>
2023-11-24 22:13 ` J.P.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).