* 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.
` (5 more replies)
0 siblings, 6 replies; 11+ 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] 11+ 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>
` (4 subsequent siblings)
5 siblings, 0 replies; 11+ 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] 11+ 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; 11+ 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] 11+ 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; 11+ 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] 11+ 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; 11+ 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] 11+ 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>
@ 2024-01-19 1:21 ` J.P.
[not found] ` <87mst2unhi.fsf@neverwas.me>
` (2 subsequent siblings)
5 siblings, 0 replies; 11+ messages in thread
From: J.P. @ 2024-01-19 1:21 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1277 bytes --]
"J.P." <jp@neverwas.me> writes:
> 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.
In the initial set of changes, I only partially implemented PREFIX-aware
channel-membership handling (here and in bug#67677, for the formatting
side). The main reason for this omission was that I mistakenly assumed
the lack of a valid use case for doing so. However, a latent clue in our
own test suite attesting to the contrary was staring me in the face the
whole time (until I unceremoniously erased it [1]). Since then, I've
come around on this and now think we might as well see it through the
somewhat arduous last mile. See attached.
Thanks.
[1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=4939f413
^ Grep for "Yqaohv".
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Actually-derive-channel-membership-from-PREFIX-i.patch --]
[-- Type: text/x-patch, Size: 40013 bytes --]
From 9c7260ef1cd9aa87bcfe98175307fed8b64e3ae5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 17 Jan 2024 21:42:02 -0800
Subject: [PATCH 3/3] [5.6] Actually derive channel membership from PREFIX in
ERC
* lisp/erc/erc-backend.el (erc--with-isupport-data): Add comment for
possibly superior alternate implementation.
* lisp/erc/erc-common.el (erc--get-isupport-entry): Use helper to
initialize traditional prefixes slots in overridden well-known
constructor.
(erc--parsed-prefix): Reverse the order of characters in the `letters'
and `statuses' slots, both by definition and in their defaults.
(erc--strpos): New function, a utility for finding a single character
in a string.
* lisp/erc/erc.el (erc--define-channel-user-status-compat-getter):
Modify to query advertised value for associated mode letter at runtime
instead of baking it in.
(erc-channel-user-voice, erc-channel-user-halfop, erc-channel-user-op,
erc-channel-user-admin, erc-channel-user-owner): Supply second
argument for associated mode letter.
(erc--cusr-status-p,
erc--cusr-change-status): New functions for querying and modifying
`erc-channel-user' statuses.
(erc-send-input-line): Update speaker time in own nick's
`erc-channel-member' entry.
(erc-get-channel-membership-prefix): Adapt code to prefer advertised
prefix for mode letter.
(erc--parsed-prefix): Save "reversed" `letters' and `statuses' so that
they're ordered from lowest to highest ranked.
(erc--get-prefix-flag,
erc--init-cusr-fallback-status,
erc--compute-cusr-fallback-status): New functions for massaging
hard-coded traditional prefixes so they're compatible with existing
`erc-channel-member' update code.
(erc-channel-receive-names): Refactor to use new status-aware
`erc-channel-member' update and init workhorse functions.
(erc--partition-prefixed-names): New function, separated for testing
and for conversion to a generic in the near future when ERC supports
extensions that list member rolls in a different format.
(erc--create-current-channel-member): New "status-aware" function
comprising the `addp' portion of `erc-update-current-channel-member'.
(erc--update-current-channel-member): New "status-aware" function
comprising the "update" portion of
`erc-update-current-channel-member', which ran when an existing
`erc-channel-member' entry for the queried nick was found.
(erc-update-current-channel-member): Split code body into two
constituent functions, both for readability and so callers can more
explicitly request the desired operation in a "status-aware" manner.
(erc--update-membership-prefix): Remove unused function, originally
meant to be new in ERC 5.6.
(erc--process-channel-modes): Call `erc--cusr-change-status' instead
of `erc--update-membership-prefix'.
(erc--shuffle-nuh-nickward): New utility so that functions similar to
`erc--partition-prefixed-names' can use `erc--parse-nuh' in the near
future.
* test/lisp/erc/erc-tests.el (erc--parsed-prefix): Reverse expected
order of various slot values in `erc--parsed-prefix' objects.
(erc--get-prefix-flag, erc--init-cusr-fallback-status,
erc--compute-cusr-fallback-status, erc--cusr-status-p,
erc--cusr-change-status): New tests.
(erc--update-channel-modes, erc-process-input-line): Use common
helpers. (Bug#67220)
---
lisp/erc/erc-backend.el | 4 +-
lisp/erc/erc-common.el | 25 ++-
lisp/erc/erc.el | 361 +++++++++++++++++++++++--------------
test/lisp/erc/erc-tests.el | 122 ++++++++++---
4 files changed, 344 insertions(+), 168 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 95207e56fd1..2d60ba3c9b0 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -2201,7 +2201,9 @@ erc--get-isupport-entry
;; While it's better to depend on interfaces than specific types,
;; using `cl-struct-slot-value' or similar to extract a known slot at
;; runtime would incur a small "ducktyping" tax, which should probably
-;; be avoided when running dozens of times per incoming message.
+;; be avoided when running hundreds of times per incoming message.
+;; Instead of separate keys per data type, we could use a crude
+;; logical clock that gets incremented whenever a new 005 arrives.
(defmacro erc--with-isupport-data (param var &rest body)
"Return structured data stored in VAR for \"ISUPPORT\" PARAM.
Expect VAR's value to be an instance of `erc--isupport-data'. If
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index e7e70fffd3a..4c5a042a4e3 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -37,6 +37,7 @@ erc-server-users
(defvar erc-session-server)
(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc--init-cusr-fallback-status "erc" (v h o a q))
(declare-function erc-get-buffer "erc" (target &optional proc))
(declare-function erc-server-buffer "erc" nil)
(declare-function widget-apply-action "wid-edit" (widget &optional event))
@@ -76,11 +77,12 @@ erc-input
make-erc-channel-user
( &key voice halfop op admin owner
last-message-time
- &aux (status (+ (if voice 1 0)
- (if halfop 2 0)
- (if op 4 0)
- (if admin 8 0)
- (if owner 16 0)))))
+ &aux (status
+ (or
+ (and (or voice halfop op admin owner)
+ (erc--init-cusr-fallback-status
+ voice halfop op admin owner))
+ 0))))
:named)
"Object containing channel-specific data for a single user."
;; voice halfop op admin owner
@@ -140,9 +142,12 @@ erc--isupport-data
(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)))
+ ( letters "vhoaq" :type string
+ :documentation "Status letters ranked lowest to highest.")
+ ( statuses "+%@&~" :type string
+ :documentation "Status prefixes ranked lowest to highest.")
+ ( alist nil :type (list-of cons)
+ :documentation "Alist of letters-prefix pairs."))
(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
"Server-local \"CHANMODES\" data."
@@ -594,6 +599,10 @@ erc-define-message-format-catalog
(debug (symbolp [&rest [keywordp form]] &rest (symbolp . form))))
`(erc--define-catalog ,language ,entries))
+(define-inline erc--strpos (char string)
+ "Return position of CHAR in STRING or nil if not found."
+ (inline-quote (string-search (string ,char) ,string)))
+
(defmacro erc--doarray (spec &rest body)
"Map over ARRAY, running BODY with VAR bound to iteration element.
Behave more or less like `seq-doseq', but tailor operations for
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 767a693a52e..5dd820784ce 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -598,28 +598,51 @@ erc-remove-channel-users
erc-channel-users)
(clrhash erc-channel-users)))
-(defmacro erc--define-channel-user-status-compat-getter (name n)
+(defmacro erc--define-channel-user-status-compat-getter (name c d)
"Define a gv getter for historical `erc-channel-user' status slot NAME.
-Expect NAME to be a string and N to be its associated power-of-2
-\"enumerated flag\" integer."
+Expect NAME to be a string, C to be its traditionally associated
+letter, and D to be its fallback power-of-2 integer."
`(defun ,(intern (concat "erc-channel-user-" name)) (u)
,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'."
name)
(declare (gv-setter (lambda (v)
(macroexp-let2 nil v v
- (,'\`(let ((val (erc-channel-user-status ,',u)))
+ (,'\`(let ((val (erc-channel-user-status ,',u))
+ (n (or (erc--get-prefix-flag ,c) ,d)))
(setf (erc-channel-user-status ,',u)
(if ,',v
- (logior val ,n)
- (logand val ,(lognot n))))
+ (logior val n)
+ (logand val (lognot n))))
,',v))))))
- (= ,n (logand ,n (erc-channel-user-status u)))))
-
-(erc--define-channel-user-status-compat-getter "voice" 1)
-(erc--define-channel-user-status-compat-getter "halfop" 2)
-(erc--define-channel-user-status-compat-getter "op" 4)
-(erc--define-channel-user-status-compat-getter "admin" 8)
-(erc--define-channel-user-status-compat-getter "owner" 16)
+ (let ((n (or (erc--get-prefix-flag ,c) ,d)))
+ (= n (logand n (erc-channel-user-status u))))))
+
+(erc--define-channel-user-status-compat-getter "voice" ?v 1)
+(erc--define-channel-user-status-compat-getter "halfop" ?h 2)
+(erc--define-channel-user-status-compat-getter "op" ?o 4)
+(erc--define-channel-user-status-compat-getter "admin" ?a 8)
+(erc--define-channel-user-status-compat-getter "owner" ?q 16)
+
+;; This is a generalized version of the compat-oriented getters above.
+(defun erc--cusr-status-p (nick-or-cusr letter)
+ "Return non-nil if NICK-OR-CUSR has channel membership status LETTER."
+ (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
+ (cdr (erc-get-channel-member nick-or-cusr))))
+ (n (erc--get-prefix-flag letter)))
+ (= n (logand n (erc-channel-user-status cusr)))))
+
+(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp)
+ "Add or remove membership status associated with LETTER for NICK-OR-CUSR.
+With RESETP, clear the user's status info completely. If ENABLEP
+is non-nil, add the status value associated with LETTER."
+ (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
+ (cdr (erc-get-channel-member nick-or-cusr))))
+ (n (erc--get-prefix-flag letter)))
+ (cl-callf (lambda (v)
+ (if resetp
+ (if enablep n 0)
+ (if enablep (logior v n) (logand v (lognot n)))))
+ (erc-channel-user-status cusr))))
(defun erc-channel-user-owner-p (nick)
"Return non-nil if NICK is an owner of the current channel."
@@ -3900,6 +3923,10 @@ erc-send-input-line-function
(defun erc-send-input-line (target line &optional force)
"Send LINE to TARGET."
+ (when-let ((target)
+ (cmem (erc-get-channel-member (erc-current-nick))))
+ (setf (erc-channel-user-last-message-time (cdr cmem))
+ (erc-compat--current-lisp-time)))
(when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n"))
(setq line " \n"))
(erc-message "PRIVMSG" (concat target " " line) force))
@@ -6141,17 +6168,15 @@ erc-get-channel-membership-prefix
(catch 'done
(pcase-dolist (`(,letter . ,pfx)
(erc--parsed-prefix-alist pfx-obj))
- (pcase letter
- ((and ?q (guard (erc-channel-user-owner nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "owner")))
- ((and ?a (guard (erc-channel-user-admin nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "admin")))
- ((and ?o (guard (erc-channel-user-op nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "operator")))
- ((and ?h (guard (erc-channel-user-halfop nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "half-op")))
- ((and ?v (guard (erc-channel-user-voice nick-or-cusr)))
- (throw 'done (propertize (string pfx) 'help-echo "voice")))))
+ (when (erc--cusr-status-p nick-or-cusr letter)
+ (throw 'done
+ (pcase letter
+ (?q (propertize (string pfx) 'help-echo "owner"))
+ (?a (propertize (string pfx) 'help-echo "admin"))
+ (?o (propertize (string pfx) 'help-echo "operator"))
+ (?h (propertize (string pfx) 'help-echo "half-op"))
+ (?v (propertize (string pfx) 'help-echo "voice"))
+ (_ (string pfx))))))
"")))
(t
(cond ((erc-channel-user-owner nick-or-cusr)
@@ -6763,12 +6788,52 @@ erc--parsed-prefix
ordering intact. If no such parameter has yet arrived, return a
stand-in from the fallback value \"(qaohv)~&@%+\"."
(erc--with-isupport-data PREFIX erc--parsed-prefix
- (let ((alist (nreverse (erc-parse-prefix))))
+ (let ((alist (erc-parse-prefix)))
(make-erc--parsed-prefix
:key key
:letters (apply #'string (map-keys alist))
:statuses (apply #'string (map-values alist))
- :alist alist))))
+ :alist (nreverse alist)))))
+
+(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p)
+ "Return numeric rank for CHAR or nil if unknown.
+For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h,
+and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a
+`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to
+be a prefix instead."
+ (and-let* ((obj (or parsed-prefix (erc--parsed-prefix)))
+ (pos (erc--strpos char (if from-prefix-p
+ (erc--parsed-prefix-statuses obj)
+ (erc--parsed-prefix-letters obj)))))
+ (ash 1 pos)))
+
+(defun erc--init-cusr-fallback-status (voice halfop op admin owner)
+ "Return channel-membership based on traditional status semantics.
+Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into
+an internal numeric value suitable for the `status' slot of a new
+`erc-channel-user' object."
+ (let ((pfx (erc--parsed-prefix)))
+ (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0)
+ (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0)
+ (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0)
+ (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0)
+ (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0))))
+
+(defun erc--compute-cusr-fallback-status (current v h o a q)
+ "Return current channel membership after toggling V H O A Q as requested.
+Assume `erc--parsed-prefix' is non-nil in the current buffer.
+Expect status switches V, H, O, A, Q, when non-nil, to be the
+symbol `on' or `off'. Return an internal numeric value suitable
+for the `status' slot of an `erc-channel-user' object."
+ (let (on off)
+ (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off)))
+ (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off)))
+ (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off)))
+ (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off)))
+ (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off)))
+ (when on (setq current (apply #'logior current on)))
+ (when off (setq current (apply #'logand current (mapcar #'lognot off)))))
+ current)
(defcustom erc-channel-members-changed-hook nil
"This hook is called every time the variable `channel-members' changes.
@@ -6776,48 +6841,40 @@ erc-channel-members-changed-hook
:group 'erc-hooks
:type 'hook)
-(defun erc-channel-receive-names (names-string)
- "This function is for internal use only.
+(defun erc--partition-prefixed-names (name)
+ "From NAME, return a list of (STATUS NICK LOGIN HOST).
+Expect NAME to be a prefixed name, like @bob."
+ (unless (string-empty-p name)
+ (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p))
+ (nick (if status (substring name 1) name)))
+ (unless (string-empty-p nick)
+ (list status nick nil nil)))))
-Update `erc-channel-users' according to NAMES-STRING.
-NAMES-STRING is a string listing some of the names on the
-channel."
- (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)))
- (adm-ch (cdr (assq ?a prefix)))
- (own-ch (cdr (assq ?q prefix)))
- (names (delete "" (split-string names-string)))
- name op voice halfop admin owner)
- (let ((erc-channel-members-changed-hook nil))
- (dolist (item names)
- (let ((updatep t)
- (ch (aref item 0)))
- (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off)
- (if (rassq ch prefix)
- (if (= (length item) 1)
- (setq updatep nil)
- (setq name (substring item 1))
- (setf (pcase ch
- ((pred (eq voice-ch)) voice)
- ((pred (eq hop-ch)) halfop)
- ((pred (eq op-ch)) op)
- ((pred (eq adm-ch)) admin)
- ((pred (eq own-ch)) owner)
- (_ (message "Unknown prefix char `%S'" ch) voice))
- 'on)))
- (when updatep
+(defun erc-channel-receive-names (names-string)
+ "Update `erc-channel-members' from NAMES-STRING.
+Expect NAMES-STRING to resemble the trailing argument of a 353
+RPL_NAMREPLY. Call internal handlers for parsing individual
+names, whose expected composition may differ depending on enabled
+extensions."
+ (let ((names (delete "" (split-string names-string)))
+ (erc-channel-members-changed-hook nil))
+ (dolist (name names)
+ (when-let ((args (erc--partition-prefixed-names name)))
+ (pcase-let* ((`(,status ,nick ,login ,host) args)
+ (cmem (erc-get-channel-user nick)))
+ (progn
;; If we didn't issue the NAMES request (consider two clients
;; talking to an IRC proxy), `erc-channel-begin-receiving-names'
;; will not have been called, so we have to do it here.
(unless erc-channel-new-member-names
(erc-channel-begin-receiving-names))
- (puthash (erc-downcase name) t
- erc-channel-new-member-names)
- (erc-update-current-channel-member
- name name t voice halfop op admin owner)))))
- (run-hooks 'erc-channel-members-changed-hook)))
+ (puthash (erc-downcase nick) t erc-channel-new-member-names)
+ (if cmem
+ (erc--update-current-channel-member cmem status nil
+ nick host login)
+ (erc--create-current-channel-member nick status nil
+ nick host login)))))))
+ (run-hooks 'erc-channel-members-changed-hook))
(defun erc-update-user-nick (nick &optional new-nick
host login full-name info)
@@ -6869,17 +6926,85 @@ erc-update-user
(run-hooks 'erc-channel-members-changed-hook))))))
changed))
+(defun erc--create-current-channel-member
+ (nick status timep &optional new-nick host login full-name info)
+ "Add an `erc-channel-member' entry for NICK.
+Create a new `erc-server-users' entry if necessary, and ensure
+`erc-channel-members-changed-hook' runs exactly once, regardless.
+Pass STATUS to the `erc-channel-user' constructor. With TIMEP,
+assume NICK has just spoken, and initialize `last-message-time'.
+Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to
+`erc-update-user' if a server user exists and otherwise to the
+`erc-server-user' constructor."
+ (cl-assert (null (erc-get-channel-member nick)))
+ (let* ((user-changed-p nil)
+ (down (erc-downcase nick))
+ (user (gethash down (erc-with-server-buffer erc-server-users))))
+ (if user
+ (progn
+ (cl-pushnew (current-buffer) (erc-server-user-buffers user))
+ ;; Update *after* ^ so hook has chance to run.
+ (setf user-changed-p (erc-update-user user new-nick host login
+ full-name info)))
+ (erc-add-server-user nick
+ (setq user (make-erc-server-user
+ :nickname (or new-nick nick)
+ :host host
+ :full-name full-name
+ :login login
+ :info nil
+ :buffers (list (current-buffer))))))
+ (let ((cusr (erc-channel-user--make
+ :status (or status 0)
+ :last-message-time (and timep
+ (erc-compat--current-lisp-time)))))
+ (puthash down (cons user cusr) erc-channel-users))
+ ;; An existing `cusr' was changed or a new one was added, and
+ ;; `user' was not updated, though possibly just created (since
+ ;; `erc-update-user' runs this same hook in all a user's buffers).
+ (unless user-changed-p
+ (run-hooks 'erc-channel-members-changed-hook))
+ t))
+
+(defun erc--update-current-channel-member (cmem status timep &rest user-args)
+ "Update existing `erc-channel-member' entry.
+Set the `status' slot of the entry's `erc-channel-user' side to
+STATUS and, with TIMEP, update its `last-message-time'. When
+actual changes are made, run `erc-channel-members-changed-hook',
+and return non-nil."
+ (cl-assert cmem)
+ (let ((cusr (cdr cmem))
+ (user (car cmem))
+ cusr-changed-p user-changed-p)
+ (when (and status (/= status (erc-channel-user-status cusr)))
+ (setf (erc-channel-user-status cusr) status
+ cusr-changed-p t))
+ (when timep
+ (setf (erc-channel-user-last-message-time cusr)
+ (erc-compat--current-lisp-time)))
+ ;; Ensure `erc-channel-members-changed-hook' runs on change.
+ (cl-assert (memq (current-buffer) (erc-server-user-buffers user)))
+ (setq user-changed-p (apply #'erc-update-user user user-args))
+ ;; An existing `cusr' was changed or a new one was added, and
+ ;; `user' was not updated, though possibly just created (since
+ ;; `erc-update-user' runs this same hook in all a user's buffers).
+ (when (and cusr-changed-p (null user-changed-p))
+ (run-hooks 'erc-channel-members-changed-hook))
+ (erc-log (format "update-member: user = %S, cusr = %S" user cusr))
+ (or cusr-changed-p user-changed-p)))
+
(defun erc-update-current-channel-member
- (nick new-nick &optional addp voice halfop op admin owner host login full-name info
- update-message-time)
+ (nick new-nick &optional addp voice halfop op admin owner host login
+ full-name info update-message-time)
"Update or create entry for NICK in current `erc-channel-members' table.
-With ADDP, ensure an entry exists. If one already does, call
-`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME,
-INFO, and NEW-NICK. Expect any non-nil membership status
-switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the
-symbol `on' or `off' when needing to influence a new or existing
-`erc-channel-user' object's `status' slot. Likewise, when
-UPDATE-MESSAGE-TIME is non-nil, update or initialize the
+With ADDP, ensure an entry exists. When an entry does exist or
+when ADDP is non-nil and an `erc-server-users' entry already
+exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN,
+FULL-NAME, and INFO. Expect any non-nil membership
+status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be
+the symbol `on' or `off' when needing to influence a new or
+existing `erc-channel-user' object's `status' slot. Likewise,
+when UPDATE-MESSAGE-TIME is non-nil, update or initialize the
`last-message-time' slot to the current-time. If changes occur,
including creation, run `erc-channel-members-changed-hook'.
Return non-nil when meaningful changes, including creation, have
@@ -6889,62 +7014,26 @@ erc-update-current-channel-member
exists. When it doesn't, assume the sender is a non-joined
entity, like the server itself or a historical speaker, or assume
the prior buffer for the channel was killed without parting."
- (let* (cusr-changed-p
- user-changed-p
- (cmem (erc-get-channel-member nick))
- (cusr (cdr cmem))
- (down (erc-downcase nick))
- (user (or (car cmem)
- (gethash down (erc-with-server-buffer erc-server-users)))))
- (if cusr
- (progn
- (erc-log (format "update-member: user = %S, cusr = %S" user cusr))
- (when-let (((or voice halfop op admin owner))
- (existing (erc-channel-user-status cusr)))
- (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on)))
- (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on)))
- (when op (setf (erc-channel-user-op cusr) (eq op 'on)))
- (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on)))
- (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on)))
- (setq cusr-changed-p (= existing (erc-channel-user-status cusr))))
- (when update-message-time
- (setf (erc-channel-user-last-message-time cusr) (current-time)))
- ;; Assume `user' exists and its `buffers' slot contains the
- ;; current buffer so that `erc-channel-members-changed-hook'
- ;; will run if changes are made.
- (setq user-changed-p
- (erc-update-user user new-nick
- host login full-name info)))
- (when addp
- (if (null user)
- (progn
- (setq user (make-erc-server-user
- :nickname nick
- :host host
- :full-name full-name
- :login login
- :info info
- :buffers (list (current-buffer))))
- (erc-add-server-user nick user))
- (setf (erc-server-user-buffers user)
- (cons (current-buffer)
- (erc-server-user-buffers user))))
- (setq cusr (make-erc-channel-user
- :voice (and voice (eq voice 'on))
- :halfop (and halfop (eq halfop 'on))
- :op (and op (eq op 'on))
- :admin (and admin (eq admin 'on))
- :owner (and owner (eq owner 'on))
- :last-message-time (if update-message-time
- (current-time))))
- (puthash down (cons user cusr) erc-channel-users)
- (setq cusr-changed-p t)))
- ;; An existing `cusr' was changed or a new one was added, and
- ;; `user' was not updated, though possibly just created (since
- ;; `erc-update-user' runs this same hook in all a user's buffers).
- (when (and cusr-changed-p (null user-changed-p))
- (run-hooks 'erc-channel-members-changed-hook))
- (or cusr-changed-p user-changed-p)))
+(let* ((cmem (erc-get-channel-member nick))
+ (status (and (or voice halfop op admin owner)
+ (if cmem
+ (erc--compute-cusr-fallback-status
+ (erc-channel-user-status (cdr cmem))
+ voice halfop op admin owner)
+ (erc--init-cusr-fallback-status
+ (and voice (eq voice 'on))
+ (and halfop (eq halfop 'on))
+ (and op (eq op 'on))
+ (and admin (eq admin 'on))
+ (and owner (eq owner 'on)))))))
+ (if cmem
+ (erc--update-current-channel-member cmem status update-message-time
+ new-nick host login
+ full-name info)
+ (when addp
+ (erc--create-current-channel-member nick status update-message-time
+ new-nick host login
+ full-name info)))))
(defun erc-update-channel-member (channel nick new-nick
&optional add voice halfop op admin owner host login
@@ -7134,16 +7223,6 @@ 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,
@@ -7189,7 +7268,7 @@ erc--process-channel-modes
(cond ((= ?+ c) (setq +p t))
((= ?- c) (setq +p nil))
((and status-letters (string-search (string c) status-letters))
- (erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
+ (erc--cusr-change-status (pop args) c +p))
((and-let* ((group (or (aref table c) (and fallbackp ?d))))
(erc--handle-channel-mode group c +p
(and (/= group ?d)
@@ -7511,6 +7590,12 @@ erc--parse-nuh
(match-string 2 string)
(match-string 3 string))))
+(defun erc--shuffle-nuh-nickward (nick login host)
+ "Interpret results of `erc--parse-nuh', promoting loners to nicks."
+ (cond (nick (cl-assert (null login)) (list nick login host))
+ ((and (null login) host) (list host nil nil))
+ ((and login (null host)) (list login nil nil))))
+
(defun erc-extract-nick (string)
"Return the nick corresponding to a user specification STRING.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 49c72836a22..b51bd67ae04 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -674,7 +674,7 @@ erc--parsed-prefix
;; checking if null beforehand.
(should-not erc--parsed-prefix)
(should (equal (erc--parsed-prefix)
- #s(erc--parsed-prefix nil "qaohv" "~&@%+"
+ #s(erc--parsed-prefix nil "vhoaq" "+%@&~"
((?q . ?~) (?a . ?&)
(?o . ?@) (?h . ?%) (?v . ?+)))))
(let ((cached (should erc--parsed-prefix)))
@@ -696,7 +696,7 @@ 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 ("(ov)@+") "ov" "@+"
+ #s(erc--parsed-prefix ("(ov)@+") "vo" "+@"
((?o . ?@) (?v . ?+)))))
;; Second target buffer reuses cached value.
(with-temp-buffer
@@ -714,6 +714,88 @@ erc--parsed-prefix
(erc-with-server-buffer erc--parsed-prefix))
'((?q . ?~) (?h . ?%)))))))
+(ert-deftest erc--get-prefix-flag ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should-not erc--parsed-prefix)
+ (should (= (erc--get-prefix-flag ?v) 1))
+ (should (= (erc--get-prefix-flag ?h) 2))
+ (should (= (erc--get-prefix-flag ?o) 4))
+ (should (= (erc--get-prefix-flag ?a) 8))
+ (should (= (erc--get-prefix-flag ?q) 16))
+
+ (ert-info ("With optional `from-prefix-p'")
+ (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1))
+ (should (= (erc--get-prefix-flag ?% nil 'fpp) 2))
+ (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4))
+ (should (= (erc--get-prefix-flag ?& nil 'fpp) 8))
+ (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--init-cusr-fallback-status ()
+ ;; Fallback behavior active because no `erc--parsed-prefix'.
+ (should-not erc--parsed-prefix)
+ (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
+ (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil)))
+ (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil)))
+ (should-not erc--parsed-prefix) ; not created in non-ERC buffer.
+
+ ;; Uses advertised server parameter.
+ (erc-tests-common-make-server-buf (buffer-name))
+ (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-")))
+ (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
+ (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil)))
+ (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--compute-cusr-fallback-status ()
+ ;; Useless without an `erc--parsed-prefix'.
+ (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
+ (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on)))
+
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off)))
+ (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off)))
+ (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil)))
+ (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil)))
+ (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil))))
+
+(ert-deftest erc--cusr-status-p ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (should-not erc--parsed-prefix)
+ (let ((cusr (make-erc-channel-user :voice t :op t)))
+ (should-not (erc--cusr-status-p cusr ?q))
+ (should-not (erc--cusr-status-p cusr ?a))
+ (should-not (erc--cusr-status-p cusr ?h))
+ (should (erc--cusr-status-p cusr ?o))
+ (should (erc--cusr-status-p cusr ?v)))
+ (should erc--parsed-prefix))
+
+(ert-deftest erc--cusr-change-status ()
+ (erc-tests-common-make-server-buf (buffer-name))
+ (let ((cusr (make-erc-channel-user)))
+ (should-not (erc--cusr-status-p cusr ?o))
+ (should-not (erc--cusr-status-p cusr ?v))
+ (erc--cusr-change-status cusr ?o t)
+ (erc--cusr-change-status cusr ?v t)
+ (should (erc--cusr-status-p cusr ?o))
+ (should (erc--cusr-status-p cusr ?v))
+
+ (ert-info ("Reset with optional param")
+ (erc--cusr-change-status cusr ?q t 'reset)
+ (should-not (erc--cusr-status-p cusr ?o))
+ (should-not (erc--cusr-status-p cusr ?v))
+ (should (erc--cusr-status-p cusr ?q)))
+
+ (ert-info ("Clear with optional param")
+ (erc--cusr-change-status cusr ?v t)
+ (should (erc--cusr-status-p cusr ?v))
+ (erc--cusr-change-status cusr ?q nil 'reset)
+ (should-not (erc--cusr-status-p cusr ?v))
+ (should-not (erc--cusr-status-p cusr ?q)))))
+
;; 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 ()
@@ -737,12 +819,9 @@ erc-parse-modes
(should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
(ert-deftest erc--update-channel-modes ()
- (erc-mode)
+ (erc-tests-common-make-server-buf)
(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-common-init-server-proc "sleep" "1")
(let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
calls)
@@ -1715,13 +1794,13 @@ erc-extract-command-from-line
;; regardless of whether a command handler is summoned.
(ert-deftest erc-process-input-line ()
- (let (erc-server-last-sent-time
- erc-server-flood-queue
- (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
- (erc-default-recipients '("#chan"))
+ (erc-tests-common-make-server-buf)
+ (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
+ (pop-flood-queue (lambda () (erc-with-server-buffer
+ (pop erc-server-flood-queue))))
calls)
- (with-temp-buffer
- (erc-tests-common-init-server-proc "sleep" "1")
+ (setq erc-server-current-nick "tester")
+ (with-current-buffer (erc--open-target "#chan")
(cl-letf (((symbol-function 'erc-cmd-MSG)
(lambda (line)
(push line calls)
@@ -1735,49 +1814,50 @@ erc-process-input-line
(ert-info ("Baseline")
(erc-process-input-line "/msg #chan hi\n")
(should (equal (pop calls) " #chan hi"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi\r\n" . utf-8))))
(ert-info ("Quote preserves line intact")
(erc-process-input-line "/QUOTE FAKE foo bar\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("FAKE foo bar\r\n" . utf-8))))
(ert-info ("Unknown command respected")
(erc-process-input-line "/FAKE foo bar\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("FAKE foo bar\r\n" . utf-8))))
(ert-info ("Spaces preserved")
(erc-process-input-line "/msg #chan hi you\n")
(should (equal (pop calls) " #chan hi you"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
(ert-info ("Empty line honored")
(erc-process-input-line "/msg #chan\n")
(should (equal (pop calls) " #chan"))
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :\r\n" . utf-8)))))
(ert-info ("Implicit cmd via `erc-send-input-line-function'")
(ert-info ("Baseline")
(erc-process-input-line "hi\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi\r\n" . utf-8))))
(ert-info ("Spaces preserved")
(erc-process-input-line "hi you\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan :hi you\r\n" . utf-8))))
(ert-info ("Empty line transmitted with injected-space kludge")
(erc-process-input-line "\n")
- (should (equal (pop erc-server-flood-queue)
+ (should (equal (funcall pop-flood-queue)
'("PRIVMSG #chan : \r\n" . utf-8))))
- (should-not calls))))))
+ (should-not calls)))))
+ (erc-tests-common-kill-buffers))
(ert-deftest erc--get-inserted-msg-beg/basic ()
(erc-tests-common-assert-get-inserted-msg/basic
--
2.42.0
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <87mst2unhi.fsf@neverwas.me>
@ 2024-01-25 21:45 ` J.P.
0 siblings, 0 replies; 11+ messages in thread
From: J.P. @ 2024-01-25 21:45 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> 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.
>
> In the initial set of changes, I only partially implemented PREFIX-aware
> channel-membership handling (here and in bug#67677, for the formatting
> side). The main reason for this omission was that I mistakenly assumed
> the lack of a valid use case for doing so. However, a latent clue in our
> own test suite attesting to the contrary was staring me in the face the
> whole time (until I unceremoniously erased it [1]). Since then, I've
> come around on this and now think we might as well see it through the
> somewhat arduous last mile. See attached.
>
> Thanks.
>
> [1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=4939f413
> ^ Grep for "Yqaohv".
The mentioned changes have been installed as:
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=aedc8b55
This bug is already closed.
^ permalink raw reply [flat|nested] 11+ 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.
` (3 preceding siblings ...)
[not found] ` <87mst2unhi.fsf@neverwas.me>
@ 2024-02-14 1:45 ` J.P.
[not found] ` <871q9fhl8j.fsf@neverwas.me>
5 siblings, 0 replies; 11+ messages in thread
From: J.P. @ 2024-02-14 1:45 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1662 bytes --]
This commit
e69bd59ec59784b2f646e93355d4d63f41426cfc
Honor arbitrary CHANTYPES in ERC
* lisp/erc/erc.el (erc-channel-p): Favor "CHANTYPES" ISUPPORT item
before falling back to well known prefixes.
* test/lisp/erc/erc-tests.el (erc-channel-p): Add test. Arbitrarily
bundled with bug#60954.
introduced "smarter" handling of CHANTYPES but overlooked a subtlety
regarding how ERC interprets empty vs. missing ISUPPORT values. As
implied in a comment for the function `erc--parse-isupport-value',
;; https://tools.ietf.org/html/draft-brocklesby-irc-isupport-03#section-2
;;
;; > The server SHOULD send "X", not "X="; this is the normalized form.
;;
;; Note: for now, assume the server will only send non-empty values,
ERC punts on this. Indeed, it's always treated "X=" as having a value
and thus deserving of ("X" . "") in `erc-server-parameters', whereas
it's always seen "X" as more of a flag/switch with no associated value,
hence ("X").
It turns out a not entirely frivolous use case for abiding by that RFC
draft and *not* distinguishing between the two forms has arisen.
Basically, a server may choose to support no channels whatsoever for a
subset of clients, limiting them to direct messages only. To accommodate
this, ERC will need to interpret both "CHANTYPES" and "CHANTYPES=" as
expressing such a policy instead of sticking with its current behavior
of only doing so for the "=" form and treating "CHANTYPES" as equivalent
to ${default/fallback} (and thus also to "-CHANTYPES", which is clearly
wrong).
I think it's worth correcting this in ERC 5.6. Proposed changes
attached. (The first patch is unrelated.)
Thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Ignore-the-TGT-LIST-parameter-in-erc-open.patch --]
[-- Type: text/x-patch, Size: 3354 bytes --]
From 20aed6e1b7ab514669a3980f6b5d96d655e1b851 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 11 Feb 2024 20:42:18 -0800
Subject: [PATCH 1/3] [5.6] Ignore the TGT-LIST parameter in erc-open
* lisp/erc/erc.el (erc-open): Set `erc-default-recipients' to a list
containing only the supplied target. Any other value may cause ERC to
malfunction. Also redo doc string.
---
lisp/erc/erc.el | 39 ++++++++++++++++-----------------------
1 file changed, 16 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 08dfa4b8f1b..45869f43c91 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2479,29 +2479,22 @@ erc--initialize-markers
(cl-assert (= (point) (point-max)))))
(defun erc-open (&optional server port nick full-name
- connect passwd tgt-list channel process
+ connect passwd _tgt-list channel process
client-certificate user id)
- "Connect to SERVER on PORT as NICK with USER and FULL-NAME.
-
-If CONNECT is non-nil, connect to the server. Otherwise assume
-already connected and just create a separate buffer for the new
-target given by CHANNEL, meaning these parameters are mutually
-exclusive. Note that CHANNEL may also be a query; its name has
-been retained for historical reasons.
-
-Use PASSWD as user password on the server. If TGT-LIST is
-non-nil, use it to initialize `erc-default-recipients'.
-
-CLIENT-CERTIFICATE, if non-nil, should either be a list where the
-first element is the file name of the private key corresponding
-to a client certificate and the second element is the file name
-of the client certificate itself to use when connecting over TLS,
-or t, which means that `auth-source' will be queried for the
-private key and the certificate.
-
-When non-nil, ID should be a symbol for identifying the connection.
-
-Returns the buffer for the given server or channel."
+ "Return a new or reinitialized server or target buffer.
+If CONNECT is non-nil, connect to SERVER and return its new or
+reassociated buffer. Otherwise, assume PROCESS is non-nil and belongs
+to an active session, and return a new or refurbished target buffer for
+CHANNEL, which may also be a query target (the parameter name remains
+for historical reasons). Pass SERVER, PORT, NICK, USER, FULL-NAME, and
+PASSWD to `erc-determine-parameters' for preserving as session-local
+variables. Do something similar for CLIENT-CERTIFICATE and ID, which
+should be as described by `erc-tls'.
+
+Note that ERC ignores TGT-LIST and initializes `erc-default-recipients'
+with CHANNEL as its only member. Note also that this function has the
+side effect of setting the current buffer to the one it returns. Use
+`with-current-buffer' or `save-excursion' to nullify this effect."
(let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer))
@@ -2538,7 +2531,7 @@ erc-open
;; connection parameters
(setq erc-server-process process)
;; stack of default recipients
- (setq erc-default-recipients tgt-list)
+ (when channel (setq erc-default-recipients (list channel)))
(when target
(setq erc--target target
erc-network (erc-network)))
--
2.43.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-5.6-Normalize-ISUPPORT-params-with-empty-values-in-E.patch --]
[-- Type: text/x-patch, Size: 7296 bytes --]
From fbfc31ab2f1675136ecbe4c030606f031d8bec90 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 11 Feb 2024 17:15:14 -0800
Subject: [PATCH 2/3] [5.6] Normalize ISUPPORT params with empty values in ERC
* lisp/erc/erc-backend.el (erc-server-parameters)
(erc--isupport-params): Mention parsing and storage behavior regarding
nonstandard "FOO=" tokens.
(erc--parse-isupport-value): Move comment closer to code.
(erc--get-isupport-entry): Treat the empty string as truly null, as
prescribed by the Brocklesby draft cited in the top-level comment.
* test/lisp/erc/erc-tests.el (erc--get-isupport-entry): Add case for
the empty string appearing as a value for an `erc-server-parameters'
item.
(erc-server-005): Assert compat-related behavior of retaining the
empty string as a valid value from a raw "FOO=" token.
---
lisp/erc/erc-backend.el | 20 ++++++++++++--------
test/lisp/erc/erc-tests.el | 26 ++++++++++++++++++--------
2 files changed, 30 insertions(+), 16 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index e379066b08e..2c6da90890b 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -254,6 +254,10 @@ erc-server-parameters
or
(PARAMETER) if no value is provided.
+where PARAMETER is a string and VALUE is a string or nil. For
+compatibility, a raw parameter of the form \"FOO=\" becomes
+(\"FOO\" . \"\") even though it's equivalent to \"FOO\" => (\"FOO\").
+
Some examples of possible parameters sent by servers:
CHANMODES=b,k,l,imnpst - list of supported channel modes
CHANNELLEN=50 - maximum length of channel names
@@ -273,7 +277,8 @@ erc-server-parameters
(defvar-local erc--isupport-params nil
"Hash map of \"ISUPPORT\" params.
Keys are symbols. Values are lists of zero or more strings with hex
-escapes removed.")
+escapes removed. ERC normalizes incoming parameters of the form
+\"FOO=\" to (FOO).")
;;; Server and connection state
@@ -2150,10 +2155,6 @@ erc--parse-isupport-value
;;
;; > The server SHOULD send "X", not "X="; this is the normalized form.
;;
- ;; Note: for now, assume the server will only send non-empty values,
- ;; possibly with printable ASCII escapes. Though in practice, the
- ;; only two escapes we're likely to see are backslash and space,
- ;; meaning the pattern is too liberal.
(let (case-fold-search)
(mapcar
(lambda (v)
@@ -2164,7 +2165,9 @@ erc--parse-isupport-value
(string-match "[\\]x[0-9A-F][0-9A-F]" v start))
(setq m (substring v (+ 2 (match-beginning 0)) (match-end 0))
c (string-to-number m 16))
- (if (<= ?\ c ?~)
+ ;; In practice, this range is too liberal. The only
+ ;; escapes we're likely to see are ?\\, ?=, and ?\s.
+ (if (<= ?\s c ?~)
(setq v (concat (substring v 0 (match-beginning 0))
(string c)
(substring v (match-end 0)))
@@ -2189,8 +2192,9 @@ erc--get-isupport-entry
(or erc-server-parameters
(erc-with-server-buffer
erc-server-parameters)))))
- (if (cdr v)
- (erc--parse-isupport-value (cdr v))
+ (if-let ((vv (cdr v))
+ ((not (string-empty-p vv))))
+ (erc--parse-isupport-value vv)
'--empty--)))))
(pcase value
('--empty-- (unless single (list key)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 7d189d37929..827bd9435e1 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1054,7 +1054,8 @@ erc--parse-isupport-value
(ert-deftest erc--get-isupport-entry ()
(let ((erc--isupport-params (make-hash-table))
- (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")))
+ (erc-server-parameters '(("FOO" . "1") ("BAR") ("BAZ" . "A,B,C")
+ ("SPAM" . "")))
(items (lambda ()
(cl-loop for k being the hash-keys of erc--isupport-params
using (hash-values v) collect (cons k v)))))
@@ -1075,7 +1076,9 @@ erc--get-isupport-entry
(should (equal (erc--get-isupport-entry 'FOO) '(FOO "1")))
(should (equal (funcall items)
- '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))))
+ '((BAR . --empty--) (BAZ "A" "B" "C") (FOO "1"))))
+ (should (equal (erc--get-isupport-entry 'SPAM) '(SPAM)))
+ (should-not (erc--get-isupport-entry 'SPAM 'single))))
(ert-deftest erc-server-005 ()
(let* ((hooked 0)
@@ -1093,34 +1096,41 @@ erc-server-005
(lambda (_ _ _ line) (push line calls))))
(ert-info ("Baseline")
- (setq args '("tester" "BOT=B" "EXCEPTS" "PREFIX=(ov)@+" "are supp...")
+ (setq args '("tester" "BOT=B" "CHANTYPES=" "EXCEPTS" "PREFIX=(ov)@+"
+ "are supp...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ov)@+") ("EXCEPTS")
+ ;; Should be ("CHANTYPES") but
+ ;; retained for compatibility.
+ ("CHANTYPES" . "")
("BOT" . "B"))))
(should (zerop (hash-table-count erc--isupport-params)))
(should (equal "(ov)@+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal '(EXCEPTS) (erc--get-isupport-entry 'EXCEPTS)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
- (should (string= (pop calls)
- "BOT=B EXCEPTS PREFIX=(ov)@+ are supp..."))
+ (should (string=
+ (pop calls)
+ "BOT=B CHANTYPES= EXCEPTS PREFIX=(ov)@+ are supp..."))
(should (equal args (erc-response.command-args parsed)))))
(erc-call-hooks nil parsed))
(ert-info ("Negated, updated")
- (setq args '("tester" "-EXCEPTS" "-FAKE" "PREFIX=(ohv)@%+" "are su...")
+ (setq args '("tester" "-EXCEPTS" "-CHANTYPES" "-FAKE" "PREFIX=(ohv)@%+"
+ "are su...")
parsed (make-erc-response :command-args args :command "005"))
(setq verify
(lambda ()
(should (equal erc-server-parameters
'(("PREFIX" . "(ohv)@%+") ("BOT" . "B"))))
- (should (string= (pop calls)
- "-EXCEPTS -FAKE PREFIX=(ohv)@%+ are su..."))
+ (should (string-prefix-p
+ "-EXCEPTS -CHANTYPES -FAKE PREFIX=(ohv)@%+ "
+ (pop calls)))
(should (equal "(ohv)@%+" (erc--get-isupport-entry 'PREFIX t)))
(should (equal "B" (erc--get-isupport-entry 'BOT t)))
(should-not (erc--get-isupport-entry 'EXCEPTS))
--
2.43.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-5.6-Use-modern-fallback-for-channel-name-detection-i.patch --]
[-- Type: text/x-patch, Size: 5954 bytes --]
From d252960c60af97e669f1c120722f36f5166550c2 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 11 Feb 2024 20:01:54 -0800
Subject: [PATCH 3/3] [5.6] Use modern fallback for channel name detection in
ERC
* lisp/erc/erc-backend.el (erc-query-buffer-p): Remove forward declaration.
* lisp/erc/erc.el (erc-query-buffer-p): Defer to `erc-channel-p'.
(erc-channel-p): Refactor and use `erc--fallback-channel-prefixes' for
the default CHANTYPES value. Honor an empty CHANTYPES set as valid
for dealing with servers that only support direct messages.
(erc--fallback-channel-prefixes): New variable to hold fallback
CHANTYPES value recommended by authorities on the matter.
* test/lisp/erc/erc-tests.el (erc-channel-p): Revise test.
---
lisp/erc/erc-backend.el | 1 -
lisp/erc/erc.el | 32 +++++++++++++-------------
test/lisp/erc/erc-tests.el | 46 ++++++++++++++++++++++++--------------
3 files changed, 44 insertions(+), 35 deletions(-)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 2c6da90890b..fbbda6fdbec 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -158,7 +158,6 @@ erc-verbose-server-ping
(declare-function erc-parse-user "erc" (string))
(declare-function erc-process-away "erc" (proc away-p))
(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host))
-(declare-function erc-query-buffer-p "erc" (&optional buffer))
(declare-function erc-remove-channel-member "erc" (channel nick))
(declare-function erc-remove-channel-users "erc" nil)
(declare-function erc-remove-user "erc" (nick))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 45869f43c91..154b55c4b62 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1656,11 +1656,7 @@ erc-open-server-buffer-p
(defun erc-query-buffer-p (&optional buffer)
"Return non-nil if BUFFER is an ERC query buffer.
If BUFFER is nil, the current buffer is used."
- (with-current-buffer (or buffer (current-buffer))
- (let ((target (erc-target)))
- (and (eq major-mode 'erc-mode)
- target
- (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
+ (not (erc-channel-p (or buffer (current-buffer)))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
@@ -1875,18 +1871,20 @@ erc-reuse-frames
:group 'erc-buffers
:type 'boolean)
-(defun erc-channel-p (channel)
- "Return non-nil if CHANNEL seems to be an IRC channel name."
- (cond ((stringp channel)
- (memq (aref channel 0)
- (if-let ((types (erc--get-isupport-entry 'CHANTYPES 'single)))
- (append types nil)
- '(?# ?& ?+ ?!))))
- ((and-let* (((bufferp channel))
- ((buffer-live-p channel))
- (target (buffer-local-value 'erc--target channel)))
- (erc-channel-p (erc--target-string target))))
- (t nil)))
+(defvar erc--fallback-channel-prefixes "#&"
+ "Prefix chars for distinguishing channel targets when CHANTYPES is unknown.")
+
+(defun erc-channel-p (target)
+ "Return non-nil if TARGET is a valid channel name or a channel buffer."
+ (cond ((stringp target)
+ (and-let*
+ (((not (string-empty-p target)))
+ (value (let ((entry (erc--get-isupport-entry 'CHANTYPES)))
+ (if entry (cadr entry) erc--fallback-channel-prefixes)))
+ ((erc--strpos (aref target 0) value)))))
+ ((and-let* (((buffer-live-p target))
+ (target (buffer-local-value 'erc--target target))
+ ((erc--target-channel-p target)))))))
;; For the sake of compatibility, a historical quirk concerning this
;; option, when nil, has been preserved: all buffers are suffixed with
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 827bd9435e1..1c16c3633c8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1167,25 +1167,37 @@ erc-downcase
(should (equal (erc-downcase "\\O/") "|o/" )))))
(ert-deftest erc-channel-p ()
- (let ((erc--isupport-params (make-hash-table))
- erc-server-parameters)
-
- (should (erc-channel-p "#chan"))
- (should (erc-channel-p "##chan"))
- (should (erc-channel-p "&chan"))
- (should (erc-channel-p "+chan"))
- (should (erc-channel-p "!chan"))
- (should-not (erc-channel-p "@chan"))
-
- (push '("CHANTYPES" . "#&@+!") erc-server-parameters)
+ (erc-tests-common-make-server-buf)
- (should (erc-channel-p "!chan"))
- (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "##chan"))
+ (should (erc-channel-p "&chan"))
+ (should-not (erc-channel-p "+chan"))
+ (should-not (erc-channel-p "!chan"))
+ (should-not (erc-channel-p "@chan"))
+
+ ;; Server sends "CHANTYPES=#&+!"
+ (should-not erc-server-parameters)
+ (setq erc-server-parameters '(("CHANTYPES" . "#&+!")))
+ (should (erc-channel-p "#chan"))
+ (should (erc-channel-p "&chan"))
+ (should (erc-channel-p "+chan"))
+ (should (erc-channel-p "!chan"))
+
+ (with-current-buffer (erc--open-target "#chan")
+ (should (erc-channel-p (current-buffer))))
+ (with-current-buffer (erc--open-target "+chan")
+ (should (erc-channel-p (current-buffer))))
+ (should (erc-channel-p (get-buffer "#chan")))
+ (should (erc-channel-p (get-buffer "+chan")))
+
+ ;; Server sends "CHANTYPES=" because it's query only.
+ (puthash 'CHANTYPES '("CHANTYPES") erc--isupport-params)
+ (should-not (erc-channel-p "#spam"))
+ (should-not (erc-channel-p "&spam"))
+ (should-not (erc-channel-p (save-excursion (erc--open-target "#spam"))))
- (with-current-buffer (get-buffer-create "#chan")
- (setq erc--target (erc--target-from-string "#chan")))
- (should (erc-channel-p (get-buffer "#chan"))))
- (kill-buffer "#chan"))
+ (erc-tests-common-kill-buffers))
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
--
2.43.0
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <871q9fhl8j.fsf@neverwas.me>
@ 2024-02-21 1:14 ` J.P.
[not found] ` <87o7cabou8.fsf@neverwas.me>
1 sibling, 0 replies; 11+ messages in thread
From: J.P. @ 2024-02-21 1:14 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> It turns out a not entirely frivolous use case for abiding by that RFC
> draft and *not* distinguishing between the two forms has arisen.
> Basically, a server may choose to support no channels whatsoever for a
> subset of clients, limiting them to direct messages only. To accommodate
> this, ERC will need to interpret both "CHANTYPES" and "CHANTYPES=" as
> expressing such a policy instead of sticking with its current behavior
> of only doing so for the "=" form and treating "CHANTYPES" as equivalent
> to ${default/fallback} (and thus also to "-CHANTYPES", which is clearly
> wrong).
>
> I think it's worth correcting this in ERC 5.6. Proposed changes
> attached. (The first patch is unrelated.)
These changes now live on master as
3d87e343276 * Use modern fallback for channel name detection in ERC
25d15391f26 * Normalize ISUPPORT params with empty values in ERC
If anyone experiences new difficulties related to detecting channel
names, these are likely to blame.
^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <87o7cabou8.fsf@neverwas.me>
@ 2024-04-13 22:17 ` J.P.
[not found] ` <877ch09acj.fsf@neverwas.me>
1 sibling, 0 replies; 11+ messages in thread
From: J.P. @ 2024-04-13 22:17 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 731 bytes --]
"J.P." <jp@neverwas.me> writes:
>> I think it's worth correcting this in ERC 5.6. Proposed changes
>> attached. (The first patch is unrelated.)
>
> These changes now live on master as
>
> 3d87e343276 * Use modern fallback for channel name detection in ERC
> 25d15391f26 * Normalize ISUPPORT params with empty values in ERC
>
> If anyone experiences new difficulties related to detecting channel
> names, these are likely to blame.
A regression involving `erc-query-buffer-p' has surfaced that basically
makes the function unsuable in many situations. The root cause is some
combination of stupdiity and laziness on my part, as usual. The attached
patch should fix the issue. Thanks to Libera user mekeor for reporting
this.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-regression-involving-erc-query-buffer-p.patch --]
[-- Type: text/x-patch, Size: 2967 bytes --]
From 415bde2403aa9564d138d0f504df36e6f9e956a3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sat, 13 Apr 2024 14:58:13 -0700
Subject: [PATCH] Fix regression involving erc-query-buffer-p
* lisp/erc/erc.el (erc-query-buffer-p): Don't return non-nil in
non-ERC buffers and server buffers, and continue to honor string
arguments. The regression was introduced by 3d87e343 "Use modern
fallback for channel name detection in ERC". Thanks to Libera user
mekeor for reporting this bug.
* test/lisp/erc/erc-tests.el (erc-query-buffer-p): New test.
(Bug#67220)
---
lisp/erc/erc.el | 9 +++++++--
test/lisp/erc/erc-tests.el | 29 +++++++++++++++++++++++++++++
2 files changed, 36 insertions(+), 2 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 4ed77655f19..ecb884fb1ab 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1662,8 +1662,13 @@ erc-open-server-buffer-p
(defun erc-query-buffer-p (&optional buffer)
"Return non-nil if BUFFER is an ERC query buffer.
-If BUFFER is nil, the current buffer is used."
- (not (erc-channel-p (or buffer (current-buffer)))))
+If BUFFER is nil, use the current buffer."
+ (and-let* ((target (if buffer
+ (progn (when (stringp buffer)
+ (setq buffer (get-buffer buffer)))
+ (buffer-local-value 'erc--target buffer))
+ erc--target)))
+ (not (erc--target-channel-p target))))
(defun erc-ison-p (nick)
"Return non-nil if NICK is online."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 22432a68034..52c6f8e75b6 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1227,6 +1227,35 @@ erc-channel-p
(erc-tests-common-kill-buffers))
+(ert-deftest erc-query-buffer-p ()
+ ;; Nil in a non-ERC buffer.
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name)))
+
+ (erc-tests-common-make-server-buf)
+ ;; Nil in a server buffer.
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name)))
+
+ ;; Nil in a channel buffer.
+ (with-current-buffer (erc--open-target "#chan")
+ (should-not (erc-query-buffer-p))
+ (should-not (erc-query-buffer-p (current-buffer)))
+ (should-not (erc-query-buffer-p (buffer-name))))
+
+ ;; Non-nil in a query buffer.
+ (with-current-buffer (erc--open-target "alice")
+ (should (erc-query-buffer-p))
+ (should (erc-query-buffer-p (current-buffer)))
+ (should (erc-query-buffer-p (buffer-name))))
+
+ (should (erc-query-buffer-p (get-buffer "alice")))
+ (should (erc-query-buffer-p "alice"))
+
+ (erc-tests-common-kill-buffers))
+
(ert-deftest erc--valid-local-channel-p ()
(ert-info ("Local channels not supported")
(let ((erc--isupport-params (make-hash-table)))
--
2.44.0
^ permalink raw reply related [flat|nested] 11+ messages in thread
* bug#67220: 30.0.50; ERC 5.6: Prefer parameter-driven MODE processing in ERC
[not found] ` <877ch09acj.fsf@neverwas.me>
@ 2024-04-23 22:35 ` J.P.
0 siblings, 0 replies; 11+ messages in thread
From: J.P. @ 2024-04-23 22:35 UTC (permalink / raw)
To: 67220; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> "J.P." <jp@neverwas.me> writes:
>
>>> I think it's worth correcting this in ERC 5.6. Proposed changes
>>> attached. (The first patch is unrelated.)
>>
>> These changes now live on master as
>>
>> 3d87e343276 * Use modern fallback for channel name detection in ERC
>> 25d15391f26 * Normalize ISUPPORT params with empty values in ERC
>>
>> If anyone experiences new difficulties related to detecting channel
>> names, these are likely to blame.
>
> A regression involving `erc-query-buffer-p' has surfaced that basically
> makes the function unsuable in many situations. The root cause is some
> combination of stupdiity and laziness on my part, as usual. The attached
> patch should fix the issue. Thanks to Libera user mekeor for reporting
> this.
This has been installed as
473189ab690 Fix regression involving erc-query-buffer-p
This bug is already closed.
^ permalink raw reply [flat|nested] 11+ messages in thread
end of thread, other threads:[~2024-04-23 22:35 UTC | newest]
Thread overview: 11+ 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.
2024-01-19 1:21 ` J.P.
[not found] ` <87mst2unhi.fsf@neverwas.me>
2024-01-25 21:45 ` J.P.
2024-02-14 1:45 ` J.P.
[not found] ` <871q9fhl8j.fsf@neverwas.me>
2024-02-21 1:14 ` J.P.
[not found] ` <87o7cabou8.fsf@neverwas.me>
2024-04-13 22:17 ` J.P.
[not found] ` <877ch09acj.fsf@neverwas.me>
2024-04-23 22:35 ` 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).