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