aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorF. Jason Park2024-01-17 21:42:02 -0800
committerF. Jason Park2024-01-24 20:58:32 -0800
commitaedc8b55bfc4d2864d777ac17f6bcf70e4ee04ce (patch)
tree7291f1d8a0a61cd10155932281a00be7b85e2da7
parentd85f561da03cd4705341a5a73f5c643f778e0f35 (diff)
downloademacs-aedc8b55bfc4d2864d777ac17f6bcf70e4ee04ce.tar.gz
emacs-aedc8b55bfc4d2864d777ac17f6bcf70e4ee04ce.zip
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 prefix slots in overridden well-known constructor. (erc--parsed-prefix): Reverse order of characters in the `letters' and `statuses' slots, in their defaults and also their definitions. (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 fallback 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 semantically. (erc--get-prefix-flag, erc--init-cusr-fallback-status, erc--compute-cusr-fallback-status): New functions for retrieving internal prefix values and massaging hard-coded traditional prefixes so they're compatible with existing `erc-channel-member' update code. (erc--partition-prefixed-names): New function, separated for testing and for conversion to a generic in the future when ERC supports extensions that list member rolls in a different format. (erc-channel-receive-names): Refactor to use new status-aware update and init workhorse functions for updating and initializing a `erc-channel-members' entry. (erc--create-current-channel-member): New "status-aware" function comprising the `addp' path of `erc-update-current-channel-member'. (erc--update-current-channel-member): New "status-aware" function comprising the "update" path of `erc-update-current-channel-member', which ran when an existing `erc-channel-members' entry for the queried nick was found. (erc-update-current-channel-member): Split code body into two constituent functions, both for readability and for usability, 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 function to ensure code like `erc--partition-prefixed-names' can use `erc--parse-nuh' in a practical and relatively convenient way in the near future. * test/lisp/erc/erc-scenarios-base-chan-modes.el (erc-scenarios-base-chan-modes--speaker-status): New test. * 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 newly available utilities imported from common library. * test/lisp/erc/resources/base/modes/speaker-status.eld: New file. (Bug#67220)
-rw-r--r--lisp/erc/erc-backend.el4
-rw-r--r--lisp/erc/erc-common.el24
-rw-r--r--lisp/erc/erc.el362
-rw-r--r--test/lisp/erc/erc-scenarios-base-chan-modes.el58
-rw-r--r--test/lisp/erc/erc-tests.el122
-rw-r--r--test/lisp/erc/resources/base/modes/speaker-status.eld69
6 files changed, 471 insertions, 168 deletions
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 95207e56fd1..e379066b08e 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -2201,7 +2201,9 @@ primitive value."
2201;; While it's better to depend on interfaces than specific types, 2201;; While it's better to depend on interfaces than specific types,
2202;; using `cl-struct-slot-value' or similar to extract a known slot at 2202;; using `cl-struct-slot-value' or similar to extract a known slot at
2203;; runtime would incur a small "ducktyping" tax, which should probably 2203;; runtime would incur a small "ducktyping" tax, which should probably
2204;; be avoided when running dozens of times per incoming message. 2204;; be avoided when running hundreds of times per incoming message.
2205;; Instead of separate keys per data type, we could increment a
2206;; counter whenever a new 005 arrives.
2205(defmacro erc--with-isupport-data (param var &rest body) 2207(defmacro erc--with-isupport-data (param var &rest body)
2206 "Return structured data stored in VAR for \"ISUPPORT\" PARAM. 2208 "Return structured data stored in VAR for \"ISUPPORT\" PARAM.
2207Expect VAR's value to be an instance of `erc--isupport-data'. If 2209Expect 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..e39e414b290 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -37,6 +37,7 @@
37(defvar erc-session-server) 37(defvar erc-session-server)
38 38
39(declare-function erc--get-isupport-entry "erc-backend" (key &optional single)) 39(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
40(declare-function erc--init-cusr-fallback-status "erc" (v h o a q))
40(declare-function erc-get-buffer "erc" (target &optional proc)) 41(declare-function erc-get-buffer "erc" (target &optional proc))
41(declare-function erc-server-buffer "erc" nil) 42(declare-function erc-server-buffer "erc" nil)
42(declare-function widget-apply-action "wid-edit" (widget &optional event)) 43(declare-function widget-apply-action "wid-edit" (widget &optional event))
@@ -76,11 +77,11 @@
76 make-erc-channel-user 77 make-erc-channel-user
77 ( &key voice halfop op admin owner 78 ( &key voice halfop op admin owner
78 last-message-time 79 last-message-time
79 &aux (status (+ (if voice 1 0) 80 &aux (status
80 (if halfop 2 0) 81 (if (or voice halfop op admin owner)
81 (if op 4 0) 82 (erc--init-cusr-fallback-status
82 (if admin 8 0) 83 voice halfop op admin owner)
83 (if owner 16 0))))) 84 0))))
84 :named) 85 :named)
85 "Object containing channel-specific data for a single user." 86 "Object containing channel-specific data for a single user."
86 ;; voice halfop op admin owner 87 ;; voice halfop op admin owner
@@ -140,9 +141,12 @@ For use with the macro `erc--with-isupport-data'."
140(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data)) 141(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data))
141 "Server-local data for recognized membership-status prefixes. 142 "Server-local data for recognized membership-status prefixes.
142Derived from the advertised \"PREFIX\" ISUPPORT parameter." 143Derived from the advertised \"PREFIX\" ISUPPORT parameter."
143 (letters "qaohv" :type string) 144 ( letters "vhoaq" :type string
144 (statuses "~&@%+" :type string) 145 :documentation "Status letters ranked lowest to highest.")
145 (alist nil :type (list-of cons))) 146 ( statuses "+%@&~" :type string
147 :documentation "Status prefixes ranked lowest to highest.")
148 ( alist nil :type (list-of cons)
149 :documentation "Alist of letters-prefix pairs."))
146 150
147(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data)) 151(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
148 "Server-local \"CHANMODES\" data." 152 "Server-local \"CHANMODES\" data."
@@ -594,6 +598,10 @@ the resulting variables will end up with more useful doc strings."
594 (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form)))) 598 (debug (symbolp [&rest [keywordp form]] &rest (symbolp . form))))
595 `(erc--define-catalog ,language ,entries)) 599 `(erc--define-catalog ,language ,entries))
596 600
601(define-inline erc--strpos (char string)
602 "Return position of CHAR in STRING or nil if not found."
603 (inline-quote (string-search (string ,char) ,string)))
604
597(defmacro erc--doarray (spec &rest body) 605(defmacro erc--doarray (spec &rest body)
598 "Map over ARRAY, running BODY with VAR bound to iteration element. 606 "Map over ARRAY, running BODY with VAR bound to iteration element.
599Behave more or less like `seq-doseq', but tailor operations for 607Behave more or less like `seq-doseq', but tailor operations for
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index e9d6099317f..fc6f51950e2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -598,28 +598,52 @@ Removes all users in the current channel. This is called by
598 erc-channel-users) 598 erc-channel-users)
599 (clrhash erc-channel-users))) 599 (clrhash erc-channel-users)))
600 600
601(defmacro erc--define-channel-user-status-compat-getter (name n) 601(defmacro erc--define-channel-user-status-compat-getter (name c d)
602 "Define a gv getter for historical `erc-channel-user' status slot NAME. 602 "Define a gv getter for historical `erc-channel-user' status slot NAME.
603Expect NAME to be a string and N to be its associated power-of-2 603Expect NAME to be a string, C to be its traditionally associated
604\"enumerated flag\" integer." 604letter, and D to be its fallback power-of-2 integer for non-ERC
605buffers."
605 `(defun ,(intern (concat "erc-channel-user-" name)) (u) 606 `(defun ,(intern (concat "erc-channel-user-" name)) (u)
606 ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'." 607 ,(format "Get equivalent of pre-5.6 `%s' slot for `erc-channel-user'."
607 name) 608 name)
608 (declare (gv-setter (lambda (v) 609 (declare (gv-setter (lambda (v)
609 (macroexp-let2 nil v v 610 (macroexp-let2 nil v v
610 (,'\`(let ((val (erc-channel-user-status ,',u))) 611 (,'\`(let ((val (erc-channel-user-status ,',u))
612 (n (or (erc--get-prefix-flag ,c) ,d)))
611 (setf (erc-channel-user-status ,',u) 613 (setf (erc-channel-user-status ,',u)
612 (if ,',v 614 (if ,',v
613 (logior val ,n) 615 (logior val n)
614 (logand val ,(lognot n)))) 616 (logand val (lognot n))))
615 ,',v)))))) 617 ,',v))))))
616 (= ,n (logand ,n (erc-channel-user-status u))))) 618 (let ((n (or (erc--get-prefix-flag ,c) ,d)))
617 619 (= n (logand n (erc-channel-user-status u))))))
618(erc--define-channel-user-status-compat-getter "voice" 1) 620
619(erc--define-channel-user-status-compat-getter "halfop" 2) 621(erc--define-channel-user-status-compat-getter "voice" ?v 1)
620(erc--define-channel-user-status-compat-getter "op" 4) 622(erc--define-channel-user-status-compat-getter "halfop" ?h 2)
621(erc--define-channel-user-status-compat-getter "admin" 8) 623(erc--define-channel-user-status-compat-getter "op" ?o 4)
622(erc--define-channel-user-status-compat-getter "owner" 16) 624(erc--define-channel-user-status-compat-getter "admin" ?a 8)
625(erc--define-channel-user-status-compat-getter "owner" ?q 16)
626
627;; This is a generalized version of the compat-oriented getters above.
628(defun erc--cusr-status-p (nick-or-cusr letter)
629 "Return non-nil if NICK-OR-CUSR has channel membership status LETTER."
630 (and-let* ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
631 (cdr (erc-get-channel-member nick-or-cusr))))
632 (n (erc--get-prefix-flag letter)))
633 (= n (logand n (erc-channel-user-status cusr)))))
634
635(defun erc--cusr-change-status (nick-or-cusr letter enablep &optional resetp)
636 "Add or remove membership status associated with LETTER for NICK-OR-CUSR.
637With RESETP, clear the user's status info completely. If ENABLEP
638is non-nil, add the status value associated with LETTER."
639 (when-let ((cusr (or (and (erc-channel-user-p nick-or-cusr) nick-or-cusr)
640 (cdr (erc-get-channel-member nick-or-cusr))))
641 (n (erc--get-prefix-flag letter)))
642 (cl-callf (lambda (v)
643 (if resetp
644 (if enablep n 0)
645 (if enablep (logior v n) (logand v (lognot n)))))
646 (erc-channel-user-status cusr))))
623 647
624(defun erc-channel-user-owner-p (nick) 648(defun erc-channel-user-owner-p (nick)
625 "Return non-nil if NICK is an owner of the current channel." 649 "Return non-nil if NICK is an owner of the current channel."
@@ -3900,6 +3924,10 @@ for other purposes.")
3900 3924
3901(defun erc-send-input-line (target line &optional force) 3925(defun erc-send-input-line (target line &optional force)
3902 "Send LINE to TARGET." 3926 "Send LINE to TARGET."
3927 (when-let ((target)
3928 (cmem (erc-get-channel-member (erc-current-nick))))
3929 (setf (erc-channel-user-last-message-time (cdr cmem))
3930 (erc-compat--current-lisp-time)))
3903 (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) 3931 (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n"))
3904 (setq line " \n")) 3932 (setq line " \n"))
3905 (erc-message "PRIVMSG" (concat target " " line) force)) 3933 (erc-message "PRIVMSG" (concat target " " line) force))
@@ -6141,17 +6169,15 @@ return a possibly empty string."
6141 (catch 'done 6169 (catch 'done
6142 (pcase-dolist (`(,letter . ,pfx) 6170 (pcase-dolist (`(,letter . ,pfx)
6143 (erc--parsed-prefix-alist pfx-obj)) 6171 (erc--parsed-prefix-alist pfx-obj))
6144 (pcase letter 6172 (when (erc--cusr-status-p nick-or-cusr letter)
6145 ((and ?q (guard (erc-channel-user-owner nick-or-cusr))) 6173 (throw 'done
6146 (throw 'done (propertize (string pfx) 'help-echo "owner"))) 6174 (pcase letter
6147 ((and ?a (guard (erc-channel-user-admin nick-or-cusr))) 6175 (?q (propertize (string pfx) 'help-echo "owner"))
6148 (throw 'done (propertize (string pfx) 'help-echo "admin"))) 6176 (?a (propertize (string pfx) 'help-echo "admin"))
6149 ((and ?o (guard (erc-channel-user-op nick-or-cusr))) 6177 (?o (propertize (string pfx) 'help-echo "operator"))
6150 (throw 'done (propertize (string pfx) 'help-echo "operator"))) 6178 (?h (propertize (string pfx) 'help-echo "half-op"))
6151 ((and ?h (guard (erc-channel-user-halfop nick-or-cusr))) 6179 (?v (propertize (string pfx) 'help-echo "voice"))
6152 (throw 'done (propertize (string pfx) 'help-echo "half-op"))) 6180 (_ (string pfx))))))
6153 ((and ?v (guard (erc-channel-user-voice nick-or-cusr)))
6154 (throw 'done (propertize (string pfx) 'help-echo "voice")))))
6155 ""))) 6181 "")))
6156 (t 6182 (t
6157 (cond ((erc-channel-user-owner nick-or-cusr) 6183 (cond ((erc-channel-user-owner nick-or-cusr)
@@ -6763,12 +6789,52 @@ parameter advertised by the current server, with the original
6763ordering intact. If no such parameter has yet arrived, return a 6789ordering intact. If no such parameter has yet arrived, return a
6764stand-in from the fallback value \"(qaohv)~&@%+\"." 6790stand-in from the fallback value \"(qaohv)~&@%+\"."
6765 (erc--with-isupport-data PREFIX erc--parsed-prefix 6791 (erc--with-isupport-data PREFIX erc--parsed-prefix
6766 (let ((alist (nreverse (erc-parse-prefix)))) 6792 (let ((alist (erc-parse-prefix)))
6767 (make-erc--parsed-prefix 6793 (make-erc--parsed-prefix
6768 :key key 6794 :key key
6769 :letters (apply #'string (map-keys alist)) 6795 :letters (apply #'string (map-keys alist))
6770 :statuses (apply #'string (map-values alist)) 6796 :statuses (apply #'string (map-values alist))
6771 :alist alist)))) 6797 :alist (nreverse alist)))))
6798
6799(defun erc--get-prefix-flag (char &optional parsed-prefix from-prefix-p)
6800 "Return numeric rank for CHAR or nil if unknown.
6801For example, given letters \"qaohv\" return 1 for ?v, 2 for ?h,
6802and 4 for ?o, etc. If given, expect PARSED-PREFIX to be a
6803`erc--parse-prefix' object. With FROM-PREFIX-P, expect CHAR to
6804be a prefix instead."
6805 (and-let* ((obj (or parsed-prefix (erc--parsed-prefix)))
6806 (pos (erc--strpos char (if from-prefix-p
6807 (erc--parsed-prefix-statuses obj)
6808 (erc--parsed-prefix-letters obj)))))
6809 (ash 1 pos)))
6810
6811(defun erc--init-cusr-fallback-status (voice halfop op admin owner)
6812 "Return channel-membership based on traditional status semantics.
6813Massage boolean switches VOICE, HALFOP, OP, ADMIN, and OWNER into
6814an internal numeric value suitable for the `status' slot of a new
6815`erc-channel-user' object."
6816 (let ((pfx (erc--parsed-prefix)))
6817 (+ (if voice (if pfx (or (erc--get-prefix-flag ?v pfx) 0) 1) 0)
6818 (if halfop (if pfx (or (erc--get-prefix-flag ?h pfx) 0) 2) 0)
6819 (if op (if pfx (or (erc--get-prefix-flag ?o pfx) 0) 4) 0)
6820 (if admin (if pfx (or (erc--get-prefix-flag ?a pfx) 0) 8) 0)
6821 (if owner (if pfx (or (erc--get-prefix-flag ?q pfx) 0) 16) 0))))
6822
6823(defun erc--compute-cusr-fallback-status (current v h o a q)
6824 "Return current channel membership after toggling V H O A Q as requested.
6825Assume `erc--parsed-prefix' is non-nil in the current buffer.
6826Expect status switches V, H, O, A, Q, when non-nil, to be the
6827symbol `on' or `off'. Return an internal numeric value suitable
6828for the `status' slot of an `erc-channel-user' object."
6829 (let (on off)
6830 (when v (push (or (erc--get-prefix-flag ?v) 0) (if (eq v 'on) on off)))
6831 (when h (push (or (erc--get-prefix-flag ?h) 0) (if (eq h 'on) on off)))
6832 (when o (push (or (erc--get-prefix-flag ?o) 0) (if (eq o 'on) on off)))
6833 (when a (push (or (erc--get-prefix-flag ?a) 0) (if (eq a 'on) on off)))
6834 (when q (push (or (erc--get-prefix-flag ?q) 0) (if (eq q 'on) on off)))
6835 (when on (setq current (apply #'logior current on)))
6836 (when off (setq current (apply #'logand current (mapcar #'lognot off)))))
6837 current)
6772 6838
6773(defcustom erc-channel-members-changed-hook nil 6839(defcustom erc-channel-members-changed-hook nil
6774 "This hook is called every time the variable `channel-members' changes. 6840 "This hook is called every time the variable `channel-members' changes.
@@ -6776,48 +6842,40 @@ The buffer where the change happened is current while this hook is called."
6776 :group 'erc-hooks 6842 :group 'erc-hooks
6777 :type 'hook) 6843 :type 'hook)
6778 6844
6779(defun erc-channel-receive-names (names-string) 6845(defun erc--partition-prefixed-names (name)
6780 "This function is for internal use only. 6846 "From NAME, return a list of (STATUS NICK LOGIN HOST).
6847Expect NAME to be a prefixed name, like @bob."
6848 (unless (string-empty-p name)
6849 (let* ((status (erc--get-prefix-flag (aref name 0) nil 'from-prefix-p))
6850 (nick (if status (substring name 1) name)))
6851 (unless (string-empty-p nick)
6852 (list status nick nil nil)))))
6781 6853
6782Update `erc-channel-users' according to NAMES-STRING. 6854(defun erc-channel-receive-names (names-string)
6783NAMES-STRING is a string listing some of the names on the 6855 "Update `erc-channel-members' from NAMES-STRING.
6784channel." 6856Expect NAMES-STRING to resemble the trailing argument of a 353
6785 (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix))) 6857RPL_NAMREPLY. Call internal handlers for parsing individual
6786 (voice-ch (cdr (assq ?v prefix))) 6858names, whose expected composition may differ depending on enabled
6787 (op-ch (cdr (assq ?o prefix))) 6859extensions."
6788 (hop-ch (cdr (assq ?h prefix))) 6860 (let ((names (delete "" (split-string names-string)))
6789 (adm-ch (cdr (assq ?a prefix))) 6861 (erc-channel-members-changed-hook nil))
6790 (own-ch (cdr (assq ?q prefix))) 6862 (dolist (name names)
6791 (names (delete "" (split-string names-string))) 6863 (when-let ((args (erc--partition-prefixed-names name)))
6792 name op voice halfop admin owner) 6864 (pcase-let* ((`(,status ,nick ,login ,host) args)
6793 (let ((erc-channel-members-changed-hook nil)) 6865 (cmem (erc-get-channel-user nick)))
6794 (dolist (item names) 6866 (progn
6795 (let ((updatep t)
6796 (ch (aref item 0)))
6797 (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off)
6798 (if (rassq ch prefix)
6799 (if (= (length item) 1)
6800 (setq updatep nil)
6801 (setq name (substring item 1))
6802 (setf (pcase ch
6803 ((pred (eq voice-ch)) voice)
6804 ((pred (eq hop-ch)) halfop)
6805 ((pred (eq op-ch)) op)
6806 ((pred (eq adm-ch)) admin)
6807 ((pred (eq own-ch)) owner)
6808 (_ (message "Unknown prefix char `%S'" ch) voice))
6809 'on)))
6810 (when updatep
6811 ;; If we didn't issue the NAMES request (consider two clients 6867 ;; If we didn't issue the NAMES request (consider two clients
6812 ;; talking to an IRC proxy), `erc-channel-begin-receiving-names' 6868 ;; talking to an IRC proxy), `erc-channel-begin-receiving-names'
6813 ;; will not have been called, so we have to do it here. 6869 ;; will not have been called, so we have to do it here.
6814 (unless erc-channel-new-member-names 6870 (unless erc-channel-new-member-names
6815 (erc-channel-begin-receiving-names)) 6871 (erc-channel-begin-receiving-names))
6816 (puthash (erc-downcase name) t 6872 (puthash (erc-downcase nick) t erc-channel-new-member-names)
6817 erc-channel-new-member-names) 6873 (if cmem
6818 (erc-update-current-channel-member 6874 (erc--update-current-channel-member cmem status nil
6819 name name t voice halfop op admin owner))))) 6875 nick host login)
6820 (run-hooks 'erc-channel-members-changed-hook))) 6876 (erc--create-current-channel-member nick status nil
6877 nick host login)))))))
6878 (run-hooks 'erc-channel-members-changed-hook))
6821 6879
6822(defun erc-update-user-nick (nick &optional new-nick 6880(defun erc-update-user-nick (nick &optional new-nick
6823 host login full-name info) 6881 host login full-name info)
@@ -6869,17 +6927,85 @@ which USER is a member, and t is returned."
6869 (run-hooks 'erc-channel-members-changed-hook)))))) 6927 (run-hooks 'erc-channel-members-changed-hook))))))
6870 changed)) 6928 changed))
6871 6929
6930(defun erc--create-current-channel-member
6931 (nick status timep &optional new-nick host login full-name info)
6932 "Add an `erc-channel-member' entry for NICK.
6933Create a new `erc-server-users' entry if necessary, and ensure
6934`erc-channel-members-changed-hook' runs exactly once, regardless.
6935Pass STATUS to the `erc-channel-user' constructor. With TIMEP,
6936assume NICK has just spoken, and initialize `last-message-time'.
6937Pass NEW-NICK, HOST, LOGIN, FULL-NAME, and INFO to
6938`erc-update-user' if a server user exists and otherwise to the
6939`erc-server-user' constructor."
6940 (cl-assert (null (erc-get-channel-member nick)))
6941 (let* ((user-changed-p nil)
6942 (down (erc-downcase nick))
6943 (user (gethash down (erc-with-server-buffer erc-server-users))))
6944 (if user
6945 (progn
6946 (cl-pushnew (current-buffer) (erc-server-user-buffers user))
6947 ;; Update *after* ^ so hook has chance to run.
6948 (setf user-changed-p (erc-update-user user new-nick host login
6949 full-name info)))
6950 (erc-add-server-user nick
6951 (setq user (make-erc-server-user
6952 :nickname (or new-nick nick)
6953 :host host
6954 :full-name full-name
6955 :login login
6956 :info nil
6957 :buffers (list (current-buffer))))))
6958 (let ((cusr (erc-channel-user--make
6959 :status (or status 0)
6960 :last-message-time (and timep
6961 (erc-compat--current-lisp-time)))))
6962 (puthash down (cons user cusr) erc-channel-users))
6963 ;; An existing `cusr' was changed or a new one was added, and
6964 ;; `user' was not updated, though possibly just created (since
6965 ;; `erc-update-user' runs this same hook in all a user's buffers).
6966 (unless user-changed-p
6967 (run-hooks 'erc-channel-members-changed-hook))
6968 t))
6969
6970(defun erc--update-current-channel-member (cmem status timep &rest user-args)
6971 "Update existing `erc-channel-member' entry.
6972Set the `status' slot of the entry's `erc-channel-user' side to
6973STATUS and, with TIMEP, update its `last-message-time'. When
6974actual changes are made, run `erc-channel-members-changed-hook',
6975and return non-nil."
6976 (cl-assert cmem)
6977 (let ((cusr (cdr cmem))
6978 (user (car cmem))
6979 cusr-changed-p user-changed-p)
6980 (when (and status (/= status (erc-channel-user-status cusr)))
6981 (setf (erc-channel-user-status cusr) status
6982 cusr-changed-p t))
6983 (when timep
6984 (setf (erc-channel-user-last-message-time cusr)
6985 (erc-compat--current-lisp-time)))
6986 ;; Ensure `erc-channel-members-changed-hook' runs on change.
6987 (cl-assert (memq (current-buffer) (erc-server-user-buffers user)))
6988 (setq user-changed-p (apply #'erc-update-user user user-args))
6989 ;; An existing `cusr' was changed or a new one was added, and
6990 ;; `user' was not updated, though possibly just created (since
6991 ;; `erc-update-user' runs this same hook in all a user's buffers).
6992 (when (and cusr-changed-p (null user-changed-p))
6993 (run-hooks 'erc-channel-members-changed-hook))
6994 (erc-log (format "update-member: user = %S, cusr = %S" user cusr))
6995 (or cusr-changed-p user-changed-p)))
6996
6872(defun erc-update-current-channel-member 6997(defun erc-update-current-channel-member
6873 (nick new-nick &optional addp voice halfop op admin owner host login full-name info 6998 (nick new-nick &optional addp voice halfop op admin owner host login
6874 update-message-time) 6999 full-name info update-message-time)
6875 "Update or create entry for NICK in current `erc-channel-members' table. 7000 "Update or create entry for NICK in current `erc-channel-members' table.
6876With ADDP, ensure an entry exists. If one already does, call 7001With ADDP, ensure an entry exists. When an entry does exist or
6877`erc-update-user' to handle updates to HOST, LOGIN, FULL-NAME, 7002when ADDP is non-nil and an `erc-server-users' entry already
6878INFO, and NEW-NICK. Expect any non-nil membership status 7003exists, call `erc-update-user' with NEW-NICK, HOST, LOGIN,
6879switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be the 7004FULL-NAME, and INFO. Expect any non-nil membership
6880symbol `on' or `off' when needing to influence a new or existing 7005status switches among VOICE, HALFOP, OP, ADMIN, and OWNER to be
6881`erc-channel-user' object's `status' slot. Likewise, when 7006the symbol `on' or `off' when needing to influence a new or
6882UPDATE-MESSAGE-TIME is non-nil, update or initialize the 7007existing `erc-channel-user' object's `status' slot. Likewise,
7008when UPDATE-MESSAGE-TIME is non-nil, update or initialize the
6883`last-message-time' slot to the current-time. If changes occur, 7009`last-message-time' slot to the current-time. If changes occur,
6884including creation, run `erc-channel-members-changed-hook'. 7010including creation, run `erc-channel-members-changed-hook'.
6885Return non-nil when meaningful changes, including creation, have 7011Return non-nil when meaningful changes, including creation, have
@@ -6889,62 +7015,26 @@ Without ADDP, do nothing unless a `erc-channel-members' entry
6889exists. When it doesn't, assume the sender is a non-joined 7015exists. When it doesn't, assume the sender is a non-joined
6890entity, like the server itself or a historical speaker, or assume 7016entity, like the server itself or a historical speaker, or assume
6891the prior buffer for the channel was killed without parting." 7017the prior buffer for the channel was killed without parting."
6892 (let* (cusr-changed-p 7018(let* ((cmem (erc-get-channel-member nick))
6893 user-changed-p 7019 (status (and (or voice halfop op admin owner)
6894 (cmem (erc-get-channel-member nick)) 7020 (if cmem
6895 (cusr (cdr cmem)) 7021 (erc--compute-cusr-fallback-status
6896 (down (erc-downcase nick)) 7022 (erc-channel-user-status (cdr cmem))
6897 (user (or (car cmem) 7023 voice halfop op admin owner)
6898 (gethash down (erc-with-server-buffer erc-server-users))))) 7024 (erc--init-cusr-fallback-status
6899 (if cusr 7025 (and voice (eq voice 'on))
6900 (progn 7026 (and halfop (eq halfop 'on))
6901 (erc-log (format "update-member: user = %S, cusr = %S" user cusr)) 7027 (and op (eq op 'on))
6902 (when-let (((or voice halfop op admin owner)) 7028 (and admin (eq admin 'on))
6903 (existing (erc-channel-user-status cusr))) 7029 (and owner (eq owner 'on)))))))
6904 (when voice (setf (erc-channel-user-voice cusr) (eq voice 'on))) 7030 (if cmem
6905 (when halfop (setf (erc-channel-user-halfop cusr) (eq halfop 'on))) 7031 (erc--update-current-channel-member cmem status update-message-time
6906 (when op (setf (erc-channel-user-op cusr) (eq op 'on))) 7032 new-nick host login
6907 (when admin (setf (erc-channel-user-admin cusr) (eq admin 'on))) 7033 full-name info)
6908 (when owner (setf (erc-channel-user-owner cusr) (eq owner 'on))) 7034 (when addp
6909 (setq cusr-changed-p (= existing (erc-channel-user-status cusr)))) 7035 (erc--create-current-channel-member nick status update-message-time
6910 (when update-message-time 7036 new-nick host login
6911 (setf (erc-channel-user-last-message-time cusr) (current-time))) 7037 full-name info)))))
6912 ;; Assume `user' exists and its `buffers' slot contains the
6913 ;; current buffer so that `erc-channel-members-changed-hook'
6914 ;; will run if changes are made.
6915 (setq user-changed-p
6916 (erc-update-user user new-nick
6917 host login full-name info)))
6918 (when addp
6919 (if (null user)
6920 (progn
6921 (setq user (make-erc-server-user
6922 :nickname nick
6923 :host host
6924 :full-name full-name
6925 :login login
6926 :info info
6927 :buffers (list (current-buffer))))
6928 (erc-add-server-user nick user))
6929 (setf (erc-server-user-buffers user)
6930 (cons (current-buffer)
6931 (erc-server-user-buffers user))))
6932 (setq cusr (make-erc-channel-user
6933 :voice (and voice (eq voice 'on))
6934 :halfop (and halfop (eq halfop 'on))
6935 :op (and op (eq op 'on))
6936 :admin (and admin (eq admin 'on))
6937 :owner (and owner (eq owner 'on))
6938 :last-message-time (if update-message-time
6939 (current-time))))
6940 (puthash down (cons user cusr) erc-channel-users)
6941 (setq cusr-changed-p t)))
6942 ;; An existing `cusr' was changed or a new one was added, and
6943 ;; `user' was not updated, though possibly just created (since
6944 ;; `erc-update-user' runs this same hook in all a user's buffers).
6945 (when (and cusr-changed-p (null user-changed-p))
6946 (run-hooks 'erc-channel-members-changed-hook))
6947 (or cusr-changed-p user-changed-p)))
6948 7038
6949(defun erc-update-channel-member (channel nick new-nick 7039(defun erc-update-channel-member (channel nick new-nick
6950 &optional add voice halfop op admin owner host login 7040 &optional add voice halfop op admin owner host login
@@ -7134,16 +7224,6 @@ person who changed the modes."
7134 ;; nick modes - ignored at this point 7224 ;; nick modes - ignored at this point
7135 (t nil)))) 7225 (t nil))))
7136 7226
7137(defun erc--update-membership-prefix (nick letter state)
7138 "Update status prefixes for NICK in current channel buffer.
7139Expect LETTER to be a status char and STATE to be a boolean."
7140 (erc-update-current-channel-member nick nil nil
7141 (and (= letter ?v) state)
7142 (and (= letter ?h) state)
7143 (and (= letter ?o) state)
7144 (and (= letter ?a) state)
7145 (and (= letter ?q) state)))
7146
7147(defvar-local erc--channel-modes nil 7227(defvar-local erc--channel-modes nil
7148 "When non-nil, a hash table of current channel modes. 7228 "When non-nil, a hash table of current channel modes.
7149Keys are characters. Values are either a string, for types A-C, 7229Keys are characters. Values are either a string, for types A-C,
@@ -7189,7 +7269,7 @@ complement relevant letters in STRING."
7189 (cond ((= ?+ c) (setq +p t)) 7269 (cond ((= ?+ c) (setq +p t))
7190 ((= ?- c) (setq +p nil)) 7270 ((= ?- c) (setq +p nil))
7191 ((and status-letters (string-search (string c) status-letters)) 7271 ((and status-letters (string-search (string c) status-letters))
7192 (erc--update-membership-prefix (pop args) c (if +p 'on 'off))) 7272 (erc--cusr-change-status (pop args) c +p))
7193 ((and-let* ((group (or (aref table c) (and fallbackp ?d)))) 7273 ((and-let* ((group (or (aref table c) (and fallbackp ?d))))
7194 (erc--handle-channel-mode group c +p 7274 (erc--handle-channel-mode group c +p
7195 (and (/= group ?d) 7275 (and (/= group ?d)
@@ -7511,6 +7591,12 @@ See associated unit test for precise behavior."
7511 (match-string 2 string) 7591 (match-string 2 string)
7512 (match-string 3 string)))) 7592 (match-string 3 string))))
7513 7593
7594(defun erc--shuffle-nuh-nickward (nick login host)
7595 "Interpret results of `erc--parse-nuh', promoting loners to nicks."
7596 (cond (nick (cl-assert (null login)) (list nick login host))
7597 ((and (null login) host) (list host nil nil))
7598 ((and login (null host)) (list login nil nil))))
7599
7514(defun erc-extract-nick (string) 7600(defun erc-extract-nick (string)
7515 "Return the nick corresponding to a user specification STRING. 7601 "Return the nick corresponding to a user specification STRING.
7516 7602
diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el b/test/lisp/erc/erc-scenarios-base-chan-modes.el
index 73fba65acf4..3183cd27370 100644
--- a/test/lisp/erc/erc-scenarios-base-chan-modes.el
+++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el
@@ -81,4 +81,62 @@
81 (should-not erc-channel-user-limit) 81 (should-not erc-channel-user-limit)
82 (funcall expect 10 "<Chad> after")))) 82 (funcall expect 10 "<Chad> after"))))
83 83
84;; This asserts proper recognition of nonstandard prefixes advertised
85;; via the "PREFIX=" ISUPPORT parameter. Note that without the IRCv3
86;; `multi-prefix' extension, we can't easily sync a user's channel
87;; membership status on receipt of a 352/353 by parsing the "flags"
88;; parameter because even though servers remember multiple prefixes,
89;; they only ever return the one with the highest rank. For example,
90;; if on receipt of a 352, we were to "update" someone we believe to
91;; be @+ by changing them to a to @, we'd be guilty of willful
92;; munging. And if they later lose that @, we'd then see them as null
93;; when in fact they're still +. However, we *could* use a single
94;; degenerate prefix to "validate" an existing record to ensure
95;; correctness of our processing logic, but it's unclear how such a
96;; discrepancy ought to be handled beyond asking the user to file a
97;; bug.
98(ert-deftest erc-scenarios-base-chan-modes--speaker-status ()
99 :tags '(:expensive-test)
100 (erc-scenarios-common-with-cleanup
101 ((erc-scenarios-common-dialog "base/modes")
102 (erc-server-flood-penalty 0.1)
103 (dumb-server (erc-d-run "localhost" t 'speaker-status))
104 (erc-show-speaker-membership-status t)
105 (erc-autojoin-channels-alist '(("." "#chan")))
106 (expect (erc-d-t-make-expecter)))
107
108 (ert-info ("Connect to foonet")
109 (with-current-buffer (erc :server "127.0.0.1"
110 :port (process-contact dumb-server :service)
111 :nick "tester"
112 :user "tester")
113 (funcall expect 5 "Here on foonet, we provide services")))
114
115 (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
116
117 (ert-info ("Prefixes printed correctly in 353")
118 (funcall expect 10 "chan: +alice @fsbot -bob !foop"))
119
120 (ert-info ("Speakers honor option `erc-show-speaker-membership-status'")
121 (funcall expect 10 "<-bob> alice: Of that which hath")
122 (funcall expect 10 "<+alice> Hie you, make haste")
123 (funcall expect 10 "<!foop> hi"))
124
125 (ert-info ("Status conferred and rescinded")
126 (funcall expect 10 "*** foop (user@netadmin.example.net) has changed ")
127 (funcall expect 10 "mode for #chan to +v bob")
128 (funcall expect 10 "<+bob> alice: Fair as a text B")
129 (funcall expect 10 "<+alice> bob: Even as Apemantus")
130 (funcall expect 10 "mode for #chan to -v bob")
131 (funcall expect 10 "<-bob> alice: That's the way")
132 (funcall expect 10 "<+alice> Give it the beasts"))
133
134 ;; If it had instead overwritten it, our two states would be
135 ;; out of sync. (See comment above.)
136 (ert-info ("/WHO output confirms server shadowed V status")
137 (erc-scenarios-common-say "/who #chan")
138 (funcall expect 10 '(: "bob" (+ " ") "H-"))
139 (funcall expect 10 "<-bob> alice: Remains in danger")
140 (erc-cmd-QUIT "")))))
141
84;;; erc-scenarios-base-chan-modes.el ends here 142;;; 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 49c72836a22..b51bd67ae04 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -674,7 +674,7 @@
674 ;; checking if null beforehand. 674 ;; checking if null beforehand.
675 (should-not erc--parsed-prefix) 675 (should-not erc--parsed-prefix)
676 (should (equal (erc--parsed-prefix) 676 (should (equal (erc--parsed-prefix)
677 #s(erc--parsed-prefix nil "qaohv" "~&@%+" 677 #s(erc--parsed-prefix nil "vhoaq" "+%@&~"
678 ((?q . ?~) (?a . ?&) 678 ((?q . ?~) (?a . ?&)
679 (?o . ?@) (?h . ?%) (?v . ?+))))) 679 (?o . ?@) (?h . ?%) (?v . ?+)))))
680 (let ((cached (should erc--parsed-prefix))) 680 (let ((cached (should erc--parsed-prefix)))
@@ -696,7 +696,7 @@
696 (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix))) 696 (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
697 (setq cached erc--parsed-prefix) 697 (setq cached erc--parsed-prefix)
698 (should (equal cached 698 (should (equal cached
699 #s(erc--parsed-prefix ("(ov)@+") "ov" "@+" 699 #s(erc--parsed-prefix ("(ov)@+") "vo" "+@"
700 ((?o . ?@) (?v . ?+))))) 700 ((?o . ?@) (?v . ?+)))))
701 ;; Second target buffer reuses cached value. 701 ;; Second target buffer reuses cached value.
702 (with-temp-buffer 702 (with-temp-buffer
@@ -714,6 +714,88 @@
714 (erc-with-server-buffer erc--parsed-prefix)) 714 (erc-with-server-buffer erc--parsed-prefix))
715 '((?q . ?~) (?h . ?%))))))) 715 '((?q . ?~) (?h . ?%)))))))
716 716
717(ert-deftest erc--get-prefix-flag ()
718 (erc-tests-common-make-server-buf (buffer-name))
719 (should-not erc--parsed-prefix)
720 (should (= (erc--get-prefix-flag ?v) 1))
721 (should (= (erc--get-prefix-flag ?h) 2))
722 (should (= (erc--get-prefix-flag ?o) 4))
723 (should (= (erc--get-prefix-flag ?a) 8))
724 (should (= (erc--get-prefix-flag ?q) 16))
725
726 (ert-info ("With optional `from-prefix-p'")
727 (should (= (erc--get-prefix-flag ?+ nil 'fpp) 1))
728 (should (= (erc--get-prefix-flag ?% nil 'fpp) 2))
729 (should (= (erc--get-prefix-flag ?@ nil 'fpp) 4))
730 (should (= (erc--get-prefix-flag ?& nil 'fpp) 8))
731 (should (= (erc--get-prefix-flag ?~ nil 'fpp) 16)))
732 (should erc--parsed-prefix))
733
734(ert-deftest erc--init-cusr-fallback-status ()
735 ;; Fallback behavior active because no `erc--parsed-prefix'.
736 (should-not erc--parsed-prefix)
737 (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
738 (should (= 1 (erc--init-cusr-fallback-status t nil nil nil nil)))
739 (should (= 4 (erc--init-cusr-fallback-status nil nil t nil nil)))
740 (should-not erc--parsed-prefix) ; not created in non-ERC buffer.
741
742 ;; Uses advertised server parameter.
743 (erc-tests-common-make-server-buf (buffer-name))
744 (setq erc-server-parameters '(("PREFIX" . "(YqaohvV)!~&@%+-")))
745 (should (= 0 (erc--init-cusr-fallback-status nil nil nil nil nil)))
746 (should (= 2 (erc--init-cusr-fallback-status t nil nil nil nil)))
747 (should (= 8 (erc--init-cusr-fallback-status nil nil t nil nil)))
748 (should erc--parsed-prefix))
749
750(ert-deftest erc--compute-cusr-fallback-status ()
751 ;; Useless without an `erc--parsed-prefix'.
752 (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
753 (should (= 0 (erc--compute-cusr-fallback-status 0 'on 'on 'on 'on 'on)))
754
755 (erc-tests-common-make-server-buf (buffer-name))
756 (should (= 0 (erc--compute-cusr-fallback-status 0 nil nil nil nil nil)))
757 (should (= 1 (erc--compute-cusr-fallback-status 0 'on nil nil nil nil)))
758 (should (= 1 (erc--compute-cusr-fallback-status 0 'on 'off 'off 'off 'off)))
759 (should (= 1 (erc--compute-cusr-fallback-status 1 'on 'off 'off 'off 'off)))
760 (should (= 1 (erc--compute-cusr-fallback-status 1 nil nil nil nil nil)))
761 (should (= 1 (erc--compute-cusr-fallback-status 3 nil 'off nil nil nil)))
762 (should (= 1 (erc--compute-cusr-fallback-status 7 nil 'off 'off nil nil)))
763 (should (= 4 (erc--compute-cusr-fallback-status 1 'off nil 'on nil nil))))
764
765(ert-deftest erc--cusr-status-p ()
766 (erc-tests-common-make-server-buf (buffer-name))
767 (should-not erc--parsed-prefix)
768 (let ((cusr (make-erc-channel-user :voice t :op t)))
769 (should-not (erc--cusr-status-p cusr ?q))
770 (should-not (erc--cusr-status-p cusr ?a))
771 (should-not (erc--cusr-status-p cusr ?h))
772 (should (erc--cusr-status-p cusr ?o))
773 (should (erc--cusr-status-p cusr ?v)))
774 (should erc--parsed-prefix))
775
776(ert-deftest erc--cusr-change-status ()
777 (erc-tests-common-make-server-buf (buffer-name))
778 (let ((cusr (make-erc-channel-user)))
779 (should-not (erc--cusr-status-p cusr ?o))
780 (should-not (erc--cusr-status-p cusr ?v))
781 (erc--cusr-change-status cusr ?o t)
782 (erc--cusr-change-status cusr ?v t)
783 (should (erc--cusr-status-p cusr ?o))
784 (should (erc--cusr-status-p cusr ?v))
785
786 (ert-info ("Reset with optional param")
787 (erc--cusr-change-status cusr ?q t 'reset)
788 (should-not (erc--cusr-status-p cusr ?o))
789 (should-not (erc--cusr-status-p cusr ?v))
790 (should (erc--cusr-status-p cusr ?q)))
791
792 (ert-info ("Clear with optional param")
793 (erc--cusr-change-status cusr ?v t)
794 (should (erc--cusr-status-p cusr ?v))
795 (erc--cusr-change-status cusr ?q nil 'reset)
796 (should-not (erc--cusr-status-p cusr ?v))
797 (should-not (erc--cusr-status-p cusr ?q)))))
798
717;; This exists as a reference to assert legacy behavior in order to 799;; This exists as a reference to assert legacy behavior in order to
718;; preserve and incorporate it as a fallback in the 5.6+ replacement. 800;; preserve and incorporate it as a fallback in the 5.6+ replacement.
719(ert-deftest erc-parse-modes () 801(ert-deftest erc-parse-modes ()
@@ -737,12 +819,9 @@
737 (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil)))))))) 819 (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
738 820
739(ert-deftest erc--update-channel-modes () 821(ert-deftest erc--update-channel-modes ()
740 (erc-mode) 822 (erc-tests-common-make-server-buf)
741 (setq erc-channel-users (make-hash-table :test #'equal) 823 (setq erc-channel-users (make-hash-table :test #'equal)
742 erc-server-users (make-hash-table :test #'equal)
743 erc--isupport-params (make-hash-table)
744 erc--target (erc--target-from-string "#test")) 824 erc--target (erc--target-from-string "#test"))
745 (erc-tests-common-init-server-proc "sleep" "1")
746 825
747 (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) 826 (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
748 calls) 827 calls)
@@ -1715,13 +1794,13 @@
1715;; regardless of whether a command handler is summoned. 1794;; regardless of whether a command handler is summoned.
1716 1795
1717(ert-deftest erc-process-input-line () 1796(ert-deftest erc-process-input-line ()
1718 (let (erc-server-last-sent-time 1797 (erc-tests-common-make-server-buf)
1719 erc-server-flood-queue 1798 (let ((orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG))
1720 (orig-erc-cmd-MSG (symbol-function 'erc-cmd-MSG)) 1799 (pop-flood-queue (lambda () (erc-with-server-buffer
1721 (erc-default-recipients '("#chan")) 1800 (pop erc-server-flood-queue))))
1722 calls) 1801 calls)
1723 (with-temp-buffer 1802 (setq erc-server-current-nick "tester")
1724 (erc-tests-common-init-server-proc "sleep" "1") 1803 (with-current-buffer (erc--open-target "#chan")
1725 (cl-letf (((symbol-function 'erc-cmd-MSG) 1804 (cl-letf (((symbol-function 'erc-cmd-MSG)
1726 (lambda (line) 1805 (lambda (line)
1727 (push line calls) 1806 (push line calls)
@@ -1735,49 +1814,50 @@
1735 (ert-info ("Baseline") 1814 (ert-info ("Baseline")
1736 (erc-process-input-line "/msg #chan hi\n") 1815 (erc-process-input-line "/msg #chan hi\n")
1737 (should (equal (pop calls) " #chan hi")) 1816 (should (equal (pop calls) " #chan hi"))
1738 (should (equal (pop erc-server-flood-queue) 1817 (should (equal (funcall pop-flood-queue)
1739 '("PRIVMSG #chan :hi\r\n" . utf-8)))) 1818 '("PRIVMSG #chan :hi\r\n" . utf-8))))
1740 1819
1741 (ert-info ("Quote preserves line intact") 1820 (ert-info ("Quote preserves line intact")
1742 (erc-process-input-line "/QUOTE FAKE foo bar\n") 1821 (erc-process-input-line "/QUOTE FAKE foo bar\n")
1743 (should (equal (pop erc-server-flood-queue) 1822 (should (equal (funcall pop-flood-queue)
1744 '("FAKE foo bar\r\n" . utf-8)))) 1823 '("FAKE foo bar\r\n" . utf-8))))
1745 1824
1746 (ert-info ("Unknown command respected") 1825 (ert-info ("Unknown command respected")
1747 (erc-process-input-line "/FAKE foo bar\n") 1826 (erc-process-input-line "/FAKE foo bar\n")
1748 (should (equal (pop erc-server-flood-queue) 1827 (should (equal (funcall pop-flood-queue)
1749 '("FAKE foo bar\r\n" . utf-8)))) 1828 '("FAKE foo bar\r\n" . utf-8))))
1750 1829
1751 (ert-info ("Spaces preserved") 1830 (ert-info ("Spaces preserved")
1752 (erc-process-input-line "/msg #chan hi you\n") 1831 (erc-process-input-line "/msg #chan hi you\n")
1753 (should (equal (pop calls) " #chan hi you")) 1832 (should (equal (pop calls) " #chan hi you"))
1754 (should (equal (pop erc-server-flood-queue) 1833 (should (equal (funcall pop-flood-queue)
1755 '("PRIVMSG #chan :hi you\r\n" . utf-8)))) 1834 '("PRIVMSG #chan :hi you\r\n" . utf-8))))
1756 1835
1757 (ert-info ("Empty line honored") 1836 (ert-info ("Empty line honored")
1758 (erc-process-input-line "/msg #chan\n") 1837 (erc-process-input-line "/msg #chan\n")
1759 (should (equal (pop calls) " #chan")) 1838 (should (equal (pop calls) " #chan"))
1760 (should (equal (pop erc-server-flood-queue) 1839 (should (equal (funcall pop-flood-queue)
1761 '("PRIVMSG #chan :\r\n" . utf-8))))) 1840 '("PRIVMSG #chan :\r\n" . utf-8)))))
1762 1841
1763 (ert-info ("Implicit cmd via `erc-send-input-line-function'") 1842 (ert-info ("Implicit cmd via `erc-send-input-line-function'")
1764 1843
1765 (ert-info ("Baseline") 1844 (ert-info ("Baseline")
1766 (erc-process-input-line "hi\n") 1845 (erc-process-input-line "hi\n")
1767 (should (equal (pop erc-server-flood-queue) 1846 (should (equal (funcall pop-flood-queue)
1768 '("PRIVMSG #chan :hi\r\n" . utf-8)))) 1847 '("PRIVMSG #chan :hi\r\n" . utf-8))))
1769 1848
1770 (ert-info ("Spaces preserved") 1849 (ert-info ("Spaces preserved")
1771 (erc-process-input-line "hi you\n") 1850 (erc-process-input-line "hi you\n")
1772 (should (equal (pop erc-server-flood-queue) 1851 (should (equal (funcall pop-flood-queue)
1773 '("PRIVMSG #chan :hi you\r\n" . utf-8)))) 1852 '("PRIVMSG #chan :hi you\r\n" . utf-8))))
1774 1853
1775 (ert-info ("Empty line transmitted with injected-space kludge") 1854 (ert-info ("Empty line transmitted with injected-space kludge")
1776 (erc-process-input-line "\n") 1855 (erc-process-input-line "\n")
1777 (should (equal (pop erc-server-flood-queue) 1856 (should (equal (funcall pop-flood-queue)
1778 '("PRIVMSG #chan : \r\n" . utf-8)))) 1857 '("PRIVMSG #chan : \r\n" . utf-8))))
1779 1858
1780 (should-not calls)))))) 1859 (should-not calls)))))
1860 (erc-tests-common-kill-buffers))
1781 1861
1782(ert-deftest erc--get-inserted-msg-beg/basic () 1862(ert-deftest erc--get-inserted-msg-beg/basic ()
1783 (erc-tests-common-assert-get-inserted-msg/basic 1863 (erc-tests-common-assert-get-inserted-msg/basic
diff --git a/test/lisp/erc/resources/base/modes/speaker-status.eld b/test/lisp/erc/resources/base/modes/speaker-status.eld
new file mode 100644
index 00000000000..4a7d508e35c
--- /dev/null
+++ b/test/lisp/erc/resources/base/modes/speaker-status.eld
@@ -0,0 +1,69 @@
1;; -*- mode: lisp-data; -*-
2((nick 10 "NICK tester"))
3((user 10 "USER tester 0 * :unknown")
4 (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
5 (0.00 ":irc.example.net NOTICE tester :*** Could not resolve your hostname: Domain not found; using your IP address (10.0.2.100) instead.")
6 (0.09 ":irc.example.net 001 tester :Welcome to the foonet IRC Network tester!tester@10.0.2.100")
7 (0.01 ":irc.example.net 002 tester :Your host is irc.example.net, running version InspIRCd-3")
8 (0.01 ":irc.example.net 003 tester :This server was created 07:50:59 Jan 22 2024")
9 (0.03 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw ACHIKMORTVXabcefghijklmnopqrstvyz :HIVXabefghjkloqvy")
10 (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are supported by this server")
11 (0.01 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100 MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=foonet :are supported by this server")
12 (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(yqaohvV)!~&@%+- SAFELIST SILENCE=32 STATUSMSG=!~&@%+- TOPICLEN=307 UHNAMES USERIP USERLEN=10 USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
13 (0.01 ":irc.example.net 251 tester :There are 2 users and 2 invisible on 2 servers")
14 (0.00 ":irc.example.net 252 tester 1 :operator(s) online")
15 (0.00 ":irc.example.net 253 tester 1 :unknown connections")
16 (0.00 ":irc.example.net 254 tester 2 :channels formed")
17 (0.00 ":irc.example.net 255 tester :I have 4 clients and 1 servers")
18 (0.00 ":irc.example.net 265 tester :Current local users: 4 Max: 5")
19 (0.00 ":irc.example.net 266 tester :Current global users: 4 Max: 5")
20 (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
21 (0.00 ":irc.example.net 372 tester : https://github.com/inspircd/inspircd-docker/issues")
22 (0.00 ":irc.example.net 372 tester : ")
23 (0.00 ":irc.example.net 372 tester : Have fun with the image!")
24 (0.00 ":irc.example.net 376 tester :End of message of the day.")
25 (0.00 ":irc.example.net 501 tester x :is not a recognised user mode.")
26 (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to foonet, tester! Here on foonet, we provide services to enable the registration of nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg ChanServ help\2."))
27
28((mode 10 "MODE tester +i")
29 (0.01 ":tester!tester@10.0.2.100 MODE tester :+i"))
30
31((join 10 "JOIN #chan")
32 (0.02 ":tester!tester@10.0.2.100 JOIN :#chan")
33 (0.02 ":irc.example.net 353 tester = #chan :+alice @fsbot -bob !foop tester")
34 (0.03 ":irc.example.net 366 tester #chan :End of /NAMES list.")
35 (0.00 ":bob!bob@localhost PRIVMSG #chan :tester, welcome!")
36 (0.01 ":alice!alice@localhost PRIVMSG #chan :tester, welcome!"))
37
38((mode-chan 10 "MODE #chan")
39 (0.00 ":irc.example.net 324 tester #chan :+nt")
40 (0.01 ":irc.example.net 329 tester #chan :1705909863")
41 (0.03 ":bob!bob@localhost PRIVMSG #chan :alice: Of that which hath so faithfully been paid.")
42 (0.03 ":alice!alice@localhost PRIVMSG #chan :Hie you, make haste, for it grows very late.")
43 (0.03 ":foop!user@netadmin.example.net PRIVMSG #chan :hi")
44 ;; (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: And make a clear way to the gods.")
45 ;; (0.04 ":bob!bob@localhost PRIVMSG #chan :Why, that they have; and bid them so be gone.")
46 ;; (0.08 ":bob!bob@localhost PRIVMSG #chan :alice: Now stay your strife: what shall be is dispatch'd.")
47 (0.06 ":foop!user@netadmin.example.net MODE #chan +v :bob")
48 (0.05 ":bob!bob@localhost PRIVMSG #chan :alice: Fair as a text B in a copy-book.")
49 (0.07 ":alice!alice@localhost PRIVMSG #chan :bob: Even as Apemantus does now; hate a lord with my heart.")
50 (0.03 ":bob!bob@localhost PRIVMSG #chan :Then here is a supplication for you. And when you come to him, at the first approach you must kneel; then kiss his foot; then deliver up your pigeons; and then look for your reward. I'll be at hand, sir; see you do it bravely.")
51 (0.05 ":foop!user@netadmin.example.net MODE #chan -v :bob")
52 (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: That's the way: for women are light at midnight.")
53 (0.04 ":alice!alice@localhost PRIVMSG #chan :Give it the beasts, to be rid of the men.")
54 ;; (0.02 ":alice!alice@localhost PRIVMSG #chan :bob: Here comes young Master Ganymede, my new mistress's brother.")
55 )
56
57((who-chan 10 "who #chan")
58 (0.03 ":irc.example.net 352 tester #chan alice localhost irc.example.net alice H+ :0 Irc bot based on irc3 http://irc3.readthedocs.io")
59 (0.03 ":irc.example.net 352 tester #chan fsbot localhost irc.example.net fsbot H@ :0 fsbot")
60 (0.01 ":irc.example.net 352 tester #chan bob localhost irc.example.net bob H- :0 Irc bot based on irc3 http://irc3.readthedocs.io")
61 (0.01 ":irc.example.net 352 tester #chan user netadmin.example.net irc.example.net foop H*! :0 unknown")
62 (0.01 ":irc.example.net 352 tester #chan tester 10.0.2.100 irc.example.net tester H :0 unknown")
63 (0.01 ":irc.example.net 315 tester #chan :End of /WHO list.")
64 ;; (0.09 ":bob!bob@localhost PRIVMSG #chan :alice: Shall nothing wrong him. Thus it is, general.")
65 ;; (0.04 ":alice!alice@localhost PRIVMSG #chan :bob: His father and I were soldiers together; to whom I have been often bound for no less than my life. Here comes the Briton: let him be so entertained amongst you as suits, with gentlemen of your knowing, to a stranger of his quality.")
66 (0.04 ":bob!bob@localhost PRIVMSG #chan :alice: Remains in danger of her former tooth."))
67
68((quit 10 "QUIT :\2ERC\2")
69 (0.03 "ERROR :Closing link: (tester@10.0.2.100) [Quit: \2ERC\2 5.x (IRC client for GNU Emacs)]"))