bug#49860: 28.0.50; add IRCv3 building blocks to ERC
"J.P." <[email protected]> Sat, 18 Oct 2025 13:40:36 -0700
| Newsgroups | gmane.emacs.bugs,gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
--=-=-= Content-Type: text/plain v2. [WIP] Add IRCv3 building blocks to ERC - Refactor CAP response handler for clarity re data-processing flow - Rename extension type's "action" field to "phase" to avoid noise from CTCP actions and for formatting alignment with "event" and "state" - Maintain invariant between "pending" state and `erc-v3--caps-queue-*' slots for clearer suspending of negotiations on behalf of SASL, extended-isupport, etc. [WIP] Add account slot to erc-server-user [WIP] Clearly define erc-server-user info field as an alist - Wrangle some misplaced hunks, even though these patches should probably be collapsed upon merging - Coerce empty string assignments for login, host, full-name, and account slots to nil in `erc-update-user' and `erc-add-server-user' [WIP] Use bespoke per-response-handler data classes in ERC [WIP] Fix some message display bugs in erc-backend - Move bug fixes out of "bespoke" patch into new "display bugs" patch --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff From 5309a7882a731f26bbf502d2e7a368c60327ede6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 18 Oct 2025 12:57:46 -0700 Subject: [PATCH 00/17] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (17): [5.7] ; Remove some forward declarations from ERC tests [5.7] Preserve order of local ERC modules for activation [5.7] Use speaker-end marker in ERC insertion hooks [5.7] Set major-mode before updating modules in erc-open [5.7] Run mode hooks in ERC query buffers on reconnect [5.x] Add predicate to detect ERC module activation [WIP] Add erc--echo msg property for self messages [WIP] Make ERC response handling more flexible [WIP] Clearly define erc-server-user info field as an alist [WIP] Add account slot to erc-server-user [WIP] Break up early ERC response processing [WIP] Make updating last-message-time more flexible in ERC [WIP] Make erc-insert-line overridable [WIP] Fix some message display bugs in erc-backend [WIP] Add macro for creating lazy struct accessors in ERC [WIP] Use bespoke per-response-handler data classes in ERC [WIP] Add IRCv3 building blocks to ERC etc/ERC-NEWS | 31 + lisp/erc/erc-backend.el | 427 ++- lisp/erc/erc-button.el | 28 +- lisp/erc/erc-common.el | 214 +- lisp/erc/erc-compat.el | 129 + lisp/erc/erc-fill.el | 20 +- lisp/erc/erc-goodies.el | 16 +- lisp/erc/erc-imenu.el | 8 +- lisp/erc/erc-speedbar.el | 36 +- lisp/erc/erc-stamp.el | 15 +- lisp/erc/erc-track.el | 4 +- lisp/erc/erc-truncate.el | 4 +- lisp/erc/erc-v3.el | 2454 +++++++++++++++++ lisp/erc/erc.el | 285 +- test/lisp/erc/erc-fill-tests.el | 11 +- .../erc/erc-scenarios-join-display-context.el | 2 + test/lisp/erc/erc-scenarios-log.el | 6 +- test/lisp/erc/erc-scenarios-services-misc.el | 3 +- .../erc/erc-scenarios-v3-account-notify.el | 133 + test/lisp/erc/erc-scenarios-v3-sasl.el | 199 ++ test/lisp/erc/erc-scenarios-v3.el | 587 ++++ test/lisp/erc/erc-tests.el | 225 +- test/lisp/erc/erc-v3-tests.el | 1364 +++++++++ .../erc/resources/erc-scenarios-common.el | 130 +- test/lisp/erc/resources/erc-tests-common.el | 2 +- .../account-notify/chghost-no-account-tag.eld | 77 + .../v3/account-notify/no-extended-join.eld | 50 + .../erc/resources/v3/away-notify/basic.eld | 63 + .../erc/resources/v3/cap-notify/basic.eld | 66 + .../erc/resources/v3/echo-message/basic.eld | 74 + .../erc/resources/v3/extended-join/basic.eld | 56 + .../erc/resources/v3/multi-prefix/basic.eld | 51 + .../erc/resources/v3/sasl/plain-failed.eld | 18 + .../resources/v3/sasl/plain-unsupported.eld | 7 + test/lisp/erc/resources/v3/sasl/plain.eld | 39 + .../erc/resources/v3/sasl/scram-sha-1.eld | 51 + .../erc/resources/v3/sasl/scram-sha-256.eld | 51 + .../erc/resources/v3/server-time/basic.eld | 57 + .../resources/v3/userhost-in-names/basic.eld | 49 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 41 files changed, 6957 insertions(+), 306 deletions(-) create mode 100644 lisp/erc/erc-v3.el create mode 100644 test/lisp/erc/erc-scenarios-v3-account-notify.el create mode 100644 test/lisp/erc/erc-scenarios-v3-sasl.el create mode 100644 test/lisp/erc/erc-scenarios-v3.el create mode 100644 test/lisp/erc/erc-v3-tests.el create mode 100644 test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld create mode 100644 test/lisp/erc/resources/v3/account-notify/no-extended-join.eld create mode 100644 test/lisp/erc/resources/v3/away-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/cap-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/echo-message/basic.eld create mode 100644 test/lisp/erc/resources/v3/extended-join/basic.eld create mode 100644 test/lisp/erc/resources/v3/multi-prefix/basic.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-unsupported.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-256.eld create mode 100644 test/lisp/erc/resources/v3/server-time/basic.eld create mode 100644 test/lisp/erc/resources/v3/userhost-in-names/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/rate-limited.eld Interdiff: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index af60afe9a99..6b96b295df1 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2893,7 +2893,8 @@ erc--extract-352-full-name (erc-channel-receive-names users)) (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) 'active) - 's353 ?c channel ?u users))) + 's353 ?c channel ?u users)) + nil) (define-erc-response-handler (366) "End of NAMES." nil diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 717afafe6a9..92082af2bcb 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -79,15 +79,24 @@ erc-input (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) - ;; User data - nickname host login full-name - ;; This slot was repurposed to accommodate metadata extensions. As - ;; of (FIXME some version), it's an alist of symbols paired with - ;; arbitrary data. For now, the only known items, when present, are - ;; `info', a legacy payload (see `erc--ensure-server-user-info'); - ;; `away', a (possibly empty) string indicating a user is away; and - ;; `idle', a nonempty string explaining how long a user has been - ;; idle (see `erc-server-307'). + ( nickname nil :type (or null string) + :documentation "The nickname, effectively non-nil and non-empty.") + ( host nil :type (or null string) + :documentation "The hostname.") + ( login nil :type (or null string) + :documentation "The login, also called username.") + ( full-name nil :type (or null string) + :documentation "The full name, also called real name and GECOS.") + ;; This slot was repurposed to accommodate metadata relevant to UI + ;; concerns, such as away status or display names. As of ERC 5.7, + ;; it's an alist of symbols paired with arbitrary values, and its only + ;; known items, when present, are + ;; - `away', a possibly empty string indicating a user is away + ;; (see `erc-server-301') + ;; - `idle', a nonempty string saying how long a user has been idle + ;; (see `erc-server-317') + ;; - `info', a "meta" item for legacy non-alist `info' slot values + ;; (see `erc--ensure-server-user-info') ( info nil :type (list-of cons) :documentation "Alist of `eq'-testable keys with arbitrary values.") diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el index 4def3fdc492..34c85696093 100644 --- a/lisp/erc/erc-v3.el +++ b/lisp/erc/erc-v3.el @@ -31,6 +31,7 @@ ;; ;; [1] https://ircv3.github.io/specs/core/capability-negotiation.html +;;; Code: (require 'erc) (eval-when-compile (require 'erc-sasl)) @@ -75,15 +76,15 @@ erc-v3--caps "Data related to capability negotiation." ( continued nil ;; This assumes replies won't be intermingled for adjacent requests. - :documentation "Stashed k/v pairs from multiline LS or LIST reply." + :documentation "Stashed arguments from a continued LS or LIST reply." :type (list-of cons)) ( extensions nil :documentation "Snapshot of desired canonical extensions on init." :type (list-of symbol) :read-only t) ( objects nil - :documentation "List of `erc-v3--capability' sorted objects." - :type (list-of erc-v3--capability)) + :documentation "List of `erc-v3--extension' sorted objects." + :type (list-of erc-v3--extension)) ( queue-out nil :documentation "Subset of OBJECTS slot used for outgoing requests." :type list) @@ -101,28 +102,46 @@ erc-v3--caps "Unique `erc-v3--caps' object for server process. Local to the server buffer.") +;; Could also generate intermediate edges for a less verbose +;; representation. (defmacro erc-v3--make-edges (name body) + "Define a `defconst' for all unique states in transition graph BODY. +Expect BODY to be an alist of members like (state . transitions) where +transitions is a list of triples of the form (event state phase). +Define a new `defvar' NAME whose value is a copy of BODY with all state +symbols replaced by their generated counterparts." (declare (indent 1)) (let* ((states ()) + (events ()) + (phases ()) (entries (mapcar (pcase-lambda (`(,in . ,next)) (cl-pushnew in states) `(,@(list (list '\, (intern (format "erc-v3--state-%s" in)))) ,@(mapcar - (pcase-lambda (`(,event ,out ,action)) + (pcase-lambda (`(,event ,out ,phase)) (cl-pushnew out states) - `(,event + (cl-pushnew event events) + (cl-pushnew phase phases) + `(,(list '\, (intern (format "erc-v3--event-%s" event))) ,(list '\, (intern (format "erc-v3--state-%s" out))) - ,action)) + ,(list '\, (intern (format "erc-v3--phase-%s" phase))))) next))) body))) `(progn - ,@(mapcar - (lambda (s) - `(defconst ,(intern (format "erc-v3--state-%s" s)) - (make-symbol ,(symbol-name s)))) - (sort states #'string-lessp)) + ,@(let (out) + (pcase-dolist (`(,kind . ,items) + (list (cons 'event events) + (cons 'phase phases) + (cons 'state (sort states #'string-lessp)))) + (push (mapcar + (lambda (s) + `(defconst ,(intern (format "erc-v3--%s-%s" kind s)) + (make-symbol ,(symbol-name s)))) + items) + out)) + (apply #'nconc out)) (defvar ,name ,(list '\` entries))))) @@ -133,89 +152,88 @@ erc-v3--make-edges ;; Pending {u: n/a, a: avail, y: queued, o: REQ-, i: REQ+, e: err} ;; ;; Events: -;; m-ok: calling extension's mode command succeeds (+1 or -1) -;; m-err: error calling extension's mode command (+1 or -1) -;; p-in: all replies from last round of REQs received -;; p-out: all requests for new round of REQs ready to be sent -;; p-err: request timed out -;; w-on: extension object created on module init -;; w-ok: pre-flight validation/prep succeeded -;; w-err: application error during activation inc. timed out -;; s-005: 005 received relevant to ISUPPORT-centric extension -;; s-ack (s-nak, s-del, s-ls, s-new): server command received +;; mOK: calling extension's mode command succeeds (+1 or -1) +;; mERR: error calling extension's mode command (+1 or -1) +;; pIN: all replies from last round of REQs received +;; pOUT: all requests for new round of REQs ready to be sent +;; pERR: request timed out +;; wON: extension object created on module init +;; wOK: pre-flight validation/prep succeeded +;; wERR: application error during activation inc. timed out +;; s005: 005 received relevant to ISUPPORT-centric extension +;; sACK (sNAK, sDEL, sLS, sNEW): server command received ;; -;; Actions: -;; nil: default value on new struct instance -;; init: instantiate, record whether extension is initially wanted -;; track: remember advertised (w. key and value for caps) -;; check: dependencies, validate advertised values, etc. -;; qout: mark as needing REQ to be sent -;; qin: mark as REQ reply needing processing -;; send: (possibly negated) REQ sent to server -;; up: attempt to enable extension's minor mode and dependencies -;; down: attempt to disable extension's minor mode and dependents -;; log: insert user-facing "error notice" in server buffer -;; run/pass: do nothing +;; Phases: +;; nil: default value on new struct instance +;; INIT: instantiate, record whether extension is initially wanted +;; TRACK: remember advertised (w. key and value for caps) +;; CHECK: dependencies, validate advertised values, etc. +;; QOUT: mark as needing REQ to be sent +;; QIN: mark as REQ reply needing processing +;; SEND: (possibly negated) REQ sent to server +;; UP: attempt to enable extension's minor mode and dependencies +;; DOWN: attempt to disable extension's minor mode and dependents +;; LOG: insert user-facing "error notice" in server buffer +;; RUN, PASS: do nothing ;; S_-W_-M_-P_ ;; Symbol-name indexes used in related predicates: .1..4..7..a (erc-v3--make-edges erc-v3--edges ;; Unavailable and unwanted (non-cap) extension - ((Su-Wo-Mo-Pu (w-on Su-Wi-Mo-Pu init) ; new struct on module init - (s-005 Sa-Wo-Mo-Pu track)) ; unwanted ISUPPORT-based (1) + ((Su-Wo-Mo-Pu (wON Su-Wi-Mo-Pu INIT) ; new struct on module init + (s005 Sa-Wo-Mo-Pu TRACK)) ; unwanted ISUPPORT-based (1) ;; Unavailable but wanted (non-cap) extension - (Su-Wi-Mo-Pu (s-005 Sa-Wi-Mo-Pu check)) ; wanted ISUPPORT-based + (Su-Wi-Mo-Pu (s005 Sa-Wi-Mo-Pu CHECK)) ; wanted ISUPPORT-based ;; Available and wanted (non-cap) extension - (Sa-Wi-Mo-Pu (m-ok Sa-Wi-Mi-Pu run) ; minor-mode up success - (m-err Sa-We-Mo-Pu log) ; minor-mode up failure (2) - (w-err Sa-We-Mo-Pu log)) ; validation failure (2) + (Sa-Wi-Mo-Pu (mOK Sa-Wi-Mi-Pu RUN) ; minor-mode up success + (mERR Sa-We-Mo-Pu LOG) ; minor-mode up failure (2) + (wERR Sa-We-Mo-Pu LOG)) ; validation failure (2) ;; Unavailable and unwanted capability - (Su-Wo-Mo-Pa (w-on Su-Wi-Mo-Pa init) ; new struct on module init - (s-ls Sa-Wo-Mo-Pa track) ; passive update, k/v stored - (s-new Sa-Wo-Mo-Pa track)) ; same as ^ + (Su-Wo-Mo-Pa (wON Su-Wi-Mo-Pa INIT) ; new struct on module init + (sLS Sa-Wo-Mo-Pa TRACK) ; passive update, k/v stored + (sNEW Sa-Wo-Mo-Pa TRACK)) ; same as ^ ;; Available but unwanted capability - (Sa-Wo-Mo-Pa (s-del Su-Wo-Mo-Pa pass)) ; server makes unavailable + (Sa-Wo-Mo-Pa (sDEL Su-Wo-Mo-Pa PASS)) ; server makes unavailable ;; Unavailable but wanted capability - (Su-Wi-Mo-Pa (s-ls Sa-Wi-Mo-Pa check) ; needs pre-flight REQ+ check - (s-new Sa-Wi-Mo-Pa check)) ; same as ^ + (Su-Wi-Mo-Pa (sLS Sa-Wi-Mo-Pa CHECK) ; needs pre-flight REQ+ check + (sNEW Sa-Wi-Mo-Pa CHECK)) ; same as ^ ;; Available and wanted capability - (Sa-Wi-Mo-Pa (w-ok Sa-Wi-Mo-Py qout) ; check passed, queue as REQ+ - (w-err Sa-We-Mo-Pa log)) ; check failed, non-fatal log + (Sa-Wi-Mo-Pa (wOK Sa-Wi-Mo-Py QOUT) ; check passed, queue as REQ+ + (wERR Sa-We-Mo-Pa LOG)) ; check failed, non-fatal log ;; Available and wanted capability awaiting outgoing request - (Sa-Wi-Mo-Py (p-out Sa-Wi-Mo-Pi send)) ; send REQ+/-, clear queue + (Sa-Wi-Mo-Py (pOUT Sa-Wi-Mo-Pi SEND)) ; send REQ+/-, clear queue ;; Available and wanted capability awaiting reply - (Sa-Wi-Mo-Pi (s-ack Si-Wi-Mo-Py qin) ; server enabled, queue sync - (s-nak Sa-We-Mo-Py qin) ; request denied, needs attn (5) - (p-err Su-Wi-Mo-Pe log)) ; timeout or transport error (2) + (Sa-Wi-Mo-Pi (sACK Si-Wi-Mo-Py QIN) ; server enabled, queue sync + (sNAK Sa-We-Mo-Py QIN) ; request denied, needs attn (5) + (pERR Su-Wi-Mo-Pe LOG)) ; timeout or transport error (2) ;; Provided and wanted capability awaiting processing - (Si-Wi-Mo-Py (p-in Si-Wi-Mo-Pa up) ; REQs all received, do sync - (w-err Sa-We-Mo-Pa log)) ; log fatal, e.g., SASL 904 + (Si-Wi-Mo-Py (pIN Si-Wi-Mo-Pa UP) ; REQs all received, do sync + (wERR Sa-We-Mo-Pa LOG)) ; log fatal, e.g., SASL 904 ;; Available but tainted capability awaiting processing - (Sa-We-Mo-Py (p-in Sa-We-Mo-Pa log)) ; log rejection + (Sa-We-Mo-Py (pIN Sa-We-Mo-Pa LOG)) ; log rejection ;; Provided and wanted capability awaiting local sync - (Si-Wi-Mo-Pa (m-ok Si-Wi-Mi-Pa run) ; minor-mode +1 sync succeeded - (m-err Si-Wi-Me-Py qout)) ; minor-mode +1 sync failed + (Si-Wi-Mo-Pa (mOK Si-Wi-Mi-Pa RUN) ; minor-mode +1 sync succeeded + (mERR Si-Wi-Me-Py QOUT)) ; minor-mode +1 sync failed ;; Provided and wanted cap with activation taint awaiting server sync - (Si-Wi-Me-Py (p-out Si-Wi-Me-Po send)) ; sent REQ- (3) + (Si-Wi-Me-Py (pOUT Si-Wi-Me-Po SEND)) ; sent REQ- (3) ;; Provided and wanted cap with activation taint awaiting reply - (Si-Wi-Me-Po (s-ack Sa-Wi-Me-Py qin) ; queue to log error from sync (3) - (s-nak Sa-We-Me-Py qin) ; rejected REQ-, queue log (3) - (p-err Su-Wi-Me-Pe log)) ; REQ- timed out, log (3) + (Si-Wi-Me-Po (sACK Sa-Wi-Me-Py QIN) ; queue to log error from sync (3) + (sNAK Sa-We-Me-Py QIN) ; rejected REQ-, queue log (3) + (pERR Su-Wi-Me-Pe LOG)) ; REQ- timed out, log (3) ;; Available and wanted cap with activation taint awaiting processing - (Sa-Wi-Me-Py (p-in Sa-Wi-Me-Pa log)) ; log error for *good* REQ- (3) + (Sa-Wi-Me-Py (pIN Sa-Wi-Me-Pa LOG)) ; log error for *good* REQ- (3) ;; Available and doubly tainted capability awaiting ingress processing - (Sa-We-Me-Py (p-in Sa-We-Me-Pa log)) ; log error for rejected REQ- (3) + (Sa-We-Me-Py (pIN Sa-We-Me-Pa LOG)) ; log error for rejected REQ- (3) ;; Provided, wanted, and active capability (idle) - (Si-Wi-Mi-Pa (s-del Su-Wi-Mi-Pa down)) ; server mandate to sync down + (Si-Wi-Mi-Pa (sDEL Su-Wi-Mi-Pa DOWN)) ; server mandate to sync down ;; Unavailable but wanted and active cap awaiting immediate local sync - (Su-Wi-Mi-Pa (m-ok Su-Wi-Mo-Pa pass) ; mode -1 success - (m-err Su-Wi-Me-Pa log)))) ; mode -1 failed (2) + (Su-Wi-Mi-Pa (mOK Su-Wi-Mo-Pa PASS) ; mode -1 success + (mERR Su-Wi-Me-Pa LOG)))) ; mode -1 failed (2) ;; Notes for transition table above: ;; 1. Currently not possible because WHOX and MONITOR are hard-coded ;; 2. Not currently part of test suite but plausible -;; 3. Temporary, for demo purposes. (See `erc-v3--ensure-enabled'.) -;; Could be simplified by allowing multiple actions (e.g., log+qout). +;; 3. Possibly temporary for demo purposes. See `erc-v3--ensure-enabled'. ;; 4. Unlikely, though possible and covered by tests; could be removed ;; 5. Possibly unreachable unless pathological @@ -242,14 +260,13 @@ erc-v3--extension :documentation "Alternate names for the same extension.") ( event nil :type symbol - :documentation "Last event triggering the current state and action.") + :documentation "Last event triggering the current state and phase.") ( state erc-v3--state-Su-Wo-Mo-Pu :type symbol - ;; Some aspects of the state model only apply to capabilities. :documentation "Internal symbol representing current negotiation state.") - ( action nil + ( phase nil :type symbol - :documentation "Associated action symbol from latest transition output.") + :documentation "Associated phase from latest transition output.") ( history nil :type list :documentation "Append-only snapshot of past states at every transition.") @@ -286,65 +303,102 @@ erc-v3--init-p ;; Always use `erc-v3--transition' instead. See related comment in ;; tests. (defun erc-v3--get-state (state event) + "Return transition triple keyed by EVENT in entry for STATE in graph." (declare (ftype (function (symbol symbol) list))) (and-let* ((events (alist-get state erc-v3--edges)) ((alist-get event events))))) -(defun erc-v3--transition (cap event) - "Transition CAP in accepts EVENT. -Perform other side effects, like logging errors and tending to history -and send/recv queues." +(defun erc-v3--log-state-error (ext) + "Display error for `erc-v3--extension' EXT if its phase is `log'." + (when (eq (erc-v3--extension-phase ext) erc-v3--phase-LOG) + (let ((name (if (erc-v3--capability-p ext) + (erc-v3--capability-key ext) + (erc-v3--extension-canon ext)))) + (erc-button--display-error-notice-with-keys + (current-buffer) + "Problem processing extension '%s'. See %s for details." + name (messages-buffer)) + (unless noninteractive + (message "Problem processing extension '%s':" name) + (pp (cons (list :event (erc-v3--extension-event ext) + :state (erc-v3--extension-state ext) + :phase (erc-v3--extension-phase ext)) + (mapcar (pcase-lambda (`(,e ,s ,p)) + (list :event e :state s :phase p)) + (erc-v3--extension-history ext)))))))) + +(defun erc-v3--enqueue-in (extension) + "Add EXTENSION to `erc-v3--caps-queue-in' slot if phase dictates." + (if (eq erc-v3--phase-QIN (erc-v3--extension-phase extension)) + (push (cons (let ((e (erc-v3--extension-event extension))) + (cond ((eq e erc-v3--event-sACK) #'erc-v3--subcmd-ACK) + ((eq e erc-v3--event-sNAK) #'erc-v3--subcmd-NAK) + (t (error "Wrong event: %S" e)))) + extension) + (erc-v3--caps-queue-in erc-v3--caps)))) + +(defun erc-v3--enqueue-out (extension) + "Add EXTENSION to `erc-v3--caps-queue-out' slot if phase dictates." + (if (eq (erc-v3--extension-phase extension) erc-v3--phase-QOUT) + (push extension (erc-v3--caps-queue-out erc-v3--caps)))) + +(defvar erc-v3--transition-functions (list #'erc-v3--enqueue-in + #'erc-v3--enqueue-out + #'erc-v3--log-state-error)) + +(defun erc-v3--transition (ext event) + "Transition `erc-v3--extension' EXT if it accepts EVENT. +Then call `erc-v3--transition-functions' to perform side effects, like +logging and queuing, before returning the new phase symbol." (declare (ftype (function (erc-v3--extension symbol) symbol))) - (when-let* ((entry (erc-v3--get-state (erc-v3--extension-state cap) event))) - (pcase-let* ((`(,state ,action) entry)) + (when-let* ((entry (erc-v3--get-state (erc-v3--extension-state ext) event))) + (pcase-let* ((`(,state ,phase) entry)) (cl-assert state) ;; Add last trio to history before committing the new one. - (push (list (erc-v3--extension-event cap) - (erc-v3--extension-state cap) - (erc-v3--extension-action cap)) - (erc-v3--extension-history cap)) - (setf (erc-v3--extension-event cap) event - (erc-v3--extension-state cap) state - (erc-v3--extension-action cap) action) - (pcase action - ('log (erc-button--display-error-notice-with-keys - (current-buffer) - "Problem processing extension '%s'. See %s for details." - (erc-v3--capability-key cap) (messages-buffer)) - (unless noninteractive - (message "Problem processing extension '%s':" - (erc-v3--capability-key cap)) - (pp (cons (list :event event :state state :action action) - (mapcar (pcase-lambda (`(,e ,s ,a)) - (list :event e :state s :action a)) - (erc-v3--extension-history cap)))))) - ('qout (push cap (erc-v3--caps-queue-out erc-v3--caps))) - ('qin (push (cons event cap) (erc-v3--caps-queue-in erc-v3--caps)))) - action))) - + (push (list (erc-v3--extension-event ext) + (erc-v3--extension-state ext) + (erc-v3--extension-phase ext)) + (erc-v3--extension-history ext)) + (setf (erc-v3--extension-event ext) event + (erc-v3--extension-state ext) state + (erc-v3--extension-phase ext) phase) + (run-hook-with-args 'erc-v3--transition-functions ext) + phase))) + +;; FIXME either cover these with tests or define and use constants for +;; the indexes instead of literal integers. (defun erc-v3--wanted-p (ext) + "Return non-nil if EXT's state slot has a Wi component." (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 4))) (defun erc-v3--unwanted-p (ext) + "Return non-nil if EXT's state slot has a Wo component." (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 4))) (defun erc-v3--enabled-p (ext) + "Return non-nil if EXT's state slot has a Mi component." (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 7))) (defun erc-v3--queued-p (ext) + "Return non-nil if EXT's state slot has a Py component." (eq ?y (aref (symbol-name (erc-v3--extension-state ext)) 10))) (defun erc-v3--pending-negated-p (ext) + "Return non-nil if EXT's state slot has a Po component." (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 10))) (defun erc-v3--error-p (ext) + "Return non-nil if EXT's state slot has a We, Me, or Pe component." (or (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 4)) (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 7)) (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 10)))) -(defun erc-v3--caps-by-action (action) - (seq-filter (lambda (o) (eq action (erc-v3--extension-action o))) - (erc-v3--caps-objects erc-v3--caps))) +(defmacro erc-v3--caps-by-phase (phase) + "Return all extensions whose phase stage matches symbol PHASE." + `(seq-filter (lambda (o) + (eq ,(intern (format "erc-v3--phase-%s" phase)) + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps))) (defun erc-v3--sync-mode-value (var value) "Set VAR in current buffer to server buffer's local VALUE for VAR." @@ -435,9 +489,9 @@ erc-v3-extension ;; the extension's minor-mode command, erc-v3--EXT-mode. (defmacro erc-v3--define-extension (&rest body) "Define an `erc-v3--extension'-derived struct and supporting items. -Create a struct type named erc-v3--NAME with an identically named -constructor, and have it \"subclass\" `erc-v3--extension'. Expect NAME -to be a symbol or, alternatively, a list containing a symbol and +From BODY, create a struct type named erc-v3--NAME with an identically +named constructor, and have it \"subclass\" `erc-v3--extension'. Expect +NAME to be a symbol or, alternatively, a list containing a symbol and `cl-defstruct' options. If OPTS, which is a span of zero or more top-level keyword-value pairs, contains a `:slots' keyword, interpret its paired value as an unquoted alist of `cl-defstruct' slot definitions @@ -459,8 +513,8 @@ erc-v3--define-extension in all buffers of the connection. Make this mode non-interactive, but allow a `:keymap' argument in OPTS to specify the minor mode's keymap. Interpret all forms following the last keyword/value pair or second doc -string as comprising the minor-mode's body. In target buffers, arrange -for this body to run alongside normal local-module activation, where +string as comprising the MODE-BODY. In target buffers, arrange for this +body to run alongside normal local-module activation, where `erc--target-priors' is populated. In server buffers, have it run during connection registration, where `erc--server-reconnecting' is empty and calls to `erc--restore-initialize-priors' ineffective, @@ -476,7 +530,8 @@ erc-v3--define-extension (defmacro erc-v3--define-capability (&rest body) "Define an `erc-v3--capability'-derived struct and supporting items. -In almost all respects, act like `erc-v3--define-extension'. +In almost all respects, act like `erc-v3--define-extension', whose doc +string explains the various parts of BODY. \(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) @@ -527,7 +582,9 @@ erc-v3--activate-module (funcall constructor)) objects) (when (erc-v3--extension-initp (car objects)) - (cl-assert (eq 'init (erc-v3--transition (car objects) 'w-on)))))) + (cl-assert (eq erc-v3--phase-INIT + (erc-v3--transition (car objects) + erc-v3--event-wON)))))) (setq exts (append erc-v3-base-extensions (mapcar (lambda (s) (get (get s 'erc-v3--extension-class) @@ -584,23 +641,13 @@ v3 ;; To profile the negotiation sequence, put a `profiler-start' here and ;; a `profiler-stop' in `erc-v3--finish-negotiating'. (cl-defmethod erc--register-connection (&context (erc-v3-mode (eql t))) - "Start capability negotiation with server." + "Start capability negotiation with server when ERC-V3-MODE is non-nil." (erc-server-send "CAP LS 302") (erc-login)) -(defun erc-v3--partition-cap-tokens (tokens) - "Partition TOKENS into cons cells. -Return an alist with elements like (CAP . VAL) or (CAP), where CAP is a -symbol and VAL is a string or nil." - (let (result) - (dolist (item tokens (nreverse result)) - (let* ((pos (string-search "=" item)) - (key (intern (if pos (substring item nil pos) item))) - (val (and pos (substring item (1+ pos))))) - (push (cons key val) result))))) - (defun erc-v3--handle-negotiation-timeout (buffer event) - "Destroy session in server BUFFER and print info about CAPS." + "Destroy session in server BUFFER and dump info about caps. +Transition all objects with EVENT." (when (buffer-live-p buffer) (with-current-buffer buffer (dolist (o (erc-v3--caps-objects erc-v3--caps)) @@ -619,6 +666,8 @@ erc-v3--sync-timeout-seconds "Time allowed between last answered \"REQ\" and \"END\".") (defun erc-v3--run-timer (event secs) + "Run timer SECS seconds from now. +Arrange to call `erc-v3--handle-negotiation-timeout' with EVENT." (when (erc-v3--caps-timer erc-v3--caps) (cancel-timer (erc-v3--caps-timer erc-v3--caps))) (setf (erc-v3--caps-timer erc-v3--caps) @@ -627,56 +676,99 @@ erc-v3--run-timer (defun erc-v3--send-requests () "Request all caps in the `erc-v3--caps-queue-out'. -If there aren't any, do nothing and return nil. Otherwise create and -return a request timer." - (when (erc-v3--caps-queue-out erc-v3--caps) - (let (todo) - (while-let ((o (pop (erc-v3--caps-queue-out erc-v3--caps)))) - (cl-assert (eq 'qout (erc-v3--extension-action o))) - (when (eq 'send (erc-v3--transition o 'p-out)) - (push (concat (and (erc-v3--pending-negated-p o) "-") - (symbol-name (erc-v3--capability-key o))) - todo))) - (while-let ((todo) - (this (take 10 todo))) - (erc-server-send (format "CAP REQ :%s" (string-join this " "))) - (setq todo (nthcdr 10 todo)))) - (erc-v3--run-timer 'p-err erc-v3--request-timeout-seconds))) - -(defun erc-v3--run-subcmds-piecemeal (alist subcmd) - "Run all individual \"CAP\" subcommand handlers. -Expect ALIST to be as described by `erc-v3--dispatch-subcmd' and SUBCMD -to be the handler function for current \"CAP\" subcommand." +Create and return a request timer." + (cl-assert (erc-v3--caps-queue-out erc-v3--caps)) + (let (todo) + (while-let ((o (pop (erc-v3--caps-queue-out erc-v3--caps)))) + (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase o))) + (when (eq erc-v3--phase-SEND (erc-v3--transition o erc-v3--event-pOUT)) + (push (concat (and (erc-v3--pending-negated-p o) "-") + (symbol-name (erc-v3--capability-key o))) + todo))) + (while-let ((todo) + (this (take 10 todo))) + (erc-server-send (format "CAP REQ :%s" (string-join this " "))) + (setq todo (nthcdr 10 todo)))) + (erc-v3--run-timer erc-v3--event-pERR erc-v3--request-timeout-seconds)) + +(defun erc-v3--run-subcmd (key handler) + "Run all \"CAP\" subcmd HANDLERs for capability KEY." + (when-let* ((canon (erc-v3--canon-from-key key)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall handler cap))) + +(defun erc-v3--run-subcmds-piecemeal (subcmd alist) + "Run all SUBCMD handlers for a \"CAP LS\" or a \"CAP NEW\". +Expect ALIST to have members with symbols at the head representing +capabilities." (pcase-dolist (`(,key . ,_) alist) - (when-let* ((canon (erc-v3--canon-from-key key)) - (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) - :key #'erc-v3--extension-canon))) - (funcall subcmd cap)))) + (erc-v3--run-subcmd key (pcase-exhaustive subcmd + ('LS #'erc-v3--subcmd-LS) + ('NEW #'erc-v3--subcmd-NEW))))) (defun erc-v3--finish-negotiating () "Finalize \"CAP\" dialog." - (unless (seq-some #'erc-v3--queued-p (erc-v3--caps-objects erc-v3--caps)) - (when-let* ((timer (erc-v3--caps-timer erc-v3--caps))) - (cancel-timer timer) - (setf (erc-v3--caps-timer erc-v3--caps) nil)) - (unless (erc-v3--caps-negotiated-p erc-v3--caps) - (erc-server-send "CAP END") - (setf (erc-v3--caps-negotiated-p erc-v3--caps) t)))) - + (when-let* ((timer (erc-v3--caps-timer erc-v3--caps))) + (cancel-timer timer) + (setf (erc-v3--caps-timer erc-v3--caps) nil)) + (unless (erc-v3--caps-negotiated-p erc-v3--caps) + (erc-server-send "CAP END") + (setf (erc-v3--caps-negotiated-p erc-v3--caps) t))) + +;; FIXME ensure a "CAP NEW" arriving unexpectedly during registration +;; won't cause problems. (cl-defmethod erc--server-CAP (_proc parsed &context (erc-v3-mode (eql t))) - "Initialize, transition, and terminate a \"CAP\" dialog. -Handle \"CAP\" subcommands, perhaps not immediately. Do this throughout -an IRC session, not only during connection registration. Don't run -handlers if the response lacks a trailing argument. Always send a \"CAP -END\" during registration if no requests are pending, which may be -undesirable in some cases. Always return nil." - (when-let* ((toks (split-string (erc-response.contents parsed)))) - (erc-v3--dispatch-subcmd - (erc-v3--partition-cap-tokens toks) - parsed (intern (nth 1 (erc-response.command-args parsed))))) - ;; Send requests or end dialog. - (unless (or (erc-v3--caps-continued erc-v3--caps) (erc-v3--send-requests)) - (erc-v3--finish-negotiating)) + "Manage a \"CAP\" dialog when ERC-V3-MODE is non-nil. +Handle \"CAP\" subcommands in `erc-response' PARSED, possibly deferring +some for later processing. Do this throughout an IRC session, not only +during connection registration. Skip handlers if PARSED lacks trailing +args but do send queued requests. Always send a \"CAP END\" during +registration if no requests are pending, which may be undesirable in +some cases. Always return nil." + (let* ((subcmd (intern (nth 1 (erc-response.command-args parsed)))) + (contents (if (memq subcmd '(LS LIST)) + (erc-v3--check-continued parsed) ; may be null + (list (erc-response.contents parsed)))) + (server-buffer (current-buffer)) + (pairs ())) + (when contents + (with-temp-buffer + (while-let ((contents (pop contents))) + (insert " " contents)) + (goto-char (point-min)) + (skip-syntax-forward "-") + (while-let (((not (eobp))) + (beg (point)) + ((not (zerop (skip-syntax-forward "^-"))))) + ;; Maybe split token into a k/v pair. + (let* ((end (point)) + (p (and (memq subcmd '(LS NEW)) + (save-excursion (goto-char beg) + (search-forward "=" end t)))) + (key (intern (buffer-substring beg (or (and p (1- p)) end)))) + (val (and p (buffer-substring p end)))) + (with-current-buffer server-buffer + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--mark-offered subcmd key val)) + ((or 'ACK 'NAK) (erc-v3--check-answered subcmd key)) + ('DEL (erc-v3--run-subcmd key #'erc-v3--subcmd-DEL)))) + (push (cons key val) pairs)) + (skip-syntax-forward "-")))) + ;; Perform deferred processing. + (when pairs + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--run-subcmds-piecemeal subcmd (nreverse pairs))) + ((or 'ACK 'NAK) (erc-v3--consider-answered)) + ('LIST (erc-v3--handle-subcmd-list parsed (nreverse pairs))) + ('DEL (erc-v3--ensure-disabled (erc-v3--caps-by-phase DOWN)))) + ;; Deal with queued items or finish negotiation. + (cond ((erc-v3--caps-queue-out erc-v3--caps) (erc-v3--send-requests)) + ;; Inhibited ACK/NAK. + ((seq-some #'erc-v3--queued-p (erc-v3--caps-objects erc-v3--caps)) + (cl-assert (erc-v3--caps-by-phase QIN)) + (cl-assert (erc-v3--caps-queue-in erc-v3--caps))) + (t (erc-v3--finish-negotiating))))) nil) (define-erc-response-handler (CAP) @@ -710,7 +802,7 @@ erc-v3--deps-build-dag (cl-pushnew v (alist-get u graph))))))) (defun erc-v3--deps-tsort (objects graph) - "Return `erc-v3--extension' list OBJECTS sorted by dependencies." + "Return `erc-v3--extension' list OBJECTS sorted by GRAPH's dependencies." (let ((out ())) (named-let doit ((us objects)) (dolist (u us) @@ -753,40 +845,50 @@ erc-v3--cap-negated-p "Indicate whether CAP-SYM is negated (has a leading hyphen)." (inline-quote (eq ?- (aref (symbol-name ,cap-sym) 0)))) -(defun erc-v3--check-continued (alist parsed) +(defun erc-v3--check-continued (parsed) "Update the `continued' slot of `erc-v3--caps' from ALIST. Return the updated value if PARSED response is terminal and not to be continued." - (let ((pairs (cl-callf (lambda (existing) (nconc existing alist)) - (erc-v3--caps-continued erc-v3--caps)))) + (let ((contents (push (erc-response.contents parsed) + (erc-v3--caps-continued erc-v3--caps)))) (unless (string= "*" (nth 2 (erc-response.command-args parsed))) (setf (erc-v3--caps-continued erc-v3--caps) nil) - pairs))) + (nreverse contents)))) (defvar erc-message-english-CAP-LIST "Enabled CAPs: %m" "English `erc-message-template' template for key `CAP-LIST'.") +(defun erc-v3--handle-subcmd-list (parsed pairs) + "Display PAIRS named for \"LIST\" subcommand in PARSED response." + (when-let* ((m (mapcar (lambda (i) (symbol-name (car i))) pairs))) + (erc-display-message parsed 'notice 'active 'CAP-LIST + ?m (string-join m ", ")))) + (defun erc-v3--find-capability-by-key (key) "Return `erc-v3--capability' matching KEY." (cl-find (erc-v3--canon-from-key key) (erc-v3--caps-objects erc-v3--caps) :key #'erc-v3--extension-canon)) -(defun erc-v3--mark-offered (alist event) - "Mark items in ALIST as ready for checking by individual handlers. -EVENT should be a symbol, either `s-ls' or `s-new'." - ;; Iterate over alist in outer loop to preserve original LS ordering. - ;; This includes uninitialized caps, typically those not declared via - ;; user option, because they're still tracked despite not being - ;; requested. - (pcase-dolist (`(,key . ,val) alist) - (cl-assert (not (erc-v3--cap-negated-p key))) - (when-let* ((o (erc-v3--find-capability-by-key key))) - (cl-assert (erc-v3--capability-p o)) ; not a plain extension - (when (erc-v3--transition o event) - ;; Store keys and values even for caps that are merely - ;; tracked and not slated for requesting. - (setf (erc-v3--capability-key o) key - (erc-v3--capability-val o) val))))) +(defun erc-v3--subcmd2event (subcmd) + "Return event for SUBCMD." + (pcase-exhaustive subcmd + ('ACK erc-v3--event-sACK) + ('NAK erc-v3--event-sNAK) + ('LS erc-v3--event-sLS) + ('NEW erc-v3--event-sNEW) + ('DEL erc-v3--event-sDEL))) + +(defun erc-v3--mark-offered (subcmd key val) + "Mark cap as ready for checking if named by SUBCMD. +Record KEY and VAL unconditionally, possibly clobbering existing." + (cl-assert (not (erc-v3--cap-negated-p key))) + (when-let* ((o (erc-v3--find-capability-by-key key))) + (cl-assert (erc-v3--capability-p o)) ; not a plain extension + ;; Clobber an existing value even if the cap is already somehow + ;; enabled. + (setf (erc-v3--capability-key o) key + (erc-v3--capability-val o) val) + (erc-v3--transition o (erc-v3--subcmd2event subcmd)))) (defun erc-v3--canon-from-key (key) "Return canonical capability name for KEY." @@ -799,30 +901,30 @@ erc-v3--canon-from-key ;; as a symbol property of the constructor to avoid having to ;; search through things like `cl-struct-erc-v3--extension-tags' ;; or `cl--struct-class-parents'. - ((eq 'erc-v3--capability (get constructor 'erc-v3--extension-super)))) + (_ (eq 'erc-v3--capability (get constructor 'erc-v3--extension-super)))) (get constructor 'erc-v3--extension-canon))) (defun erc-v3--ensure-deps (extension) "Check `depends' slot of `erc-v3--extension' EXTENSION. -If dependencies remain unmet, print an error notice and send a `w-err' -into the state machine. Otherwise, transition via `w-ok'." +If dependencies remain unmet, print an error notice and send a `wERR' +into the state machine. Otherwise, transition via `wOK'." (catch 'done (dolist (canon (erc-v3--extension-depends extension)) (when-let* ((dep (cl-find canon (erc-v3--caps-objects erc-v3--caps) :key #'erc-v3--extension-canon)) ;; Unless dependency is slated to be enabled or already is... - ((not (or (memq (erc-v3--extension-action dep) '(check qout)) - (erc-v3--enabled-p dep))))) - (erc-v3--transition extension 'w-err) + (_ (not (or (memq (erc-v3--extension-phase dep) + (list erc-v3--phase-CHECK erc-v3--phase-QOUT)) + (erc-v3--enabled-p dep))))) + (erc-v3--transition extension erc-v3--event-wERR) (erc-button--display-error-notice-with-keys - (current-buffer) - "Problem resolving dependencies." + (current-buffer) "Problem resolving dependencies." " Disabling capability '%s' because of unmet requirement '%s'." " Try checking option `erc-v3-extensions'." (erc-v3--capability-key extension) canon) (throw 'done t))) - (erc-v3--transition extension 'w-ok))) + (erc-v3--transition extension erc-v3--event-wOK))) (defvar erc-v3--fatal-mode-body-failure-p t "Whether to destroy the session if an extension's mode body signals.") @@ -856,7 +958,7 @@ erc-v3--ensure-enabled ;; themselves if requirements are unmet. (unless (symbol-value variable) (funcall mode +1))) - (erc-v3--transition cap 'm-ok)) + (erc-v3--transition cap erc-v3--event-mOK)) (error ;; The remaining members of CANDIDATES that depend on cap must ;; also be taken offline, in addition to anything already up. @@ -866,7 +968,7 @@ erc-v3--ensure-enabled (memq o others))))) (setq candidates nil) ; break loop (dolist (o (cons cap (erc-v3--deps-gather-dependents cap test))) - (erc-v3--transition o 'm-err) + (erc-v3--transition o erc-v3--event-mERR) (let ((mode (get (erc-v3--extension-canon o) 'erc-v3--extension-minor-mode))) (erc-button--display-error-notice-with-keys @@ -903,7 +1005,7 @@ erc-v3--ensure-disabled ;; This can happen if an active extension is DEL'd by the ;; server and its "disable body" signals. (error - (erc-v3--transition o 'm-err) + (erc-v3--transition o erc-v3--event-mERR) (erc-button--display-error-notice-with-keys "Failed to disable %s properly: %S. ERC is now out of sync with" " the server and cannot recover." @@ -911,7 +1013,7 @@ erc-v3--ensure-disabled (progn (delete-process erc-server-process) " Disconnecting...") "Recommend issuing a /QUIT and investigating.") mode err))) - (erc-v3--transition o 'm-ok))))) + (erc-v3--transition o erc-v3--event-mOK))))) ;; ACK handling is complicated ;; @@ -927,35 +1029,39 @@ erc-v3--ensure-disabled (defun erc-v3--consider-answered () "Run subcommand handlers and perform mode (de)activation. -Only do the latter if all queues are empty." +Only do the latter if all queues are empty, and do nothing if all +outstanding \"REQ\"s haven't all been accounted for." ;; Start a new deadline for processing ACKs. - (erc-v3--run-timer 'w-err erc-v3--sync-timeout-seconds) - (dolist (item (erc-v3--caps-queue-in erc-v3--caps)) - (funcall (pcase-exhaustive (car item) - ('s-ack #'erc-v3--subcmd-ACK) - ('s-nak #'erc-v3--subcmd-NAK)) - (cdr item))) - (setf (erc-v3--caps-queue-in erc-v3--caps) nil) - ;; Check that handlers haven't suspended processing to conduct - ;; external business, such as SASL or `extended-isupport'. - (unless (seq-some #'erc-v3--queued-p (erc-v3--caps-queue-out erc-v3--caps)) - ;; Disable negated and DEL'd caps after disabling their dependents. - (when-let* ((down (erc-v3--caps-by-action 'down))) - (erc-v3--ensure-disabled down)) - ;; Enable all other caps after their dependencies. - (when-let* ((up (erc-v3--caps-by-action 'up))) - (erc-v3--ensure-enabled up)))) - -(defun erc-v3--check-answered (alist event) - "Enqueue caps in ALIST for current \"ACK\" or \"NAK\" EVENT. -Return non-nil if all outstanding \"REQ\"s have been accounted for." - (pcase-dolist (`(,k . ,_) alist) - (let ((o (erc-v3--find-capability-by-key k))) - (cl-assert (or (eq (erc-v3--cap-negated-p k) (erc-v3--unwanted-p o)) - (erc-v3--error-p o))) - (cl-assert (eq 'qin (erc-v3--transition o event))))) - (null (seq-some (lambda (o) (eq 'send (erc-v3--extension-action o))) - (erc-v3--caps-objects erc-v3--caps)))) + (unless (seq-some (lambda (o) (eq erc-v3--phase-SEND + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps)) + (erc-v3--run-timer erc-v3--event-wERR erc-v3--sync-timeout-seconds) + (let ((inhibited ())) + (dolist (item (erc-v3--caps-queue-in erc-v3--caps)) + (funcall (car item) (cdr item)) + ;; Push back if still queued to maintain invariant. + (when (eq erc-v3--phase-QIN (erc-v3--extension-phase (cdr item))) + (push item inhibited))) + (setf (erc-v3--caps-queue-in erc-v3--caps) (nreverse inhibited))) + ;; Check that handlers haven't suspended processing to conduct + ;; external business, such as SASL or `extended-isupport'. + (unless (seq-some #'erc-v3--queued-p (erc-v3--caps-queue-out erc-v3--caps)) + ;; Disable negated and DEL'd caps after disabling their dependents. + (when-let* ((down (erc-v3--caps-by-phase DOWN))) + (erc-v3--ensure-disabled down)) + ;; Enable all other caps after their dependencies. + (when-let* ((up (erc-v3--caps-by-phase UP))) + (erc-v3--ensure-enabled up))))) + +(defun erc-v3--check-answered (subcmd key) + "Enqueue KEY's capability to be enabled on SUBCMD \"ACK\". +Or disabled on \"NAK\"." + (let ((cap (erc-v3--find-capability-by-key key))) + (cl-assert (or (eq (erc-v3--cap-negated-p key) (erc-v3--unwanted-p cap)) + (erc-v3--error-p cap))) + + (cl-assert (eq erc-v3--phase-QIN + (erc-v3--transition cap (erc-v3--subcmd2event subcmd)))))) ;;;; Subcommand handlers @@ -964,29 +1070,6 @@ erc-v3--check-answered ;; because the current design views membership in the objects list as ;; immutable. -(defun erc-v3--dispatch-subcmd (alist parsed subcmd) - "Process SUBCMD taking one or more caps in a terminal argument. -Expect ALIST to be a cons of (KEY . VALUE) where VALUE is a -string or nil and KEY is a symbol representing a capability on -the server. Expect PARSED to be an `erc-response' object." - (pcase-exhaustive subcmd - ('LS (when-let* ((pairs (erc-v3--check-continued alist parsed))) - (erc-v3--mark-offered pairs 's-ls) - (erc-v3--run-subcmds-piecemeal pairs #'erc-v3--subcmd-LS))) - ('ACK (when (erc-v3--check-answered alist 's-ack) - (erc-v3--consider-answered))) - ('NAK (when (erc-v3--check-answered alist 's-nak) - (erc-v3--consider-answered))) - ;; TODO find out if `NEW' can arrive during connection registration. - ('NEW (erc-v3--mark-offered alist 's-new) - (erc-v3--run-subcmds-piecemeal alist #'erc-v3--subcmd-NEW)) - ('DEL (erc-v3--run-subcmds-piecemeal alist #'erc-v3--subcmd-DEL) - (erc-v3--ensure-disabled (erc-v3--caps-by-action 'down))) - ('LIST (when-let* ((pairs (erc-v3--check-continued alist parsed)) - (m (mapcar (lambda (i) (symbol-name (car i))) pairs))) - (erc-display-message parsed 'notice 'active 'CAP-LIST - ?m (string-join m ", ")))))) - ;; If ever switching to blind-REQ style without initial CAP LS, move ;; `erc-v3--ensure-deps' call from this handler to the default ACK ;; method and adjust expected negotiation states accordingly. @@ -1000,15 +1083,15 @@ erc-v3--subcmd-NEW (cl-defmethod erc-v3--subcmd-DEL (capability) "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability 's-del)) + (erc-v3--transition capability erc-v3--event-sDEL)) (cl-defmethod erc-v3--subcmd-ACK (capability) "Handle a \"CAP ACK\" subcommand for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability 'p-in)) + (erc-v3--transition capability erc-v3--event-pIN)) (cl-defmethod erc-v3--subcmd-NAK (capability) "Handle a \"CAP NAK\" subcommand for `erc-v3--capability' CAPABILITY." - (erc-v3--transition capability 'p-in)) + (erc-v3--transition capability erc-v3--event-pIN)) ;;;; ISUPPORT-based extensions @@ -1021,14 +1104,16 @@ erc-v3--subcmd-NAK (defvar erc-v3--isupport-params '((whox . WHOX) (monitor . MONITOR))) (defun erc-v3--check-offered-on-005 (canon param) + "Call handler for extension named CANON with \"ISUPPORT\" PARAM." (when-let* ((item (erc--get-isupport-entry param)) (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) :key #'erc-v3--extension-canon))) (funcall #'erc-v3--on-isupport-param cap (car item) (cdr item)))) (cl-defmethod erc-v3--on-isupport-param (extension _key _value) - (when (eq 'check (erc-v3--transition extension 's-005)) - (unless (eq 'log (erc-v3--ensure-deps extension)) + "Call EXTENSION with \"ISUPPORT\" parameter KEY and VALUE." + (when (eq erc-v3--phase-CHECK (erc-v3--transition extension erc-v3--event-s005)) + (unless (eq erc-v3--phase-LOG (erc-v3--ensure-deps extension)) (erc-v3--ensure-enabled (list extension))))) (cl-defmethod erc--server-005 (_proc _parsed &context (erc-v3-mode (eql t))) @@ -1094,7 +1179,8 @@ erc-v3--multi-prefix-split-flags (defun erc-v3--update-server-user (nick host full-name login account info) "Add or update `erc-server-users' entry with params. -Pass INFO to `erc--ensure-server-user-info' before committing." +Use NICK, HOST, FULL-NAME, LOGIN, and ACCOUNT to init new server user if +needed. Pass INFO to `erc--ensure-server-user-info' before committing." (if-let* ((server-user (erc-get-server-user nick))) (erc-update-user server-user nick host login full-name) (erc-add-server-user nick (make-erc-server-user :nickname nick @@ -1211,11 +1297,6 @@ erc--parse-message-tags (erc-v3--message-tags-unescape-tag-value (decode-coding-string value 'utf-8 t)))))))) -(erc--define-zresponse (TAGMSG) - :include erc--zstatused - ( buffer (erc-get-buffer (erc--zstatused-target parsed) erc-server-process) - :type buffer)) - ;; TODO make this useful. Currently, it just ensures messages don't ;; end up in the server buffer. (define-erc-response-handler (TAGMSG) @@ -1270,7 +1351,8 @@ erc-v3--server-time-display-latest (defvar erc-v3--server-time-display-nested-p nil) (defvar erc-v3--server-time-pulse-late-arrivals-p (not noninteractive)) -(defun erc-v3--find-insertion-point (p target-time) +(defun erc-v3--server-time-find-splice-point (p target-time) + "Scan backwards to find newest message with TARGET-TIME, starting from P." (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) (qq (erc--get-inserted-msg-beg q)) (ts (get-text-property qq 'erc--ts)) @@ -1279,11 +1361,12 @@ erc-v3--find-insertion-point p) (defun erc-v3--server-time-pulse () + "Highlight entire narrowed buffer." (pulse-momentary-highlight-region (point-min) (point-max))) (cl-defmethod erc--insert-line (_ &context (erc-v3--server-time erc-v3--server-time)) - "Insert late-arriving messages up-buffer." + "Insert late-arriving messages earlier in buffer." (if-let* (((null erc--insert-marker)) ((not (buffer-narrowed-p))) ((not erc-v3--server-time-display-nested-p)) @@ -1291,7 +1374,7 @@ erc--insert-line (last-seen erc-v3--server-time-display-latest) ((time-less-p current last-seen)) (p (erc--get-inserted-msg-beg erc-insert-marker)) - (pt (erc-v3--find-insertion-point p current))) + (pt (erc-v3--server-time-find-splice-point p current))) (let ((erc-v3--server-time-display-nested-p t) (erc-insert-post-hook (if (and erc-v3--server-time-pulse-late-arrivals-p @@ -1309,13 +1392,14 @@ erc--insert-line (cl-call-next-method))) (defun erc-v3--current-time-pair () - "Return a lisp time stamp from time tag or call ORIG." + "Return a Lisp time stamp from time tag." (cond ((erc--zresponse-p erc--parsed-response) (erc--zresponse-time erc--parsed-response)) (erc--parsed-response (erc--time-pair-from-time-tag erc--parsed-response)))) (defun erc-v3--server-time-on-phantom-users-mode () + "Perform setup/teardown for server-time extension." (defvar erc-button--phantom-users-mode) (if erc-button--phantom-users-mode (add-function :filter-return (local 'erc--cmem-from-nick-function) @@ -1324,6 +1408,7 @@ erc-v3--server-time-on-phantom-users-mode #'erc-v3--server-time-update-phantom-cmem))) (defun erc-v3--server-time-update-phantom-cmem (cmem) + "Update last-message-time slot of channel-user of CMEM." (when-let* ((cusr (cdr cmem)) ((eq 'erc--phantom-channel-user (aref cusr 0)))) (cl-assert (erc-v3--server-time-p erc-v3--server-time)) @@ -1375,16 +1460,18 @@ erc--send-message-external (defvar erc-v3--echo-message-allow-noncommands-p nil "Allow non-commands, such as /SAY, /SV, etc. to emit labeled messages. -This does not concern original, submitted command lines -themselves but rather replacement text those commands generate, -which is sent via nested calls to `erc--send-input-lines'.") +This flag does not concern original, submitted command lines themselves +but rather replacement text those commands generate, which is sent via +nested calls to `erc--send-input-lines'.") (defun erc-v3--echo-message-inhibit-insert-on-send-message (orig &rest args) + "With `erc-v3--echo-message-allow-noncommands-p', call ORIG function with ARGS. +Otherwise, arrange to do so while suppressing input insertion." (cl-assert erc-v3--echo-message) (if erc-v3--echo-message-allow-noncommands-p (apply orig args) (let ((erc-pre-send-functions (cons #'erc-v3--echo-message-on-pre-send - erc-pre-send-functions))) + (ensure-list erc-pre-send-functions)))) (apply orig args)))) @@ -1457,7 +1544,8 @@ erc-v3--whox-make-request (erc-server-send (concat "WHO " target " %" fields) nil target)))) (defun erc-v3--whox-enqueue (target fields handler) - "Schedule a \"WHO\" request for immediate or deferred sending." + "Schedule a \"WHO\" request for immediate or deferred sending. +Use TARGET, FIELDS, and HANDLER to make a new request object." (let ((existing (erc-v3--whox-requests erc-v3--whox)) (new (make-erc-v3--whox-request :target target :fields fields @@ -1469,7 +1557,8 @@ erc-v3--whox-enqueue (defvar erc-v3--whox-on-354-functions nil) (defun erc-v3--whox-handle-channel-user (parsed parts) - "Update channel user from WHOX reply with fields \"cuhnflar\"." + "Update channel user from PARSED \"WHOX\" reply with fields \"cuhnflar\". +Do so with response parameters PARTS." ;; FIXME explain why `idle' is ignored here. (pcase-let* ((`(,target ,login ,host ,nick ,flags ,_idle ,account) parts) (account (and (not (string= account "0")) account)) @@ -1490,6 +1579,7 @@ erc-v3--whox-handle-channel-user (run-hooks 'erc-v3--whox-on-354-functions)))) (defun erc-v3--request-who-after-mode (_ parsed) + "Schedule a \"WHOX\" request on PARSED \"329\" response." (when-let* ((channel (cadr (erc-response.command-args parsed)))) (erc-with-buffer (channel) (erc-v3--whox-on-join))) @@ -1526,6 +1616,7 @@ erc--server-354 nil) (defun erc-v3--whox-request-delayed (buffer) + "Request a \"WHOX\" query in BUFFER." (with-current-buffer buffer (setf (erc-v3--whox-timer erc-v3--whox) nil) (cl-assert (erc-v3--whox-requests erc-v3--whox)) @@ -1535,7 +1626,8 @@ erc-v3--whox-request-delayed ;; We can't override with an internal method this because it would ;; also run on 318, etc. -(defun erc-v3--whox-handle-315 (_proc parsed ) +(defun erc-v3--whox-handle-315 (_proc parsed) + "Make a \"WHOX\" request from PARSED \"315\" response." (pcase-let* ((`(,_ ,target . ,_) (erc-response.command-args parsed)) (found (cl-find target (erc-v3--whox-req-seen erc-v3--whox) :key #'erc-v3--whox-request-target @@ -1644,6 +1736,7 @@ erc-v3--monitor-exclude-regexp "Pattern to ignore common services and bots you regularly query.") (defun erc-v3--monitor-on-new-query (&rest _) + "Send \"MONITOR\" request when initializing a query buffer." (when (and erc-v3--monitor (erc-query-buffer-p)) (let* ((target (erc-target)) (nickd (erc-downcase target))) @@ -1658,6 +1751,7 @@ erc-v3--monitor-on-new-query (erc-server-send (concat "MONITOR + " target) nil target))))) (defun erc-v3--monitor-forget () + "Send a \"MONITOR\" unsubscribe request when killing a query buffer." (when (erc-query-buffer-p) (let ((target (erc-target))) (when (and erc-server-connected @@ -1674,6 +1768,7 @@ erc-message-english-s730 (defvar erc-message-english-s731 "%n is offline" "English `erc-format-message' template for key `s731'.") +;; FIXME ensure this is unused and delete. (defun erc-v3--monitor-display-online () (cl-assert (erc-query-buffer-p)) (unless (eq 's730 (erc--get-inserted-msg-prop 'erc--msg)) @@ -1720,6 +1815,7 @@ erc-v3--monitor-display-online (erc-display-message parsed 'notice (current-buffer) 's731 ?n nick)) (erc-remove-current-channel-member nick))) + ;; FIXME how can buffer be non-nil if it's the last item in the VARLIST? (unless buffer (cl-assert nickd) (cl-decf (erc-v3--monitor-count erc-v3--monitor)) @@ -1742,8 +1838,11 @@ erc-message-english-JOIN-X ;; Move "MODE #chan" to a hook so modules like chathistory can process ;; JOINs for the client's nick. (defun erc-v3--send-mode-on-join () + "Send a \"MODE\" command for current channel or query." (erc-server-send (concat "MODE " (erc-target)))) +;; FIXME explain who "others" are and what traditional behavior this +;; compatibility flag restores. (defvar erc-v3--create-unknown-channel-buffer-when-others-join-p nil "When non-nil, create a buffer for unknown targets joined by others.") @@ -1764,7 +1863,10 @@ erc--server-JOIN (when (and (null buffer) erc-v3--create-unknown-channel-buffer-when-others-join-p (erc-channel-p chnl)) - (setq buffer (save-excursion (erc--open-target chnl)))) + (setq buffer (let ((erc--display-context + (erc--server-determine-join-display-context + chnl erc--display-context))) + (save-excursion (erc--open-target chnl))))) (when buffer (with-current-buffer buffer (unless (and nickp (erc--target-channel-joined-p erc--target)) @@ -1795,7 +1897,8 @@ erc-message-english-ACCOUNT ;; likely not ideal. (defun erc-v3--update-account (account nick &optional login host) - "Update ACCOUNT field for NICK's `erc-server-user' object." + "Update ACCOUNT field for NICK's `erc-server-user' object. +Use LOGIN and HOST for new server user if needed." (cl-assert (not (string-empty-p account))) (if-let* ((user (erc-get-server-user nick))) (erc-update-user user nil nil nil nil nil account) @@ -1831,6 +1934,7 @@ erc-v3--update-account ;; network. (defun erc-v3--key-resolved-p (key) + "Return non-nil if associated minor mode for KEY is enabled." (and-let* ((o (erc-v3--find-capability-by-key key))) (erc-v3--enabled-p o))) @@ -1855,6 +1959,7 @@ account-tag (remove-hook 'erc-timer-hook #'erc-v3--ensure-account t)))) (defun erc-v3--ensure-account (_) + "Add account info if response is an `erc--zresponse'." (when-let* (((erc--zresponse-p erc--parsed-response)) ((erc-response.tags erc--parsed-response)) (parsed erc--parsed-response)) @@ -1871,8 +1976,7 @@ away-notify "Handle an AWAY message. See also RPL_AWAY 301." nil (pcase-let* ((msg (erc-response.contents parsed)) - (`(,nick ,_login ,_host) - (erc-parse-user (erc-response.sender parsed)))) + (nick (erc-extract-nick (erc-response.sender parsed)))) (when (string-empty-p msg) (setq msg nil)) (erc-update-user-nick nick nil nil nil nil (cons 'away msg) nil)) @@ -1926,6 +2030,7 @@ erc-v3--standard-replies-handle ?n (string-join rest " ")))) (defun erc-v3--standard-replies-dispatch (parsed) + "Call method for PARSED standard reply." (pcase-let* ((`(,maybe-cmd ,code . ,rest) (erc-response.command-args parsed)) (command (and (not (equal "*" maybe-cmd)) (intern maybe-cmd))) (code (intern code)) @@ -2022,12 +2127,12 @@ erc-v3--sasl-on-wantedp-init (cl-defmethod erc-v3--subcmd-LS ((cap erc-v3--sasl)) (cl-assert (null erc--target)) - (when (eq 'check (erc-v3--extension-action cap)) + (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) (cl-assert erc-sasl-mode) (let ((val (erc-v3--capability-val cap))) (if (or (null val) (erc-sasl--mechanism-offered-p val)) (cl-call-next-method) - (erc-v3--transition cap 'w-err) + (erc-v3--transition cap erc-v3--event-wERR) (erc-button--display-error-notice-with-keys "Chosen SASL mechanism " (upcase (symbol-name (alist-get 'mechanism erc-sasl--options))) @@ -2045,7 +2150,7 @@ erc-v3--subcmd-LS (cl-defmethod erc-v3--subcmd-ACK ((cap erc-v3--sasl) &context ((bound-and-true-p erc-sasl-mode) (eql v3))) "Suspend negotiation path for CAP and initiate sub-protocol." - (cl-assert (eq 'qin (erc-v3--extension-action cap))) + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) ;; Extend request timer by 10 seconds. (timer-inc-time (erc-v3--caps-timer erc-v3--caps) erc-v3--sync-timeout-seconds) @@ -2084,11 +2189,16 @@ erc--server-903 (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) "Call default finalizer to conclude capability negotiation." (let ((cap (erc-v3--find-capability-by-key 'sasl))) - (cl-assert (eq 'qin (erc-v3--extension-action cap))) - (let ((erc-sasl-mode nil)) ; ensure the default handler runs - (erc-v3--subcmd-ACK cap)) - (erc-v3--consider-answered)) - (erc-v3--finish-negotiating) + ;; FIXME remove assertions once convinced in case some rogue server + ;; sends a 903 for some reason other than to end an SASL subprotocol + ;; dialog. + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + (cl-assert (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (when (and (eq erc-v3--phase-QIN (erc-v3--extension-phase cap)) + (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (let ((erc-sasl-mode nil)) ; ensure the default handler runs + (erc-v3--consider-answered)) + (erc-v3--finish-negotiating))) nil) (defun erc-v3--sasl-finalize-failed () @@ -2096,7 +2206,7 @@ erc-v3--sasl-finalize-failed (let ((o (erc-v3--find-capability-by-key 'sasl))) (cl-assert o) (erc-v3--ensure-disabled (list o)) - (erc-v3--transition o 'w-err))) + (erc-v3--transition o erc-v3--event-wERR))) (cl-defmethod erc--server-902 (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) @@ -2174,7 +2284,7 @@ erc-v3--name-less-p (t (string< a b))))) (defun erc-v3--print-names (parsed channel names disp) - "Insert aggregated implicit \"NAMES\" response into current buffer. + "Insert aggregated PARSED implicit \"NAMES\" response into current CHANNEL. Expect NAMES to be a list of statusted nicks and DISP to be the tally." (add-function :filter-return (local 'erc-button--modify-nick-function) #'erc-button--deemphasize-plebs '((depth . 95))) @@ -2259,7 +2369,8 @@ erc--server-366 ;; These last two handlers are account aware. (cl-defmethod erc--server-900 (_proc parsed &context (erc-v3-mode (eql t))) - "Mark this session's user as being logged in." + "Given `erc-response' PARSED, mark this session's user as being logged in. +Only do so when ERC-V3-MODE is non-nil." (pcase-let* ((`(,nick ,userhost ,account) (erc-response.command-args parsed)) (`(,uh-nick ,login ,host) @@ -2318,7 +2429,7 @@ erc-v3--format-prefix 'help-echo "voice")))))) (defun erc-v3--assemble-server-user-info-string (user) - "Format an informative string to display in the echo area. + "Format an informative string for USER to display in the echo area. This is basically what `erc-nick-at-point' shows but with some extra info." (let ((away-msg (erc--server-user-away-p user))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 75d88cca9a0..96a4abdecad 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -549,8 +549,18 @@ erc--casemapping-rfc1459 (defun erc-add-server-user (nick user &optional info) "This function is for internal use only. -Optionally massage INFO with a la carte updates and deletions. -Adds USER with nickname NICK to the `erc-server-users' hash table." +Add `erc-server-user' USER with string NICK to `erc-server-users'. +Ensure slots login, host, full-name, and account in USER are nil instead +of the empty string. Optionally massage INFO with a la carte updates +and deletions." + (when (string-empty-p (erc-server-user-login user)) + (setf (erc-server-user-login user) nil)) + (when (string-empty-p (erc-server-user-host user)) + (setf (erc-server-user-host user) nil)) + (when (string-empty-p (erc-server-user-full-name user)) + (setf (erc-server-user-full-name user) nil)) + (when (member (erc-server-user-account user) '("" "*")) + (setf (erc-server-user-account user) nil)) (erc-with-server-buffer (when info (erc--ensure-server-user-info user info)) @@ -7345,18 +7355,14 @@ erc-update-user "Update user info for USER. Replace slot values in in USER, an `erc-server-user' struct, with NEW-NICK, HOST, LOGIN, FULL-NAME, and ACCOUNT if non-nil and not -`equal'. +`equal'. If HOST, LOGIN, FULL-NAME, or ACCOUNT are an empty string, set +the slot to nil. Do so as well if ACCOUNT is a string containing a lone +asterisk. -Note that when a user re-nicks, the `erc-server-user' entry for -their original nick is updated in place. For example, messages -from \"Alice\" will show contextual info for their new nick, -\"Bob\", since they're the same person. Though confusing, this -is deliberate. - -In addition to being a replacement for an `erc-server-user-info' -slot, INFO can also be a single cons pair indicating a member of -the existing `info' field to update. In such cases, a nil CDR -will cause the member to be deleted. +In addition to being a complete replacement for the object's info slot, +INFO can also be a single cons pair indicating a member of the existing +`info' field to update. In such cases, a nil CDR will cause the member +to be deleted. If, and only if, a change is made, `erc-channel-members-changed-hook' is run for each channel for @@ -7371,16 +7377,19 @@ erc-update-user (when (and host (not (equal (erc-server-user-host user) host))) (setq changed t) - (setf (erc-server-user-host user) host)) + (setf (erc-server-user-host user) + (and (not (string-empty-p host)) host))) (when (and login (not (equal (erc-server-user-login user) login))) (setq changed t) - (setf (erc-server-user-login user) login)) + (setf (erc-server-user-login user) + (and (not (string-empty-p login)) login))) (when (and full-name (not (equal (erc-server-user-full-name user) full-name))) (setq changed t) - (setf (erc-server-user-full-name user) full-name)) + (setf (erc-server-user-full-name user) + (and (not (string-empty-p full-name)) full-name))) (when (and info (not (equal (erc-server-user-info user) info))) (setq changed t) @@ -7390,10 +7399,9 @@ erc-update-user ;; Don't report a change when unset and already nil (or (not (equal account "*")) (erc-server-user-account user))) - (cl-assert (not (string-empty-p account))) (setq changed t) (setf (erc-server-user-account user) - (and (not (equal "*" account)) account))) + (and (not (member account '("" "*"))) account))) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) diff --git a/test/lisp/erc/erc-v3-tests.el b/test/lisp/erc/erc-v3-tests.el index 99f8f35d923..8f93871703d 100644 --- a/test/lisp/erc/erc-v3-tests.el +++ b/test/lisp/erc/erc-v3-tests.el @@ -80,28 +80,36 @@ erc-v3--state-Si-Wo-Me-Pa (defconst erc-v3--state-Si-Wo-Mo-Po (make-symbol "Si-Wo-Mo-Po")) (defconst erc-v3--state-Si-Wo-Mo-Py (make-symbol "Si-Wo-Mo-Py")) +(defconst erc-v3--event-wOFF (make-symbol "wOFF")) + ;; This addendum to the main table shows that user code could decide to -;; override an "up" action, which normally effects a local Mo -> Mi +;; override an "UP" phase, which normally effects a local Mo -> Mi ;; component change, and still continue a well-behaved protocol flow by ;; telling the server to sync down. ;; -;; Note that this and other tests introduce a made-up "w-off" event, +;; Note that this and other tests introduce a made-up "wOFF" event, ;; which means that the extension was declared unwanted externally. (defvar erc-v3-tests--preempt-up-edges `((,erc-v3--state-Si-Wi-Mo-Pa - (w-off ,erc-v3--state-Si-Wo-Mo-Py qout)) + (,erc-v3--event-wOFF ,erc-v3--state-Si-Wo-Mo-Py ,erc-v3--phase-QOUT)) (,erc-v3--state-Si-Wo-Mo-Py - (p-out ,erc-v3--state-Si-Wo-Mo-Po send)) + (,erc-v3--event-pOUT ,erc-v3--state-Si-Wo-Mo-Po ,erc-v3--phase-SEND)) (,erc-v3--state-Si-Wo-Mo-Po - (s-ack ,erc-v3--state-Sa-Wo-Mo-Py qin) ; queue good REQ- sync - (s-nak ,erc-v3--state-Si-We-Mo-Py qin) ; queue rejected REQ- log - (p-err ,erc-v3--state-Si-Wo-Me-Pa log)) ; timeout REQ- + (,erc-v3--event-sACK ,erc-v3--state-Sa-Wo-Mo-Py + ,erc-v3--phase-QIN) ; queue good REQ- sync + (,erc-v3--event-sNAK ,erc-v3--state-Si-We-Mo-Py + ,erc-v3--phase-QIN) ; queue rejected REQ- log + (,erc-v3--event-pERR ,erc-v3--state-Si-Wo-Me-Pa + ,erc-v3--phase-LOG)) ; timeout REQ- (,erc-v3--state-Sa-Wo-Mo-Py - (p-in ,erc-v3--state-Sa-Wo-Mo-Pa pass)) ; good REQ- from w-off + (,erc-v3--event-pIN ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS)) ; good REQ- from wOFF (,erc-v3--state-Si-We-Mo-Py - (p-in ,erc-v3--state-Si-We-Mo-Pa log)) ; rejected REQ- for ^ + (,erc-v3--event-pIN ,erc-v3--state-Si-We-Mo-Pa + ,erc-v3--phase-LOG)) ; rejected REQ- for ^ (,erc-v3--state-Sa-Wo-Mo-Pa ; unrelated to main path above - (w-on ,erc-v3--state-Sa-Wi-Mo-Py qout)))) ; made wanted during check + (,erc-v3--event-wON ,erc-v3--state-Sa-Wi-Mo-Py + ,erc-v3--phase-QOUT)))) ; made wanted during check ;; This simulates an ISUPPORT-based extension already enabled ;; successfully now becoming unwanted because a better offer arrives, @@ -109,12 +117,14 @@ erc-v3-tests--preempt-up-edges ;; functionality. (defvar erc-v3-tests--make-unwanted-edges ;; Disabling of enabled non-cap extension - `((,erc-v3--state-Sa-Wi-Mi-Pu - (w-off ,erc-v3--state-Sa-Wo-Mi-Pu down)) ; e.g., better offer made + `((,erc-v3--state-Sa-Wi-Mi-Pu ; e.g., better offer made + (,erc-v3--event-wOFF ,erc-v3--state-Sa-Wo-Mi-Pu ,erc-v3--phase-DOWN)) ;; Mode deactivation for non-cap extension (,erc-v3--state-Sa-Wo-Mi-Pu - (m-ok ,erc-v3--state-Sa-Wo-Mo-Pu pass) ; mode down success - (m-err ,erc-v3--state-Sa-Wo-Me-Pu log)))) ; mode down failure + (,erc-v3--event-mOK ,erc-v3--state-Sa-Wo-Mo-Pu + ,erc-v3--phase-PASS) ; mode deactivation success + (,erc-v3--event-mERR ,erc-v3--state-Sa-Wo-Me-Pu + ,erc-v3--phase-LOG)))) ; mode deactivation failure (defun erc-v3-tests--modify-edges (additions &optional graph) "Splice new ADDITIONS into transition GRAPH, returning a copy." @@ -130,7 +140,9 @@ erc-v3-tests--slots (mapcar (lambda (o) (mapcar (lambda (slot) (let ((v (cl-struct-slot-value (type-of o) slot o))) - (if (eq slot 'state) (intern (symbol-name v)) v))) + (if (memq slot '(state event phase)) + (intern (symbol-name v)) + v))) slots)) (or objects (erc-v3--caps-objects erc-v3--caps)))) @@ -268,9 +280,9 @@ erc-v3--ensure-enabled erc-v3--test/b nil erc-v3--test/c nil erc-v3--test/d nil - (erc-v3--extension-action b) 'up - (erc-v3--extension-action c) 'up - (erc-v3--extension-action d) 'up + (erc-v3--extension-phase b) erc-v3--phase-UP + (erc-v3--extension-phase c) erc-v3--phase-UP + (erc-v3--extension-phase d) erc-v3--phase-UP (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mo-Pa (erc-v3--extension-state c) erc-v3--state-Si-Wi-Mo-Pa (erc-v3--extension-state d) erc-v3--state-Si-Wi-Mo-Pa))) @@ -293,7 +305,7 @@ erc-v3--ensure-enabled (funcall reset) (setq erc-v3--test/b b) (setf (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mi-Pa - (erc-v3--extension-action b) 'pass) + (erc-v3--extension-phase b) erc-v3--phase-PASS) (erc-v3--ensure-enabled (list b c d)) (funcall assert-common) (should (equal calls '(test/d test/c)))))) @@ -583,11 +595,6 @@ erc-v3--merge-client-tags :params (alist-get 'params atoms)) want))))))) -(ert-deftest erc-v3--partition-cap-tokens () - (let ((parts '("a" "b=x" "-c" "d" "e" "f=y"))) - (should (equal (erc-v3--partition-cap-tokens parts) - '((a) (b . "x") (-c) (d) (e) (f . "y")))))) - (ert-deftest erc--server-CAP/continued-LIST () (erc-tests-common-make-server-buf (buffer-name)) (cl-letf* ((calls ()) @@ -602,19 +609,25 @@ erc--server-CAP/continued-LIST (erc-tests-common-simulate-line ":irc.example.org CAP * LIST * :test/a test/b") (should-not calls) - (should (erc-v3--caps-continued erc-v3--caps)) (should (equal (erc-v3--caps-continued erc-v3--caps) - '((test/a) (test/b))))) + '("test/a test/b")))) + + (ert-info ("Processing deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST * :test/c") + (should-not calls) + (should (equal (erc-v3--caps-continued erc-v3--caps) + '("test/c" "test/a test/b")))) (ert-info ("Printed message includes earlier response") (erc-tests-common-simulate-line - ":irc.example.org CAP * LIST :test/c") + ":irc.example.org CAP * LIST :test/d") (should-not calls) (should-not (erc-v3--caps-continued erc-v3--caps)) - (should-not (erc-v3--caps-continued erc-v3--caps)) - (goto-char (point-min)) - (should (search-forward "Enabled CAPs: test/a, test/b, test/c" nil t)))) + (should (search-forward "Enabled CAPs: test/a, test/b," nil t)) + (should (search-forward "test/c," nil t)) + (should (search-forward "test/d" nil t)))) (erc-tests-common-kill-buffers)) @@ -649,9 +662,9 @@ erc--server-CAP/no-request/post-registration ":irc.example.org CAP * NEW :test/a test/b") ;; Advertised caps are shown as OFFERED. - (should (equal (erc-v3-tests--slots '(canon state action)) - '((test/a Sa-Wo-Mo-Pa track) - (test/b Sa-Wo-Mo-Pa track)))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) ;; Request queue empty because no common extensions. (should-not (funcall get-calls)))))) @@ -667,14 +680,15 @@ erc--server-CAP/no-request/registration (cl-letf (((erc-v3--caps-negotiated-p erc-v3--caps) nil)) (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/a test/b") - (should (equal (erc-v3-tests--slots '(canon state action)) - '((test/a Sa-Wo-Mo-Pa track) - (test/b Sa-Wo-Mo-Pa track)))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) (should (equal (funcall get-calls) '(("CAP END")))) (should (erc-v3--caps-negotiated-p erc-v3--caps)))))) ;; This demos basic 302 capability negotiation, including -;; post-registration. +;; post-registration. It includes some aberrant server behavior +;; regarding the NEW subcommand. (ert-deftest erc--server-CAP/pre-and-post-registration () (erc-tests-common-make-server-buf) (defvar cl-struct-erc-v3--extension-tags) @@ -693,26 +707,26 @@ erc--server-CAP/pre-and-post-registration (ert-info ("Handlers inert when continuation line arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * LS * :test/a test/b") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a nil) (test/b init) - (test/c nil) (test/d init) (test/e init))))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a nil) (test/b INIT) + (test/c nil) (test/d INIT) (test/e INIT))))) (ert-info ("Handlers run when terminating line arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/c test/d") (should-not (erc-v3--caps-continued erc-v3--caps)) (should (equal (pop calls) '("CAP REQ :test/b test/d"))) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a track) (test/b send) (test/c track) - (test/d send) (test/e init)))) ; never arrives + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b SEND) (test/c TRACK) + (test/d SEND) (test/e INIT)))) ; never arrives (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) (ert-info ("All ACKs for arrive, extensions enabled, END sent") (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/b test/d") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a track) (test/b run) (test/c track) - (test/d run) (test/e init)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e INIT)))) ;; Minor modes enabled. (should erc-v3--test/b) (should erc-v3--test/d) @@ -720,31 +734,34 @@ erc--server-CAP/pre-and-post-registration (should (erc-v3--caps-negotiated-p erc-v3--caps)) (should-not calls)) + ;; XXX a server re-advertising an enabled cap in a NEW, much less + ;; changing its associated value, is unlikely. (ert-info ("NEW offer arrives after connection registration") (erc-tests-common-simulate-line ":irc.example.org CAP * NEW :test/e test/b=foo") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a track) (test/b run) (test/c track) (test/d run) - (test/e send)))) ; b already enabled + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) (test/d RUN) + (test/e SEND)))) ; b already enabled (should (equal (pop calls) '("CAP REQ :test/e"))) (should-not calls) (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/e") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a track) (test/b run) (test/c track) - (test/d run) (test/e run)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e RUN)))) (should erc-v3--test/e) (should-not calls)) (ert-info ("DEL arrives indicating cap b no longer supported") (should erc-v3--test/b) ; test/b extension enabled + (should (equal "foo" (erc-v3--capability-val erc-v3--test/b))) (erc-tests-common-simulate-line ":irc.example.org CAP * DEL :test/b test/a") ; no longer supported ;; A and B marked as Su (server unknown). - (should (equal (erc-v3-tests--slots '(canon state action)) - '((test/a Su-Wo-Mo-Pa pass) (test/b Su-Wi-Mo-Pa pass) - (test/c Sa-Wo-Mo-Pa track) (test/d Si-Wi-Mi-Pa run) - (test/e Si-Wi-Mi-Pa run)))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Su-Wo-Mo-Pa PASS) (test/b Su-Wi-Mo-Pa PASS) + (test/c Sa-Wo-Mo-Pa TRACK) (test/d Si-Wi-Mi-Pa RUN) + (test/e Si-Wi-Mi-Pa RUN)))) (should-not calls) (should (erc-v3--caps-negotiated-p erc-v3--caps)) (should-not erc-v3--test/b))) @@ -760,7 +777,7 @@ erc-v3--subcmd-LS (cl-defmethod erc-v3--subcmd-LS ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/subcmd-handlers))) - (should (eq 'check (erc-v3--extension-action o))) + (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) (push 'a erc-v3-tests--calls) (cl-call-next-method)) @@ -768,8 +785,8 @@ erc-v3--subcmd-LS (cl-defmethod erc-v3--subcmd-LS ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/subcmd-handlers))) - (should (eq 'check (erc-v3--extension-action o))) - (erc-v3--transition o 'w-off) + (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) + (erc-v3--transition o erc-v3--event-wOFF) (push 'c erc-v3-tests--calls) (cl-call-next-method)) @@ -784,7 +801,9 @@ erc--server-CAP/subcmd-handlers (erc-v3-extensions '(test/a test/c)) (erc-v3--edges (erc-v3-tests--modify-edges `((,erc-v3--state-Sa-Wi-Mo-Pa - (w-off ,erc-v3--state-Sa-Wo-Mo-Pa pass))))) + (,erc-v3--event-wOFF + ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS))))) (cl-struct-erc-v3--extension-tags '( erc-v3--test/a erc-v3--test/b erc-v3--test/c erc-v3--extension erc-v3--capability)) @@ -797,16 +816,16 @@ erc--server-CAP/subcmd-handlers (erc-tests-common-simulate-line ":irc.example.org CAP * LS * :test/a test/c") (should-not erc-v3-tests--calls) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a init) (test/b nil) (test/c init))))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil) (test/c INIT))))) (ert-info ("Handlers run and requests sent") (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/b") - (should (equal (erc-v3-tests--slots '(canon state action)) - '((test/a Sa-Wi-Mo-Pi send) - (test/b Sa-Wo-Mo-Pa track) - (test/c Sa-Wo-Mo-Pa pass)))) ; manually disabled + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wi-Mo-Pi SEND) + (test/b Sa-Wo-Mo-Pa TRACK) + (test/c Sa-Wo-Mo-Pa PASS)))) ; manually disabled ;; The LS handler for test/c effectively negates the configuration ;; expressed by `erc-v3-extensions'. (should (equal erc-v3-tests--calls @@ -820,7 +839,7 @@ erc-v3--subcmd-ACK ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/NAK-made-unwanted))) (cl-call-next-method) - (should (eq 'up (erc-v3--extension-action o))) + (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) (should (erc-v3--wanted-p o)) (push (erc-v3--extension-canon o) erc-v3-tests--calls)) @@ -828,7 +847,7 @@ erc-v3--subcmd-ACK ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/NAK-made-unwanted))) (cl-call-next-method) - (should (eq 'up (erc-v3--extension-action o))) + (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) (should (erc-v3--wanted-p o)) (push (erc-v3--extension-canon o) erc-v3-tests--calls)) @@ -836,7 +855,7 @@ erc-v3--subcmd-NAK ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/NAK-made-unwanted))) (cl-call-next-method) - (should (eq 'log (erc-v3--extension-action o))) + (should (eq erc-v3--phase-LOG (erc-v3--extension-phase o))) (should-not (erc-v3--wanted-p o)) (push (erc-v3--extension-canon o) erc-v3-tests--calls)) @@ -857,21 +876,21 @@ erc--server-CAP/NAK-made-unwanted (erc-v3-mode +1) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a init) (test/b init) (test/c init)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b INIT) (test/c INIT)))) (ert-info ("LS arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/a test/b test/c") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a send) (test/b send) (test/c send)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c SEND)))) (should (equal (pop calls) '("CAP REQ :test/a test/b test/c"))) (should-not calls)) (ert-info ("ACK 1 arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/c") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a send) (test/b send) (test/c qin)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c QIN)))) ;; Extension not activated because outstanding REQs. (should-not erc-v3--test/c) (should-not erc-v3-tests--calls) @@ -879,8 +898,8 @@ erc--server-CAP/NAK-made-unwanted (ert-info ("ACK 2 arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/a") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a qin) (test/b send) (test/c qin)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a QIN) (test/b SEND) (test/c QIN)))) (should-not erc-v3-tests--calls) (should-not calls) (should-not erc-v3--test/c) ; still missing reply for test/b @@ -888,8 +907,8 @@ erc--server-CAP/NAK-made-unwanted (ert-info ("NAK arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * NAK :test/b") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a run) (test/b log) (test/c run)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a RUN) (test/b LOG) (test/c RUN)))) (should erc-v3--test/c) (should (equal calls '(("CAP END")))) (should (equal erc-v3-tests--calls '(test/c test/a test/b))))) @@ -900,8 +919,8 @@ erc-v3--subcmd-ACK ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/preempted-ACK))) (cl-call-next-method) - (if (eq 'up (erc-v3--extension-action o)) - (erc-v3--transition o 'w-off) + (if (eq erc-v3--phase-UP (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wOFF) (should-not (erc-v3--enabled-p o)) (should-not (erc-v3--wanted-p o))) (push (erc-v3--extension-canon o) erc-v3-tests--calls)) @@ -910,8 +929,8 @@ erc-v3--subcmd-LS ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) (eql erc--server-CAP/preempted-ACK))) (cl-call-next-method) - (if (eq 'track (erc-v3--extension-action o)) - (erc-v3--transition o 'w-on) + (if (eq erc-v3--phase-TRACK (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wON) (should-not (erc-v3--enabled-p o)) (should-not (erc-v3--wanted-p o))) (push (erc-v3--extension-canon o) erc-v3-tests--calls)) @@ -939,8 +958,8 @@ erc--server-CAP/preempted-ACK (erc-v3-mode +1) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a init) (test/b nil)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil)))) (ert-info ("LS arrives, REQ sent") (erc-tests-common-simulate-line @@ -948,8 +967,8 @@ erc--server-CAP/preempted-ACK (should-not (erc-v3--caps-continued erc-v3--caps)) (should (equal (pop calls) '("CAP REQ :test/a test/b"))) (should (equal erc-v3-tests--calls '(test/b))) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a send) (test/b send)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND)))) (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) (ert-info ("ACK arrives, handler reconsiders, preempts END") @@ -960,8 +979,8 @@ erc--server-CAP/preempted-ACK ":irc.example.org CAP * ACK :test/a test/b") (should (equal (pop calls) '("CAP REQ :-test/a"))) (should-not calls) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a send) (test/b up)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b UP)))) ;; Other ACKs for this round also deferred until no REQs remain. (should-not erc-v3--test/a) (should-not erc-v3--test/b) @@ -972,8 +991,8 @@ erc--server-CAP/preempted-ACK ;; Simulate a reply instigated by overriding handler. (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :-test/a") - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a pass) (test/b run)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) (should (erc-v3--caps-negotiated-p erc-v3--caps)) (should-not erc-v3--test/a) ; remains disabled (should erc-v3--test/b) ; activated @@ -986,8 +1005,8 @@ erc--server-CAP/preempted-ACK (erc-tests-common-simulate-line ":irc.example.org CAP * DEL :test/a") (should-not erc-v3--test/a) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/a pass) (test/b run)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) (should (erc-v3--caps-negotiated-p erc-v3--caps)) (should-not calls))) @@ -1009,16 +1028,16 @@ erc--server-CAP/mode-activation-failure (erc-v3-mode +1) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/m init) (test/m-1 init)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m INIT) (test/m-1 INIT)))) (ert-info ("LS arrives, REQ sent") (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/m test/m-1") (should-not (erc-v3--caps-continued erc-v3--caps)) (should (equal (pop calls) '("CAP REQ :test/m test/m-1"))) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/m send) (test/m-1 send)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) (ert-info ("ACK arrives, mode activation fails, REQ- sent") @@ -1028,8 +1047,8 @@ erc--server-CAP/mode-activation-failure ":irc.example.org CAP * ACK :test/m test/m-1")) (should (equal (pop calls) '("CAP REQ :-test/m -test/m-1"))) (should-not calls) - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/m send) (test/m-1 send)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) ;; Disabling the mode appears to have worked. (should-not erc-v3--test/m) (should-not erc-v3--test/m-1) @@ -1039,8 +1058,8 @@ erc--server-CAP/mode-activation-failure (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :-test/m -test/m-1") ;; Error message is inserted when interactive. - (should (equal (erc-v3-tests--slots '(canon action)) - '((test/m log) (test/m-1 log)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m LOG) (test/m-1 LOG)))) (should (erc-v3--caps-negotiated-p erc-v3--caps)) (should-not erc-v3--test/m) (should (equal calls '(("CAP END")))))) @@ -1062,7 +1081,7 @@ erc--server-CAP/mode-deactivation-failure (erc-v3-mode +1) - (should (equal (erc-v3-tests--slots '(canon action)) '((test/n init)))) + (should (equal (erc-v3-tests--slots '(canon phase)) '((test/n INIT)))) (ert-info ("LS arrives, REQ sent, ACK arrives") (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/n") @@ -1078,8 +1097,8 @@ erc--server-CAP/mode-deactivation-failure (with-silent-modifications (erc-tests-common-simulate-line ":irc.example.org CAP * DEL :test/n"))) - (should (equal (erc-v3-tests--slots '(canon state action)) - '((test/n Su-Wi-Me-Pa log)))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/n Su-Wi-Me-Pa LOG)))) (should-not calls) (should-not erc-v3--test/b))) @@ -1307,8 +1326,8 @@ erc-server-354--whox (erc-tests-common-simulate-line ":irc.foonet.org 005 tester PREFIX=(qaohv)~&@%+ WHOX=390 :supported") (should erc-v3--whox) - (should (equal (erc-v3-tests--slots '(canon action)) - '((multi-prefix run) (whox run)))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((multi-prefix RUN) (whox RUN)))) ;; Simulate outgoing request for members in #chan. (push (make-erc-v3--whox-request -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.7-Remove-some-forward-declarations-from-ERC-tests.patch From 449ef6c64db2cfec0f080311f53859d6b49c7cf5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 16 Sep 2025 18:43:58 -0700 Subject: [PATCH 01/17] [5.7] ; Remove some forward declarations from ERC tests * lisp/erc/erc.el (erc--insert-before-markers-transplanting-hidden): Fix what's almost certainly a typo since the return value is undefined. * test/lisp/erc/erc-scenarios-join-display-context.el: Require `erc-join'. * test/lisp/erc/erc-scenarios-log.el: Remove forward declares and require `erc-stamp'. * test/lisp/erc/erc-scenarios-services-misc.el: Require `erc-services'. * test/lisp/erc/erc-tests.el (erc-tests--modules): Reflow into single column for easier management of divergent WIP patch sets, which should help minimize manual surgery when later applying them atop each other. * test/lisp/erc/resources/erc-scenarios-common.el: Remove unused requires and declarations from top of file. (erc-scenarios-common-with-cleanup): Generate local defvars in test scope for likely unloaded user options. (erc-scenarios-common--assert-date-stamps): Don't run when erc-stamp isn't loaded. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-make-server-buf): Accept a buffer for the NAME arg. --- lisp/erc/erc.el | 3 +- .../erc/erc-scenarios-join-display-context.el | 2 + test/lisp/erc/erc-scenarios-log.el | 6 +- test/lisp/erc/erc-scenarios-services-misc.el | 3 +- test/lisp/erc/erc-tests.el | 45 +++++++- .../erc/resources/erc-scenarios-common.el | 103 +++++++++--------- test/lisp/erc/resources/erc-tests-common.el | 2 +- 7 files changed, 100 insertions(+), 64 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6ebb137311b..2fb6570ad88 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3724,7 +3724,8 @@ erc--insert-before-markers-transplanting-hidden (new (and before (erc--solo (cl-intersection b a))))) (when new (erc--remove-from-prop-value-list (1- (point)) (point) 'invisible a)) - (prog1 (insert-before-markers string) + (progn + (insert-before-markers string) (when new (erc--merge-prop (1- (point)) (point) 'invisible new))))) diff --git a/test/lisp/erc/erc-scenarios-join-display-context.el b/test/lisp/erc/erc-scenarios-join-display-context.el index 0e1bb2b081d..3e57cd16986 100644 --- a/test/lisp/erc/erc-scenarios-join-display-context.el +++ b/test/lisp/erc/erc-scenarios-join-display-context.el @@ -26,6 +26,8 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) +(require 'erc-join) + (ert-deftest erc-scenarios-join-display-context--errors () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup diff --git a/test/lisp/erc/erc-scenarios-log.el b/test/lisp/erc/erc-scenarios-log.el index 3c95018dd26..d06613b9066 100644 --- a/test/lisp/erc/erc-scenarios-log.el +++ b/test/lisp/erc/erc-scenarios-log.el @@ -28,8 +28,7 @@ (require 'erc-log) (require 'erc-truncate) - -(defvar erc-timestamp-format-left) +(require 'erc-stamp) (ert-deftest erc-scenarios-log--kill-hook () :tags '(:expensive-test) @@ -327,9 +326,6 @@ erc-scenarios-log--truncate/left-stamps (funcall expect 1 "loathed enemy") (funcall expect -0.001 "please your lordship"))))) -(defvar erc-insert-timestamp-function) -(declare-function erc-insert-timestamp-left "erc-stamp" (string)) - (ert-deftest erc-scenarios-log--save-buffer-in-logs/truncate-on-save () :tags '(:expensive-test) (with-suppressed-warnings ((obsolete erc-truncate-buffer-on-save)) diff --git a/test/lisp/erc/erc-scenarios-services-misc.el b/test/lisp/erc/erc-scenarios-services-misc.el index 13d66a54d3a..1c6222fcddd 100644 --- a/test/lisp/erc/erc-scenarios-services-misc.el +++ b/test/lisp/erc/erc-scenarios-services-misc.el @@ -24,8 +24,7 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) -(eval-when-compile (require 'erc-join) - (require 'erc-services)) +(require 'erc-services) (ert-deftest erc-scenarios-services-password () :tags '(:expensive-test) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2279496e600..4997199a7ea 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3521,12 +3521,45 @@ erc-channel-user (should (= 0 (erc-channel-user-status u)))))) (defconst erc-tests--modules - '( autoaway autojoin bufbar button capab-identify - command-indicator completion dcc fill identd - imenu irccontrols keep-place list log match menu move-to-prompt netsplit - networks nickbar nicks noncommands notifications notify page readonly - replace ring sasl scrolltobottom services smiley sound - spelling stamp track truncate unmorse xdcc)) + '(autoaway + autojoin + bufbar + button + capab-identify + command-indicator + completion + dcc + fill + identd + imenu + irccontrols + keep-place + list log + match + menu + move-to-prompt + netsplit + networks + nickbar + nicks + noncommands + notifications + notify + page + readonly + replace + ring + sasl + scrolltobottom + services + smiley + sound + spelling + stamp + track + truncate + unmorse + xdcc)) ;; Ensure that `:initialize' doesn't change the ordering of the ;; members because otherwise the widget's state is "edited". diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index ce7595363c9..c2453e93616 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -93,13 +93,6 @@ (require 'erc) -(eval-when-compile (require 'erc-join) - (require 'erc-services) - (require 'erc-fill)) - -(declare-function erc-network "erc-networks") -(defvar erc-network) - (defvar erc-scenarios-common--resources-dir (expand-file-name "../" (ert-resource-directory))) @@ -149,7 +142,8 @@ erc-scenarios-common--print-trace (auth-source-do-cache nil) (timer-list (copy-sequence timer-list)) (timer-idle-list (copy-sequence timer-idle-list)) - (erc-auth-source-parameters-join-function nil) + ;; This binding exists to protect the default value because ERC + ;; adds all joined channels automatically. (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) (erc-after-connect nil) @@ -178,47 +172,56 @@ erc-scenarios-common-with-cleanup (let* ((orig-autojoin-mode (make-symbol "orig-autojoin-mode")) (combined `((,orig-autojoin-mode (bound-and-true-p erc-autojoin-mode)) - ,@(erc-scenarios-common--make-bindings bindings)))) - - `(erc-d-t-with-cleanup (,@combined) - - (ert-info ("Restore autojoin, etc., kill ERC buffers") + ,@(erc-scenarios-common--make-bindings bindings))) + (dynvars ())) + + ;; Declare "erc-" variables dynamic in test scope. + (dolist (binder combined) + (setq binder (ensure-list binder)) + (when (and (string-prefix-p "erc-" (symbol-name (car binder))) + (not (special-variable-p (car binder)))) + (push `(defvar ,(car binder)) dynvars))) + `(progn + ,@dynvars + (erc-d-t-with-cleanup (,@combined) + + (ert-info ("Restore autojoin, etc., kill ERC buffers") + (dolist (buf (buffer-list)) + (when-let* ((erc-d-u--process-buffer) + (proc (get-buffer-process buf))) + (delete-process proc))) + + (erc-scenarios-common--remove-silence) + + (when erc-scenarios-common-extra-teardown + (ert-info ("Running extra teardown") + (funcall erc-scenarios-common-extra-teardown))) + + (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) + (when (and (boundp 'erc-autojoin-mode) + (not (eq erc-autojoin-mode ,orig-autojoin-mode))) + (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) + + (when (or noninteractive erc-scenarios-common--graphical-p) + (when noninteractive + (erc-scenarios-common--print-trace)) + (erc-d-t-kill-related-buffers) + (delete-other-windows))) + + (erc-scenarios-common--add-silence) + + (ert-info ("Wait for dumb server") (dolist (buf (buffer-list)) - (when-let* ((erc-d-u--process-buffer) - (proc (get-buffer-process buf))) - (delete-process proc))) - - (erc-scenarios-common--remove-silence) - - (when erc-scenarios-common-extra-teardown - (ert-info ("Running extra teardown") - (funcall erc-scenarios-common-extra-teardown))) - - (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) - (when (and (boundp 'erc-autojoin-mode) - (not (eq erc-autojoin-mode ,orig-autojoin-mode))) - (erc-autojoin-mode (if ,orig-autojoin-mode +1 -1))) - - (when (or noninteractive erc-scenarios-common--graphical-p) - (when noninteractive - (erc-scenarios-common--print-trace)) - (erc-d-t-kill-related-buffers) - (delete-other-windows))) - - (erc-scenarios-common--add-silence) - - (ert-info ("Wait for dumb server") - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when erc-d-u--process-buffer - (erc-d-t-search-for 3 "Starting"))))) + (with-current-buffer buf + (when erc-d-u--process-buffer + (erc-d-t-search-for 3 "Starting"))))) - (ert-info ("Activate erc-debug-irc-protocol") - (unless (and (or noninteractive erc-scenarios-common--graphical-p) - (not erc-debug-irc-protocol)) - (erc-toggle-debug-irc-protocol))) + (ert-info ("Activate erc-debug-irc-protocol") + (unless (and (or noninteractive erc-scenarios-common--graphical-p) + (not erc-debug-irc-protocol)) + (erc-toggle-debug-irc-protocol))) - ,@body))) + ,@body)))) (defvar erc-scenarios-common--term-size '(34 . 80)) (declare-function term-char-mode "term" nil) @@ -329,9 +332,11 @@ erc-scenarios-common-with-noninteractive-in-term (defun erc-scenarios-common--assert-date-stamps () "Ensure all date stamps are accounted for." - (dolist (stamp erc-stamp--date-stamps) - (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) - 'erc--msg))))) + (defvar erc-stamp--date-stamps) + (when (fboundp 'erc-stamp--date-marker) + (dolist (stamp erc-stamp--date-stamps) + (should (eq 'datestamp (get-text-property (erc-stamp--date-marker stamp) + 'erc--msg)))))) (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 6eddd576bf5..7b1bdb86580 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -119,7 +119,7 @@ erc-tests-common-make-server-buf "Return a server buffer named NAME, creating it if necessary. Use NAME for the network and the session server as well." (with-current-buffer (if name - (get-buffer-create name) + (setq name (buffer-name (get-buffer-create name))) (and (string-search "temp" (buffer-name)) (setq name "foonet") (buffer-name))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.7-Preserve-order-of-local-ERC-modules-for-activati.patch From bb515d1cd15f912f3b1231bbaa1bbf9505acdbc6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 21 Sep 2025 15:52:16 -0700 Subject: [PATCH 02/17] [5.7] Preserve order of local ERC modules for activation * etc/ERC-NEWS: Add new section for ERC 5.7. * lisp/erc/erc.el (erc--update-modules): Reverse returned list. * test/lisp/erc/erc-tests.el (erc--update-modules/local): Update. --- etc/ERC-NEWS | 14 ++++++++++++++ lisp/erc/erc.el | 2 +- test/lisp/erc/erc-tests.el | 2 +- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 513ed8f706d..9f364de591b 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -11,6 +11,20 @@ This file is about changes in ERC, the powerful, modular, and extensible IRC (Internet Relay Chat) client distributed with GNU Emacs since Emacs version 22.1. + +* Changes in ERC 5.7 + +** Changes in the library API. + +*** Local modules activate in preferred order instead of in reverse. +In recent versions, ERC has enabled local modules in the reverse order +of that produced by the "set" function used by 'setopt' and the Custom +UI for the option 'erc-modules'. Specifically, Built-in locals were +activated in reverse lexicographic order after third-party ones, which +were simply reversed as given. Now, just like with global modules, ERC +preserves the preferred order when activating local modules for new +sessions. + * Changes in ERC 5.6.1 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2fb6570ad88..4d1808e2c44 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2426,7 +2426,7 @@ erc--find-mode (defun erc--update-modules (modules) (let (local-modes) - (dolist (module modules local-modes) + (dolist (module modules (nreverse local-modes)) (if-let* ((mode (erc--find-mode module))) (if (custom-variable-p mode) (funcall mode 1) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4997199a7ea..e008551998d 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3781,7 +3781,7 @@ erc--update-modules/local ;; Returns local modules. (should (equal (mapcar #'symbol-name (erc--update-modules erc-modules)) - '("erc-lo2-mode" "erc-lo1-mode"))) + '("erc-lo1-mode" "erc-lo2-mode"))) ;; Requiring `erc-lo2' defines `erc-lo2-mode'. (should (equal (mapcar #'prin1-to-string (funcall get-calls)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.7-Use-speaker-end-marker-in-ERC-insertion-hooks.patch From 391b646a0fc152d2a358e4ef5ed364fb36a6962f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 6 Oct 2024 23:17:40 -0700 Subject: [PATCH 03/17] [5.7] Use speaker-end marker in ERC insertion hooks * lisp/erc/erc-fill.el (erc-fill-wrap): Use `erc--offset-marker' instead of heuristics for finding the beginning of the message proper. * lisp/erc/erc.el (erc--send-action-display): Use `erc--ensure-offset-prop'. (erc--ensure-offset-prop): New function. Only works for `erc--message-speaker-catalog' entries, which all (currently) end in "%m". If any were to gain a "footer" component after their "%m", this would need to be modified, possibly to require an extra `catalog-key' parameter that could then be queried at runtime for a symbol property specifying the footer length as a negative offset. (erc--add-msg-prop): New function. (erc--offset-marker): New variable. (erc--with-offset-marker): New macro. (erc-insert-line): Run insertion hooks in `erc--with-offset-marker'. (erc--determine-speaker-message-format-args) (erc--format-speaker-input-message) (erc-ctcp-query-ACTION): Use `erc--ensure-offset-prop'. In the latter, don't set statusmsg "%s" to the target name. (erc-make-notice): Set `erc--offset' msg prop to the length of the `erc--notice-prefix', which includes a trailing space. Don't do the same for the fallback case of `erc-display-message-highlight' because some format specs contain leading characters that are basically analogs of `erc-notice-prefix'. Examining each prematurely to formulate a guess that may never be used is wasteful, and just going with 0 would sometimes be wrong or destructive, such as on subsequent passes for "compound" `erc-display-message' type parameters specified by `erc-display-error-notice', etc. (erc-display-msg): Run send hooks in `erc--with-offset-marker'. (Bug#73798) --- lisp/erc/erc-fill.el | 20 ++++++++++-------- lisp/erc/erc.el | 48 +++++++++++++++++++++++++++++++++++--------- 2 files changed, 51 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index cbe91861e48..5ae12054a6f 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -707,14 +707,18 @@ erc-fill-wrap (funcall erc-fill--wrap-length-function)) (and-let* ((msg-prop (erc--check-msg-prop 'erc--msg)) ((not (eq msg-prop 'unknown)))) - (when-let* ((e (erc--get-speaker-bounds)) - (b (pop e)) - ((or erc-fill--wrap-action-dedent-p - (not (erc--check-msg-prop 'erc--ctcp - 'ACTION))))) - (goto-char e)) - (skip-syntax-forward "^-") - (forward-char) + (let ((dedentp (or erc-fill--wrap-action-dedent-p + (not (erc--check-msg-prop 'erc--ctcp + 'ACTION))))) + (if (and dedentp erc--offset-marker) + (goto-char erc--offset-marker) + ;; No marker means `datestamp' or refilling via + ;; `erc-fill--wrap-unmerge-on-date-stamp', etc. + (when-let* ((dedentp) + (bounds (erc--get-speaker-bounds))) + (goto-char (cdr bounds))) + (skip-syntax-forward "^-") + (forward-char))) (cond ((eq msg-prop 'datestamp) (when erc-fill--wrap-rejigger-last-message (set-marker erc-fill--wrap-last-msg (point-min))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4d1808e2c44..700fd72f5f7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3196,7 +3196,8 @@ erc--send-action-display (let ((erc-current-message-catalog erc--message-speaker-catalog)) (erc-display-message nil nil (current-buffer) 'ctcp-action-input ?p (erc-get-channel-membership-prefix nick) - ?n (erc--speakerize-nick nick) ?m string))))) + ?n (erc--speakerize-nick nick) + ?m (erc--ensure-offset-prop string)))))) (defun erc--send-action (target string force) "Display STRING, then send to TARGET as a \"CTCP ACTION\" message." @@ -3220,6 +3221,11 @@ erc--ensure-spkr-prop `((erc--spkr . ,nick) ,@overrides ,@erc--msg-prop-overrides)))) nick) +(defun erc--ensure-offset-prop (message) + "Add `erc--offset' msg prop for string MESSAGE." + (erc--add-msg-prop 'erc--offset (- (length message))) + message) + (defun erc-string-invisible-p (string) "Check whether STRING is invisible or not. I.e. any char in it has the `invisible' property set." @@ -3334,6 +3340,13 @@ erc--memq-msg-prop ((consp haystack))) (memq needle haystack))) +(defun erc--add-msg-prop (prop val) + "Add PROP and VAL to `erc--msg-props' or `erc--msg-prop-overrides'." + (cond (erc--msg-props + (puthash prop val erc--msg-props)) + (erc--msg-prop-overrides + (setf (alist-get prop erc--msg-prop-overrides) val)))) + (defmacro erc--get-inserted-msg-beg-at (point at-start-p) (macroexp-let2* nil ((point point) (at-start-p at-start-p)) @@ -3458,6 +3471,20 @@ erc--insert-line-function (defvar erc--insert-marker nil "Internal override for `erc-insert-marker'.") +(defvar erc--offset-marker nil + "Demarcates the header/body partition in a message.") + +(defmacro erc--with-offset-marker (&rest body) + "Run BODY in insertion-narrowed buffer with `erc--offset-marker' present." + `(let ((erc--offset-marker + (and-let* ((offset (erc--check-msg-prop 'erc--offset)) + (side (if (natnump offset) (point-min) (1- (point-max))))) + (remhash 'erc--offset erc--msg-props) + (copy-marker (+ side offset))))) + ,@body + (when erc--offset-marker + (set-marker erc--offset-marker nil)))) + (define-obsolete-function-alias 'erc-display-line-1 'erc-insert-line "30.1") (defun erc-insert-line (string buffer) "Insert STRING in an `erc-mode' BUFFER. @@ -3515,8 +3542,9 @@ erc-insert-line ;; run insertion hook, with point at restored location (save-restriction (narrow-to-region insert-position (point)) - (run-hooks 'erc-insert-modify-hook) - (run-hooks 'erc-insert-post-hook) + (erc--with-offset-marker + (run-hooks 'erc-insert-modify-hook) + (run-hooks 'erc-insert-post-hook)) (when erc-remove-parsed-property (remove-text-properties (point-min) (point-max) '(erc-parsed nil tags nil))) @@ -6444,7 +6472,7 @@ erc--determine-speaker-message-format-args (if inputp 'input-query-notice 'query-notice) (if inputp 'input-chan-notice 'chan-notice)))) ?p (or prefix "") ?n (erc--speakerize-nick nick disp-nick) - ?s (or statusmsg "") ?m message)) + ?s (or statusmsg "") ?m (erc--ensure-offset-prop message))) (defcustom erc-show-speaker-membership-status nil "Whether to prefix speakers with their channel status. @@ -6578,7 +6606,7 @@ erc--format-speaker-input-message (erc--msg-prop-overrides (push (cons 'erc--msg key) erc--msg-prop-overrides))) (erc-format-message key ?p pfx ?n (erc--speakerize-nick nick) - ?m message)) + ?m (erc--ensure-offset-prop message))) (propertize (concat "> " message) 'font-lock-face 'erc-input-face))) (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) @@ -6888,12 +6916,12 @@ erc-ctcp-query-ACTION (if selfp (if stsmsg 'ctcp-action-statusmsg-input 'ctcp-action-input) (if stsmsg 'ctcp-action-statusmsg 'ctcp-action)) - ?s (or stsmsg to) + ?s (or stsmsg "") ?p (or (and (erc-channel-user-p prefix) (erc-get-channel-membership-prefix prefix)) "") ?n (erc--speakerize-nick nick dispnm) - ?m s)))))) + ?m (erc--ensure-offset-prop s))))))) (defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO)) @@ -7876,6 +7904,7 @@ erc-make-notice "Notify the user of MESSAGE." (when erc-minibuffer-notice (message "%s" message)) + (erc--add-msg-prop 'erc--offset (length erc-notice-prefix)) (erc-highlight-notice (concat erc-notice-prefix message))) (defun erc-highlight-error (s) @@ -8375,8 +8404,9 @@ erc-display-msg (insert (erc--format-speaker-input-message line) "\n") (save-restriction (narrow-to-region insert-position (point)) - (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook) + (erc--with-offset-marker + (run-hooks 'erc-send-modify-hook) + (run-hooks 'erc-send-post-hook)) (cl-assert (> (- (point-max) (point-min)) 1)) (add-text-properties (point-min) (1+ (point-min)) (erc--order-text-properties-from-hash -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.7-Set-major-mode-before-updating-modules-in-erc-op.patch From 364add5f4452d83935475bf8823ebc04a04c8eb5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 1 Feb 2025 16:59:51 -0800 Subject: [PATCH 04/17] [5.7] Set major-mode before updating modules in erc-open * etc/ERC-NEWS: Mention change. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable) (erc-button-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-common.el (erc-with-initialized-session): New macro. * lisp/erc/erc-goodies.el (erc-scrolltobottom-mode) (erc-scrolltobottom-enable, erc-scrolltobottom-disable) (erc-move-to-prompt-mode, erc-move-to-prompt-enable) (erc-move-to-prompt-disable): Use `erc-with-initialized-session' instead of `erc-mode-hook'. * lisp/erc/erc-imenu.el (erc-imenu-mode, erc-imenu-enable) (erc-imenu-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable) (erc-stamp-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-track.el (erc-track-mode, erc-track-enable) (erc-track-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc-truncate.el (erc-truncate-mode, erc-truncate-enable) (erc-truncate-disable): Use macro instead of `erc-mode-hook'. * lisp/erc/erc.el (erc--set-modules-functions): New variable, an internal hook to modify erc-modules membership. (erc-open): Set major mode before updating modules. (Bug#76019) --- etc/ERC-NEWS | 10 ++++++++++ lisp/erc/erc-button.el | 4 +--- lisp/erc/erc-common.el | 16 ++++++++++++++++ lisp/erc/erc-goodies.el | 14 +++++--------- lisp/erc/erc-imenu.el | 8 +++----- lisp/erc/erc-stamp.el | 8 +++----- lisp/erc/erc-track.el | 4 +--- lisp/erc/erc-truncate.el | 4 +--- lisp/erc/erc.el | 10 ++++++++-- 9 files changed, 48 insertions(+), 30 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 9f364de591b..c6675ff4c58 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -25,6 +25,16 @@ were simply reversed as given. Now, just like with global modules, ERC preserves the preferred order when activating local modules for new sessions. +*** Major-mode setup runs before global-module setup in 'erc-open'. +The "enable" body of a global module's minor-mode command will now see +'erc-mode' as the 'major-mode'. Although ERC still delays its +major-mode hook until after it has initialized its main session +variables, a module can also now set any of its own variables that don't +depend on such initialization immediately and without fear of their +being killed. For modules still needing to run delayed, session-aware +code, a new convenience macro called 'erc-with-initialized-session' is +now available to automate any 'erc-mode-hook' wrangling for you. + * Changes in ERC 5.6.1 diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 77aec20c40f..ac646ed507f 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -54,13 +54,11 @@ button "This mode buttonizes all messages according to `erc-button-alist'." ((add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 30) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 30) - (add-hook 'erc-mode-hook #'erc-button-setup 91) - (unless erc--updating-modules-p (erc-buffer-do #'erc-button-setup)) + (erc-with-initialized-session (erc-button-setup)) (add-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map t "<backtab>" #'erc-button-previous)) ((remove-hook 'erc-insert-modify-hook #'erc-button-add-buttons) (remove-hook 'erc-send-modify-hook #'erc-button-add-buttons) - (remove-hook 'erc-mode-hook #'erc-button-setup) (remove-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map nil "<backtab>" #'erc-button-previous))) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d293e6ba878..776407b0e8d 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -434,6 +434,22 @@ define-erc-module (put ',enable 'definition-name ',name) (put ',disable 'definition-name ',name)))) +(defmacro erc-with-initialized-session (&rest body) + "Run BODY in all ERC buffers if outside `erc-open' and soon otherwise. +When inside `erc-open', run BODY after session variables have been +initialzied and after all `erc-mode-hook' members but before any +`after-change-major-mode-hook' members. Expect caller to know this is +only useful in global-module setup and that they're still responsible +for teardown, which is often done with `erc-buffer-do' or similar." + (let ((fn (make-symbol "fn")) + (hook-var (make-symbol "hook-var"))) + `(let ((,fn (lambda () ,@body))) + (if erc--updating-modules-p + (let ((,hook-var (gensym "erc--oneoff-major-mode-hook-"))) + (set ,hook-var ,fn) + (push ,hook-var delayed-mode-hooks)) + (erc-buffer-do ,fn))))) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 2a787f3e014..5da13409842 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -79,12 +79,11 @@ erc-scrolltobottom-all ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." - ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (when (and erc-scrolltobottom-all (< emacs-major-version 28)) + ((when (and erc-scrolltobottom-all (< emacs-major-version 28)) (erc-button--display-error-notice-with-keys "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.") (setq erc-scrolltobottom-all nil)) - (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) + (erc-with-initialized-session (erc--scrolltobottom-setup)) (if erc-scrolltobottom-all (progn (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) @@ -97,8 +96,7 @@ scrolltobottom (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) - ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) - (erc-buffer-do #'erc--scrolltobottom-setup) + ((erc-buffer-do #'erc--scrolltobottom-setup) (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) @@ -258,10 +256,8 @@ erc-make-read-only ;;;###autoload(autoload 'erc-move-to-prompt-mode "erc-goodies" nil t) (define-erc-module move-to-prompt nil "This mode causes the point to be moved to the prompt when typing text." - ((add-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-move-to-prompt-setup))) - ((remove-hook 'erc-mode-hook #'erc-move-to-prompt-setup) - (dolist (buffer (erc-buffer-list)) + ((erc-with-initialized-session (erc-move-to-prompt-setup))) + ((dolist (buffer (erc-buffer-list)) (with-current-buffer buffer (remove-hook 'pre-command-hook #'erc-move-to-prompt t))))) diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 2e244fa157e..6919e02bc8b 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -135,11 +135,9 @@ erc-imenu--create-index-function ;;;###autoload(autoload 'erc-imenu-mode "erc-imenu" nil t) (define-erc-module imenu nil "Simple Imenu integration for ERC." - ((add-hook 'erc-mode-hook #'erc-imenu-setup) - (add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) - (unless erc--updating-modules-p (erc-buffer-do #'erc-imenu-setup))) - ((remove-hook 'erc-mode-hook #'erc-imenu-setup) - (remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + ((add-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) + (erc-with-initialized-session (erc-imenu-setup))) + ((remove-hook 'which-function-mode-hook #'erc-imenu--disable-which-func) (erc-buffer-do #'erc-imenu-setup))) (defun erc-imenu-setup () diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index c3ab155cb24..d49cf8f05e7 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -178,13 +178,11 @@ erc-timestamp-face ;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t) (define-erc-module stamp timestamp "This mode timestamps messages in the channel buffers." - ((add-hook 'erc-mode-hook #'erc-stamp--setup) - (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) + ((add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70) (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) - (unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup))) - ((remove-hook 'erc-mode-hook #'erc-stamp--setup) - (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) + (erc-with-initialized-session (erc-stamp--setup))) + ((remove-hook 'erc-insert-modify-hook #'erc-add-timestamp) (remove-hook 'erc-send-modify-hook #'erc-add-timestamp) (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect) (erc-buffer-do #'erc-stamp--setup))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 2897c3ede93..7c3523670ad 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -607,8 +607,7 @@ track ;; enable the tracking keybindings (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (erc-track-minor-mode-maybe)) - (add-hook 'erc-mode-hook #'erc-track--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-track--setup)) + (erc-with-initialized-session (erc-track--setup)) (add-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer)) ;; Disable: @@ -630,7 +629,6 @@ track (remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe) (when erc-track-minor-mode (erc-track-minor-mode -1))) - (remove-hook 'erc-mode-hook #'erc-track--setup) (erc-buffer-do #'erc-track--setup) (remove-hook 'erc-networks--copy-server-buffer-functions #'erc-track--replace-killed-buffer))) diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index f5404a15b71..7b458b6164a 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -67,12 +67,10 @@ truncate ;;enable ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer) (add-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (add-hook 'erc-mode-hook #'erc-truncate--setup) - (unless erc--updating-modules-p (erc-buffer-do #'erc-truncate--setup))) + (erc-with-initialized-session (erc-truncate--setup))) ;; disable ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer) (remove-hook 'erc-connect-pre-hook #'erc-truncate--warn-about-logging) - (remove-hook 'erc-mode-hook #'erc-truncate--setup) (erc-buffer-do #'erc-truncate--setup))) (defvar-local erc-truncate--buffer-size nil diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 700fd72f5f7..572370ebbc6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2453,6 +2453,11 @@ erc--updating-modules-p confidently call (erc-foo-mode 1) without having to learn anything about the dependency's implementation.") +(defvar erc--set-modules-functions nil + "Abnormal hook run before updating modules on major-mode init. +Calls members with ID and TARGET parameters of `erc-open', both possibly +nil, along with a non-nil TARGET's server buffer when applicable.") + (defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules) "Internal hook for module setup involving windows and frames.") @@ -2603,6 +2608,9 @@ erc-open (when connect (run-hook-with-args 'erc-before-connect server port nick)) (set-buffer buffer) (setq old-point (point)) + (delay-mode-hooks (erc-mode)) + (run-hook-with-args 'erc--set-modules-functions id channel + (and channel old-buffer)) (setq delayed-modules (erc--merge-local-modes (let ((erc--updating-modules-p t)) (erc--update-modules @@ -2610,8 +2618,6 @@ erc-open (or erc--server-reconnecting erc--target-priors))) - (delay-mode-hooks (erc-mode)) - (setq erc-server-reconnect-count old-recon-count) (when (setq erc-server-connected (not connect)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.7-Run-mode-hooks-in-ERC-query-buffers-on-reconnect.patch From dda198612458af04173bba2fa0f49557a03085b7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 1 May 2024 03:25:51 -0700 Subject: [PATCH 05/17] [5.7] Run mode hooks in ERC query buffers on reconnect * etc/ERC-NEWS: Mention change. * lisp/erc/erc.el (erc-connection-established): Call `erc--open-target' on all existing query buffers after they've been reassociated by erc-networks logic. --- etc/ERC-NEWS | 7 +++++++ lisp/erc/erc.el | 13 ++++++++++--- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index c6675ff4c58..a0c177b169e 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -16,6 +16,13 @@ GNU Emacs since Emacs version 22.1. ** Changes in the library API. +*** Mode hooks run in query buffers on reconnect. +Previously, mode hooks would only run in channel buffers on reconnect, +due to channels being rejoined. But user code had no way to affect how +query buffers were (re)initialized for the new session. Though this may +cause churn in some cases, not that query buffers are currently only +distinguishable by name. + *** Local modules activate in preferred order instead of in reverse. In recent versions, ERC has enabled local modules in the reverse order of that produced by the "set" function used by 'setopt' and the Custom diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 572370ebbc6..bb4afed6504 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6818,9 +6818,16 @@ erc-connection-established (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) - (when erc-unhide-query-prompt - (erc-with-all-buffers-of-server erc-server-process nil - (when (and erc--target (not (erc--target-channel-p erc--target))) + ;; Run mode hooks on all reclaimed query buffers. + (let ((buffer (current-buffer)) + (erc-join-buffer 'bury) + erc-active-buffer) + (erc-with-all-buffers-of-server erc-server-process + #'erc-query-buffer-p + (let ((target (erc-target))) + (with-current-buffer buffer + (erc--open-target target))) + (when erc-unhide-query-prompt (erc--unhide-prompt)))) (run-hook-with-args 'erc-after-connect server nick))))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-5.x-Add-predicate-to-detect-ERC-module-activation.patch From c6cc56448eda9e0bd8d299a0cc8fc033e09b6d8a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 6 Jan 2024 12:57:27 -0800 Subject: [PATCH 06/17] [5.x] Add predicate to detect ERC module activation ;; FIXME update stale change log before merging. * lisp/erc/erc.el (erc--module-active-p): New function. (erc--module-active-ensure): New function. * test/lisp/erc/erc-tests.el (erc--module-active-ensure): Add test. --- lisp/erc/erc.el | 12 ++++++++++++ test/lisp/erc/erc-tests.el | 31 +++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bb4afed6504..b1c2b50de8d 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2424,6 +2424,18 @@ erc--find-mode (fboundp mode) mode))) +(defun erc--module-active-p (module) + "Return non-nil if symbol MODULE has been enabled or will be." + (let ((mode-var (intern-soft (concat "erc-" (symbol-name module) "-mode")))) + (and (or (and mode-var (boundp mode-var) (symbol-value mode-var) t) + (memq module erc-modules))))) + +(defun erc--module-active-ensure (module) + "Enable symbol MODULE if it's configured to be but isn't currently." + (when-let* (((consp (erc--module-active-p module))) + (mode-var (erc--find-mode module))) + (funcall mode-var +1))) + (defun erc--update-modules (modules) (let (local-modes) (dolist (module modules (nreverse local-modes)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index e008551998d..6e1b724012f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3629,6 +3629,37 @@ erc--find-mode (string< (symbol-name a) (symbol-name b))))))) erc-tests--modules)) +(ert-deftest erc--module-active-enable () + (should (featurep 'erc-networks)) + + (should-not (erc--module-active-p 'fake)) + + (let (after-load-alist calls) + + (cl-letf (((symbol-function 'erc-networks-mode) + (lambda (&rest r) (push r calls)))) + + ;; Module is not enabled nor configured to be. + (let ((erc-networks-mode nil) + (erc-modules nil)) + (should-not (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should-not calls)) + + ;; Module is enabled but not configured to be. + (let ((erc-networks-mode t) + erc-modules) + (should (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should-not calls)) + + ;; Module is disabled but slated to be enabled. + (let ((erc-networks-mode nil) + (erc-modules '(networks))) + (should (erc--module-active-p 'networks)) + (erc--module-active-ensure 'networks) + (should (equal calls '((1)))))))) + (ert-deftest erc--essential-hook-ordering () (erc-tests--assert-printed-in-subprocess '(progn -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-WIP-Add-erc-echo-msg-property-for-self-messages.patch From 74dfa6b3b9a28c689d28db410eaf090aabc6daa0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 20 Oct 2024 18:05:14 -0700 Subject: [PATCH 07/17] [WIP] Add erc--echo msg property for self messages ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Add `erc--echo' prop when sender has client's current nick. Pass inputp to alternate `erc--ctcp-response' constructor. * lisp/erc/erc-common.el (erc--ctcp-response): Add `inputp' slot. * lisp/erc/erc.el (erc--msg-props): Mention `erc--echo'. (erc--send-message-external): Convert to generic. (erc-process-ctcp-query): Skip all response handling for echoed non-ACTION queries, like VERSION, because no spoofed prompt input needs inserting, and no replies need emitting. --- lisp/erc/erc-backend.el | 5 ++++- lisp/erc/erc-common.el | 5 +++-- lisp/erc/erc.el | 36 +++++++++++++++++++++--------------- 3 files changed, 28 insertions(+), 18 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 81907ffa462..18e05c2790c 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2185,13 +2185,16 @@ erc--speaker-status-prefix-wanted-p erc-show-speaker-membership-status inputp) (cdr cdata)))))) + (when inputp + (push (cons 'erc--echo t) erc--msg-prop-overrides)) (if (erc-is-message-ctcp-p msg) (if noticep (erc-process-ctcp-reply proc parsed nick login host (match-string 1 msg)) (setq parsed (erc--ctcp-response-from-parsed :parsed parsed :buffer buffer :statusmsg statusmsg - :prefix cmem-prefix :dispname fnick)) + :prefix cmem-prefix :dispname fnick + :inputp inputp)) (erc-process-ctcp-query proc parsed nick login host)) (setq erc-server-last-peers (cons nick (cdr erc-server-last-peers))) (with-current-buffer (or buffer (current-buffer)) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 776407b0e8d..82571c37e9c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -135,7 +135,7 @@ erc--target (:include erc-response) (:constructor erc--ctcp-response-from-parsed - (&key parsed buffer statusmsg prefix dispname + (&key parsed buffer statusmsg prefix dispname inputp &aux (unparsed (erc-response.unparsed parsed)) (sender (erc-response.sender parsed)) (command (erc-response.command parsed)) @@ -146,7 +146,8 @@ erc--target (buffer nil :type (or buffer null)) (statusmsg nil :type (or null string)) (prefix nil :type (or erc-channel-user null)) - (dispname nil :type (or string null))) + (dispname nil :type (or string null)) + (inputp nil :type boolean)) (cl-defstruct erc--isupport-data "Abstract \"class\" for parsed ISUPPORT data. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index b1c2b50de8d..4446093de6f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -191,6 +191,9 @@ erc--msg-props hooks that the current message should not affect stateful operations, such as recording a channel's most recent speaker + - `erc--echo': t when present; indicates message is an echoed copy + of a something originally spoken by the client. + - `erc--hide': a symbol or list of symbols added as an `invisible' prop value to the entire message, starting *before* the preceding newline and ending before the trailing newline @@ -5139,7 +5142,7 @@ erc-send-message (funcall erc--send-message-nested-function line force) (erc--send-message-external line force))) -(defun erc--send-message-external (line force) +(cl-defmethod erc--send-message-external (line force) "Send a \"PRIVMSG\" to the default target with optional FORCE. Expect caller to bind `erc-default-recipients' if needing to specify a status-prefixed target." @@ -6876,7 +6879,9 @@ erc-process-ctcp-query ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08 "Process a CTCP query." (let ((queries (delete "" (split-string (erc-response.contents parsed) - "\C-a")))) + "\C-a"))) + (echoedp (and (erc--ctcp-response-p parsed) + (erc--ctcp-response-inputp parsed)))) (if (> (length queries) 4) (erc-display-message parsed (list 'notice 'error) proc 'ctcp-too-many) @@ -6895,20 +6900,21 @@ erc-process-ctcp-query hook proc parsed nick login host (car (erc-response.command-args parsed)) (car queries)) - (when erc-paranoid - (if (erc-current-nick-p - (car (erc-response.command-args parsed))) + (unless echoedp + (when erc-paranoid + (if (erc-current-nick-p + (car (erc-response.command-args parsed))) + (erc-display-message + parsed 'error 'active 'ctcp-request + ?n nick ?u login ?h host ?r (car queries)) (erc-display-message - parsed 'error 'active 'ctcp-request - ?n nick ?u login ?h host ?r (car queries)) - (erc-display-message - parsed 'error 'active 'ctcp-request-to - ?n nick ?u login ?h host ?r (car queries) - ?t (car (erc-response.command-args parsed))))) - (run-hook-with-args-until-success - hook proc nick login host - (car (erc-response.command-args parsed)) - (car queries))) + parsed 'error 'active 'ctcp-request-to + ?n nick ?u login ?h host ?r (car queries) + ?t (car (erc-response.command-args parsed))))) + (run-hook-with-args-until-success + hook proc nick login host + (car (erc-response.command-args parsed)) + (car queries)))) (erc-display-message parsed (list 'notice 'error) proc 'undefined-ctcp))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-WIP-Make-ERC-response-handling-more-flexible.patch From df77c4e46d18db886c7b482e418bc96bfe2a8a5d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 17 Jun 2022 01:43:03 -0700 Subject: [PATCH 08/17] [WIP] Make ERC response handling more flexible ;; FIXME update stale change log before merging. ;; Note: it may be necessary to use local advice wrappers instead of ;; &context methods if more granularity is required. Generics are ;; sensitive to file-loading order and exhibit other peculiarities that ;; can make them difficult to predict in terms of running order. * lisp/erc/erc-backend.el (erc--generic-response-handlers): New constant variable listing IRC commands and "numerics" whose handler logic should live in an internal generic method to be called by a traditional erc-server-FOO handler function, now just a thin public wrapper. ERC matches these members of the list value against the NAME param of `define-erc-response-handler'. (define-erc-response-handler): Allow defining a handler as an internal defgeneric to be called by a public handler. The rationale is that the existing public hook interface cannot adequately support the level of granularity required. For example, registering a local `erc-server-FOO-functions' member at an earlier hook depth and returning non-nil based on which extensions are active would still preempt existing user functions registered to run after a primary `erc-server-FOO' handler globally. Sticking with this existing interface would in fact require a breaking change in which ERC adds its primary hook member, erc-server-FOO, buffer-locally on major-mode init, at an earlier depth than any existing global members represented by the familiar t. (Bug#49860) --- lisp/erc/erc-backend.el | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 18e05c2790c..6fb87f2d4dd 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1625,6 +1625,9 @@ erc-handle-unknown-server-response " ")))) (erc-display-message parsed 'notice proc line))) +(eval-and-compile + (defconst erc--generic-response-handlers + '(JOIN 005 263 352 353 354 366 900 903 904 CAP))) (cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc @@ -1758,6 +1761,9 @@ define-erc-response-handler (concat extra-fn-doc "\n\n") "") name hook-name)) + (fn-internal (and (memq (read (symbol-name name)) + erc--generic-response-handlers) + (intern (format "erc--server-%s" name)))) (fn-alternates (cl-loop for alias in aliases collect (intern (format "erc-server-%s" alias)))) @@ -1770,11 +1776,18 @@ define-erc-response-handler ;; unconditionally (defvar ,hook-name nil ,(format hook-doc name)) (add-hook ',hook-name #',fn-name) + + ,@(when fn-internal + `((cl-defgeneric ,fn-internal (proc parsed) + ,(or extra-fn-doc (format "Handle incoming %s response." name)) + (ignore proc parsed) + ,@fn-body))) ; FIXME indentation in form just below + ;; Handler function (defun ,fn-name (proc parsed) ,fn-doc (ignore proc parsed) - ,@fn-body) + ,@(if fn-internal `((,fn-internal proc parsed)) fn-body)) ;; Make find-function and find-variable find them (put ',fn-name 'definition-name ',name) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0009-WIP-Clearly-define-erc-server-user-info-field-as-an-.patch From a62393fec79b334440bc814f2e61e556a94f1649 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 26 Jul 2021 05:40:59 -0700 Subject: [PATCH 09/17] [WIP] Clearly define erc-server-user info field as an alist ;; FIXME add news entry explaining change in erc-server-user schema. ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-server-317): Drop nonstandard usage of `info' slot for misc informational message that's never recalled for later use. This is printed to the buffer anyway, so there's no reason to store degenerate data in the table. Instead, preserve structured data as `idle' entry in erc-server-user-info alist. * lisp/erc/erc-common.el (erc-server-user): Redefine rarely used, confusing `info' slot, formerly an opaque value, and repurpose it as an alist. In the handful of instances where it was used, it was largely misused. Add type descriptions for nickname, host, login, full-name. * lisp/erc/erc-speedbar.el (erc-speedbar-italicize-away, erc-speedbar--italicize-away): Add var and function to facilitate italicizing of away users. (erc-speedbar--expand-info): New function to optionally show various items from the `erc-server-user' `info' alist. (erc-speedbar-expand-user): Appeal to `erc-speedbar--expand-info' for displaying info-derived tags. (erc-speedbar--emulate-sidebar): Conditionally wrap `erc-speedbar--nick-face-function'. * lisp/erc/erc.el (erc-add-server-user): Add optional `info' argument and maybe update `info' field before committing user. (erc-process-away): Add away member with an empty string to `erc-server-user' object's info slot. (erc--server-user-away-p): Add function to extract away field from `info' slot of `erc-server-user'. (erc--server-user-info-collect-p, erc--ensure-server-user-info): New function and internal flag variable to massage obsolete values to be added to the `info' field of an `erc-server-user' object. (erc-update-user): Take special pains to shoehorn `info' into an alist and emit a warning if necessary. * test/lisp/erc/erc-tests.el (erc--ensure-server-user-info): New test. (Bug#49860) --- lisp/erc/erc-backend.el | 9 ++++--- lisp/erc/erc-common.el | 28 +++++++++++++++++--- lisp/erc/erc-speedbar.el | 36 +++++++++++++++++++++---- lisp/erc/erc.el | 54 +++++++++++++++++++++++++++++++++++--- test/lisp/erc/erc-tests.el | 53 +++++++++++++++++++++++++++++++++++++ 5 files changed, 164 insertions(+), 16 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 6fb87f2d4dd..fba451f69e6 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2457,9 +2457,10 @@ erc--with-isupport-data (define-erc-response-handler (301) "AWAY notice." nil - (erc-display-message parsed 'notice 'active 's301 - ?n (cadr (erc-response.command-args parsed)) - ?r (erc-response.contents parsed))) + (let ((nick (cadr (erc-response.command-args parsed))) + (msg (erc-response.contents parsed))) + (erc-update-user-nick nick nil nil nil nil (cons 'away msg) nil) + (erc-display-message parsed 'notice 'active 's301 ?n nick ?r msg))) (define-erc-response-handler (303) "ISON reply" nil @@ -2529,7 +2530,7 @@ erc--with-isupport-data (format-time-string erc-server-timestamp-format (string-to-number on-since)))) (erc-update-user-nick nick nick nil nil nil - (and time (format "on since %s" time))) + (cons 'idle time)) (if time (erc-display-message parsed 'notice 'active 's317-on-since diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 82571c37e9c..638838924d3 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -79,10 +79,30 @@ erc-input (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) - ;; User data - nickname host login full-name info - ;; Buffers - (buffers nil)) + ( nickname nil :type (or null string) + :documentation "The nickname, effectively non-nil and non-empty.") + ( host nil :type (or null string) + :documentation "The hostname.") + ( login nil :type (or null string) + :documentation "The login, also called username.") + ( full-name nil :type (or null string) + :documentation "The full name, also called real name and GECOS.") + ;; This slot was repurposed to accommodate metadata relevant to UI + ;; concerns, such as away status or display names. As of ERC 5.7, + ;; it's an alist of symbols paired with arbitrary values, and its only + ;; known items, when present, are + ;; - `away', a possibly empty string indicating a user is away + ;; (see `erc-server-301') + ;; - `idle', a nonempty string saying how long a user has been idle + ;; (see `erc-server-317') + ;; - `info', a "meta" item for legacy non-alist `info' slot values + ;; (see `erc--ensure-server-user-info') + ( info nil + :type (list-of cons) + :documentation "Alist of `eq'-testable keys with arbitrary values.") + ( buffers nil + :type (list-of buffer) + :documentation "Channel buffers user is joined to.")) (cl-defstruct (erc-channel-user (:type vector) (:constructor diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 720b5cd5d11..63de1b5c5f7 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -299,6 +299,18 @@ erc-speedbar--highlight-self-and-ops erc-button-nickname-face) 'erc-default-face)))) +(defvar erc-speedbar-italicize-away t + "Show channel users who are away in italics.") + +(defun erc-speedbar--italicize-away (orig buffer user cuser) + (let ((others (funcall orig buffer user cuser))) + (if-let* ((info (erc-server-user-info user)) + ((assq 'away info))) + (if others + (cons 'erc-italic-face (ensure-list others)) + 'erc-italic-face) + others))) + (defun erc-speedbar--on-click (nick sbtoken _indent) ;; 0: finger, 1: name, 2: info, 3: buffer-name (with-current-buffer (nth 3 sbtoken) @@ -354,6 +366,20 @@ erc-speedbar-update-channel (speedbar-delete-subblock 1) (erc-speedbar-expand-channel "+" buffer 1))))) +(defun erc-speedbar--expand-info (info indent) + "Create a tag from items in INFO that have a `erc-speedbar-tag' prop. +Expect INFO to be an alist associating symbols with opaque +objects. If the property is a function, call it with the item's +key and value and also the indent level." + (pcase-dolist (`(,key . ,value) info) + (when-let* ((fn (get key 'erc-speedbar-tag)) + ;; FIXME figure out the right way to do this + ;; using the `speedbar' API. + (tag (if (functionp fn) + (funcall fn key value indent) + (format "%s: %s" key value)))) + (speedbar-make-tag-line nil nil nil nil tag nil nil nil (1+ indent))))) + (defun erc-speedbar-expand-user (text token indent) (cond ((string-search "+" text) (speedbar-change-expand-button-char ?-) @@ -374,10 +400,7 @@ erc-speedbar-expand-user name nil nil nil (1+ indent))) (when info - (speedbar-make-tag-line - nil nil nil nil - info nil nil nil - (1+ indent))))))) + (erc-speedbar--expand-info info indent)))))) ((string-search "-" text) (speedbar-change-expand-button-char ?+) (speedbar-delete-subblock indent)) @@ -486,7 +509,10 @@ erc-speedbar--emulate-sidebar (when (memq 'nicks erc-modules) (with-current-buffer speedbar-buffer (add-function :around (local 'erc-speedbar--nick-face-function) - #'erc-speedbar--compose-nicks-face)))) + #'erc-speedbar--compose-nicks-face))) + (when erc-speedbar-italicize-away + (add-function :around (local 'erc-speedbar--nick-face-function) + #'erc-speedbar--italicize-away '((depth . 50))))) (defun erc-speedbar--handle-delete-frame (event) "Disable the nickbar if EVENT is deleting the proxy frame." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 4446093de6f..3787d6e3d97 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -547,11 +547,13 @@ erc--casemapping-rfc1459 (aset cup ?~ ?~) tbl)) -(defun erc-add-server-user (nick user) +(defun erc-add-server-user (nick user &optional info) "This function is for internal use only. Adds USER with nickname NICK to the `erc-server-users' hash table." (erc-with-server-buffer + (when info + (erc--ensure-server-user-info user info)) (puthash (erc-downcase nick) user erc-server-users))) (defvar erc--decouple-query-and-channel-membership-p nil @@ -7115,6 +7117,7 @@ erc-process-away If non-nil, return from being away." (let ((sessionbuf (process-buffer proc))) (when sessionbuf + (cl-assert (eq sessionbuf (current-buffer))) (with-current-buffer sessionbuf (when erc-away-nickname (erc-log (format "erc-process-away: away-nick: %s, away-p: %s" @@ -7122,6 +7125,11 @@ erc-process-away (erc-cmd-NICK (if away-p erc-away-nickname erc-nick))) + (when-let* ((user (erc-get-server-user (erc-current-nick))) + ((not (and away-p + (alist-get 'away + (erc-server-user-info user)))))) + (erc-update-user user nil nil nil nil (cons 'away (and away-p "")))) (cond (away-p (setq erc-away (current-time))) @@ -7289,6 +7297,40 @@ erc-update-user-nick (erc-update-user (erc-get-server-user nick) new-nick host login full-name info)) +(defun erc--server-user-away-p (user) + "Return a possibly empty away message when USER is away. +Expect USER to be a `erc-server-user' object." + (alist-get 'away (erc-server-user-info user))) + +(defvar erc--server-user-info-collect-p nil + "Escape hatch for pre-ERC 5.7 `erc-server-user-info' interface. +When non-nil, ERC adds non-list `info' slot update values to a +list of existing ones stored in the `info' item in the +`erc-server-user-info' alist. Otherwise, it replaces the current +`info' alist value.") ; FIXME sync version on release + +(defun erc--ensure-server-user-info (user info) + "Normalize INFO to conform to `info' slot of `erc-server-user'. +When INFO is a list whose CAR is a symbol, update or create +`erc-server-user-info' instead, removing matching members if +INFO's CDR is nil." + (cond + ((consp (car-safe info)) + (setf (erc-server-user-info user) info)) + ((consp info) + (setf (alist-get (car info) (erc-server-user-info user) nil t #'eq) + (cdr info))) + ((progn (erc-button--display-error-notice-with-keys-and-warn + "Non-alist value given for `info' field of `erc-server-user' " + (erc-server-user-nickname user) + "; storing as alist `info' item " + (if erc--server-user-info-collect-p "(info %S ...)" "(info . %S)") + " instead." (or info (make-symbol "nil"))) + nil)) + (erc--server-user-info-collect-p + (push info (alist-get 'info (erc-server-user-info user)))) + (t (setf (alist-get 'info (erc-server-user-info user)) info)))) + (defun erc-update-user (user &optional new-nick host login full-name info) "Update user info for USER. @@ -7297,6 +7339,11 @@ erc-update-user existing values for USER are used to replace the stored values in USER. +In addition to being a complete replacement for the object's info slot, +INFO can also be a single cons pair indicating a member of the existing +`info' field to update. In such cases, a nil CDR will cause the member +to be deleted. + If, and only if, a change is made, `erc-channel-members-changed-hook' is run for each channel for which USER is a member, and t is returned." @@ -7323,7 +7370,7 @@ erc-update-user (when (and info (not (equal (erc-server-user-info user) info))) (setq changed t) - (setf (erc-server-user-info user) info)) + (erc--ensure-server-user-info user info)) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) @@ -7358,7 +7405,8 @@ erc--create-current-channel-member :full-name full-name :login login :info nil - :buffers (list (current-buffer)))))) + :buffers (list (current-buffer)))) + info)) (let ((cusr (erc-channel-user--make :status (or status 0) :last-message-time (and timep diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 6e1b724012f..b8bc453f498 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4078,4 +4078,57 @@ erc-retrieve-catalog-entry ;; Terminates. (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) +(ert-deftest erc--ensure-server-user-info () + (with-current-buffer (get-buffer-create "*erc-tests*") + (erc-mode) + (erc--initialize-markers (point) nil) + (should-not erc--server-user-info-collect-p) + + (let ((user (make-erc-server-user :nickname "tester" :login "testeroni" + :info '((a . 1)))) + (erc--server-user-info-collect-p t)) + + (cl-letf (((symbol-function 'display-warning) #'ignore)) + (ert-info ("Collects when `erc--server-user-info-collect-p' non-nil") + (erc--ensure-server-user-info user 42) + (should (equal (erc-server-user-info user) '((info 42) (a . 1)))) + (erc--ensure-server-user-info user 'foo) + (should + (equal (erc-server-user-info user) '((info foo 42) (a . 1))))) + + (ert-info ("Replaces when `erc--server-user-info-collect-p' nil") + (setq erc--server-user-info-collect-p nil) + (erc--ensure-server-user-info user 'bar) + (should (equal (erc-server-user-info user) '((info . bar) (a . 1)))) + (erc--ensure-server-user-info user 'nil) + (should (equal (erc-server-user-info user) '((info . nil) (a . 1)))) + (should (equal (pop (erc-server-user-info user)) '(info))))) + + (erc--ensure-server-user-info user '((b . 2))) + (should (equal (erc-server-user-info user) '((b . 2)))) + + (erc--ensure-server-user-info user '(b . 3)) + (should (equal (erc-server-user-info user) '((b . 3)))) + + (erc--ensure-server-user-info user '(c . 4)) + (should (equal (erc-server-user-info user) '((c . 4) (b . 3)))) + + (erc--ensure-server-user-info user '(b . 5)) + (should (equal (erc-server-user-info user) '((c . 4) (b . 5)))) + + (erc--ensure-server-user-info user '(b . nil)) + (should (equal (erc-server-user-info user) '((c . 4)))) + + (erc--ensure-server-user-info user '(c . nil)) + (should-not (erc-server-user-info user)) + + (goto-char (point-min)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should (search-forward "Non-alist value given" nil t)) + (should-not (search-forward "Non-alist value given" nil t))) + + (when noninteractive (kill-buffer)))) + ;;; erc-tests.el ends here -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0010-WIP-Add-account-slot-to-erc-server-user.patch From b324d7c917b2f709e7b646a7f4bdf439b73817bc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 7 Aug 2022 04:12:41 -0700 Subject: [PATCH 10/17] [WIP] Add account slot to erc-server-user ;; FIXME update stale change log before merging. ;; There's some unrelated stuff in erc-button that could go elsewhere. ;; FIMXE combine this with preceding info patch if merging. ;; FIXME add a news entry for all changes to `erc-server-user' and the ;; meaning of empty strings in `erc-update-user'. * lisp/erc/erc-backend.el (erc-server-301): Update user state before displaying message. * lisp/erc/erc-common.el (erc-server-user): Add `account' slots for nick-services account name. * lisp/erc/erc.el (erc-add-server-user): Ensure slots with empty strings whose type can be null or a string are set to nil. (erc-update-user-nick, erc-update-user) (erc-update-current-channel-member, erc-update-channel-member): Add `account' and `away' and parameters. --- lisp/erc/erc-backend.el | 4 ++- lisp/erc/erc-button.el | 24 ++++++++++--- lisp/erc/erc-common.el | 3 ++ lisp/erc/erc.el | 74 +++++++++++++++++++++++++++-------------- 4 files changed, 75 insertions(+), 30 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index fba451f69e6..95cf8cdff86 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -187,7 +187,7 @@ erc-verbose-server-ping (declare-function erc-update-channel-topic "erc" (channel topic &optional modify)) (declare-function erc-update-user-nick "erc" - (nick &optional new-nick host login full-name info)) + (nick &optional new-nick host login full-name info account)) (declare-function erc-open "erc" (&optional server port nick full-name connect passwd tgt-list channel process client-certificate user id)) @@ -195,6 +195,8 @@ erc-verbose-server-ping (channel nick new-nick &optional add voice halfop op admin owner host login full-name info update-message-time)) +(declare-function erc-update-user-nick "erc" + (nick &optional new-nick host login full-name info account)) ;;;; Variables and options diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index ac646ed507f..1748d152b72 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -415,17 +415,23 @@ erc-button--get-user-from-spkr-prop (cl-defstruct (erc--phantom-channel-user (:include erc-channel-user))) (cl-defstruct (erc--phantom-server-user (:include erc-server-user))) -(defun erc-button--add-phantom-speaker (downcased nuh _parsed) +(defun erc-button--add-phantom-speaker (downcased nuh parsed) (pcase-let* ((`(,nick ,login ,host) nuh) (cmem (gethash downcased erc-button--phantom-cmems)) + (account (and-let* ((tags (erc-response.tags parsed))) + (alist-get 'account tags))) (user (or (car cmem) (make-erc--phantom-server-user :nickname nick :host (and (not (string-empty-p host)) host) - :login (and (not (string-empty-p login)) login)))) + :login (and (not (string-empty-p login)) login) + :account account))) (cuser (or (cdr cmem) (make-erc--phantom-channel-user - :last-message-time (current-time))))) + :last-message-time (erc--current-time-pair))))) + ;; Can't create `erc-data' object yet without access to the + ;; inserted nick, which we'd need to preserve a weak reference + ;; against `erc-button--nicks-to-data'. (puthash downcased (cons user cuser) erc-button--phantom-cmems) (cons user cuser))) @@ -458,6 +464,15 @@ erc-button--phantom-users-mode #'erc-button--get-phantom-cmem) (kill-local-variable 'erc-button--phantom-cmems))) +(defun erc-button--deemphasize-plebs (nick-object) + "Don't embolden nicks lacking status prefixes." + (when (and nick-object + (erc-button--nick-cusr nick-object) + (let ((cusr (erc-button--nick-cusr nick-object))) + (or (null cusr) (zerop (erc-channel-user-status cusr))))) + (setf (erc-button--nick-nickname-face nick-object) nil)) + nick-object) + (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." (when-let* ((form (nth 2 entry)) @@ -487,7 +502,8 @@ erc-button-add-nickname-buttons down word bounds seen)))) (user (or (and cmem (car cmem)) (and erc-server-users (gethash down erc-server-users)))) - (data (list word))) + ;; Use the nick that's already stored. + (data (and user (list (erc-server-user-nickname user))))) (when (or (not (functionp form)) (and user (setq nick-obj (funcall form (make-erc-button--nick diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 638838924d3..87ed78e4f24 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -100,6 +100,9 @@ erc-input ( info nil :type (list-of cons) :documentation "Alist of `eq'-testable keys with arbitrary values.") + ( account nil + :type (or null string) + :documentation "A non-empty string other than \"*\" or nil.") ( buffers nil :type (list-of buffer) :documentation "Channel buffers user is joined to.")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 3787d6e3d97..c4a4df1c936 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -549,8 +549,18 @@ erc--casemapping-rfc1459 (defun erc-add-server-user (nick user &optional info) "This function is for internal use only. - -Adds USER with nickname NICK to the `erc-server-users' hash table." +Add `erc-server-user' USER with string NICK to `erc-server-users'. +Ensure slots login, host, full-name, and account in USER are nil instead +of the empty string. Optionally massage INFO with a la carte updates +and deletions." + (when (string-empty-p (erc-server-user-login user)) + (setf (erc-server-user-login user) nil)) + (when (string-empty-p (erc-server-user-host user)) + (setf (erc-server-user-host user) nil)) + (when (string-empty-p (erc-server-user-full-name user)) + (setf (erc-server-user-full-name user) nil)) + (when (member (erc-server-user-account user) '("" "*")) + (setf (erc-server-user-account user) nil)) (erc-with-server-buffer (when info (erc--ensure-server-user-info user info)) @@ -7290,12 +7300,12 @@ erc-channel-receive-names (run-hooks 'erc-channel-members-changed-hook)) (defun erc-update-user-nick (nick &optional new-nick - host login full-name info) + host login full-name info account) "Update the stored user information for the user with nickname NICK. See also: `erc-update-user'." - (erc-update-user (erc-get-server-user nick) new-nick - host login full-name info)) + (when-let* ((user (erc-get-server-user nick))) + (erc-update-user user new-nick host login full-name info account))) (defun erc--server-user-away-p (user) "Return a possibly empty away message when USER is away. @@ -7332,12 +7342,13 @@ erc--ensure-server-user-info (t (setf (alist-get 'info (erc-server-user-info user)) info)))) (defun erc-update-user (user &optional new-nick - host login full-name info) + host login full-name info account) "Update user info for USER. -USER must be an erc-server-user struct. Any of NEW-NICK, HOST, -LOGIN, FULL-NAME, INFO which are non-nil and not equal to the -existing values for USER are used to replace the stored values in -USER. +Replace slot values in in USER, an `erc-server-user' struct, with +NEW-NICK, HOST, LOGIN, FULL-NAME, and ACCOUNT if non-nil and not +`equal'. If HOST, LOGIN, FULL-NAME, or ACCOUNT are an empty string, set +the slot to nil. Do so as well if ACCOUNT is a string containing a lone +asterisk. In addition to being a complete replacement for the object's info slot, INFO can also be a single cons pair indicating a member of the existing @@ -7357,20 +7368,31 @@ erc-update-user (when (and host (not (equal (erc-server-user-host user) host))) (setq changed t) - (setf (erc-server-user-host user) host)) + (setf (erc-server-user-host user) + (and (not (string-empty-p host)) host))) (when (and login (not (equal (erc-server-user-login user) login))) (setq changed t) - (setf (erc-server-user-login user) login)) + (setf (erc-server-user-login user) + (and (not (string-empty-p login)) login))) (when (and full-name (not (equal (erc-server-user-full-name user) full-name))) (setq changed t) - (setf (erc-server-user-full-name user) full-name)) + (setf (erc-server-user-full-name user) + (and (not (string-empty-p full-name)) full-name))) (when (and info (not (equal (erc-server-user-info user) info))) (setq changed t) (erc--ensure-server-user-info user info)) + (when (and account + (not (equal (erc-server-user-account user) account)) + ;; Don't report a change when unset and already nil + (or (not (equal account "*")) + (erc-server-user-account user))) + (setq changed t) + (setf (erc-server-user-account user) + (and (not (member account '("" "*"))) account))) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) @@ -7379,13 +7401,13 @@ erc-update-user changed)) (defun erc--create-current-channel-member - (nick status timep &optional new-nick host login full-name info) + (nick status timep &optional new-nick host login full-name info account) "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 +Pass NEW-NICK, HOST, LOGIN, FULL-NAME, INFO, and ACCOUNT 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))) @@ -7397,7 +7419,7 @@ erc--create-current-channel-member (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))) + full-name info account))) (erc-add-server-user nick (setq user (make-erc-server-user :nickname (or new-nick nick) @@ -7405,6 +7427,7 @@ erc--create-current-channel-member :full-name full-name :login login :info nil + :account account :buffers (list (current-buffer)))) info)) (let ((cusr (erc-channel-user--make @@ -7448,12 +7471,12 @@ erc--update-current-channel-member (defun erc-update-current-channel-member (nick new-nick &optional addp voice halfop op admin owner host login - full-name info update-message-time) + full-name info update-message-time account) "Update or create entry for NICK in current `erc-channel-members' table. 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 +FULL-NAME, INFO, and ACCOUNT. 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, @@ -7482,23 +7505,24 @@ erc-update-current-channel-member (if cmem (erc--update-current-channel-member cmem status update-message-time new-nick host login - full-name info) + full-name info account) (when addp (erc--create-current-channel-member nick status update-message-time new-nick host login - full-name info))))) + full-name info account))))) (defun erc-update-channel-member (channel nick new-nick - &optional add voice halfop op admin owner host login - full-name info update-message-time) + &optional add voice halfop op admin + owner host login full-name info + update-message-time account) "Update user and channel for user with nickname NICK in channel CHANNEL. See also: `erc-update-current-channel-member'." (erc-with-buffer (channel) - (erc-update-current-channel-member nick new-nick add voice halfop op admin owner host - login full-name info - update-message-time))) + (erc-update-current-channel-member nick new-nick add voice halfop op admin + owner host login full-name info + update-message-time account))) (defun erc-remove-current-channel-member (nick) "Remove NICK from current channel membership list. -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0011-WIP-Break-up-early-ERC-response-processing.patch From b4547fafe33ae837e117fe295806bd3e44aaf39c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 15 Jul 2022 05:02:35 -0700 Subject: [PATCH 11/17] [WIP] Break up early ERC response processing ;; FIXME update stale change log before merging. ;; See note in "Make ERC response handling more flexible" regarding ;; generics. The same applies here. * lisp/erc/erc-backend.el (erc--finish-parsing-server-response): Add new generic function and default method. (erc-parse-server-response): Convert to modular logic and delegate to helpers. (erc--parse-traditional-response): Perform actual parsing-related business formerly handled by `erc-parse-server-response) (erc--handle-parsed-tags): Add new generic function to handle a tag regardless of the response command or numeric type. (erc-handle-parsed-server-response): Call `erc--handle-parsed-tags'. --- lisp/erc/erc-backend.el | 69 +++++++++++++------ lisp/erc/erc-compat.el | 33 +++++++++ .../erc/resources/erc-scenarios-common.el | 2 + 3 files changed, 83 insertions(+), 21 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 95cf8cdff86..4bc3f1de66d 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -997,7 +997,10 @@ erc-server-filter-function (substring erc-server-filter-data (match-end 0)))) (erc-log-irc-protocol line nil) - (erc-parse-server-response process line))))))) + (save-match-data + (unless (string= line "") + (erc-compat--with-backtrace-buffer "*erc-process-error*" + (erc-parse-server-response process line)))))))))) (defun erc--server-reconnect-p (event) "Return non-nil when ERC should attempt to reconnect. @@ -1488,21 +1491,39 @@ erc--parse-message-tags " releases. See `erc-tags-format' for more info."))) (erc--parse-tags string))) -(defun erc-parse-server-response (proc string) - "Parse and act upon a complete line from an IRC server. -PROC is the process (connection) from which STRING was received. -PROCs `process-buffer' is `current-buffer' when this function is called." - (unless (string= string "") ;; Ignore empty strings - (save-match-data - (let* ((tag-list (when (eq (aref string 0) ?@) - (substring string 1 - (string-search " " string)))) - (msg (make-erc-response :unparsed string :tags - (when tag-list - (erc--parse-message-tags tag-list)))) - (string (if tag-list - (substring string (+ 1 (string-search " " string))) - string)) +(cl-defgeneric erc--create-response-from-parts (full-line 1459-line tags) + "Parse response from 1459-LINE, considering parsed TAGS and FULL-LINE. +Expect 1459-LINE to be a traditional raw IRC message without a leading +tags portion. Expect TAGS, if non-nil, to conform to the non-legacy +`erc-tags-format'. Return a new `erc-response' object or nil.") + +(cl-defmethod erc--create-response-from-parts (full-line 1459-line tags) + "Parse and decode 1459-LINE into `erc-response' object." + (let ((message (erc--parse-traditional-response 1459-line + :unparsed full-line + :tags tags))) + (erc-decode-parsed-server-response message) + message)) + +(defun erc--partition-line (full-line) + "Return two-tuple list of rfc1459 line and tags list from FULL-LINE. +Strip leading \"@\" and trailing space from FULL-LINE to get 1459 line." + (let ((end (and (eq (aref full-line 0) ?@) (string-search " " full-line)))) + (list (if end (substring full-line (1+ end)) full-line) + (and end (save-match-data + (erc--parse-message-tags + (substring full-line 1 end))))))) + +(defun erc-parse-server-response (process raw-line) + "Parse and act upon a RAW-LINE from PROCESS." + (when-let* ((message (apply #'erc--create-response-from-parts + raw-line (erc--partition-line raw-line)))) + (erc-handle-parsed-server-response process message))) + +(defun erc--parse-traditional-response (string &rest keyword-pairs) + (progn ; preserve indentation until next refactoring + (progn + (let* ((msg (apply #'make-erc-response keyword-pairs)) (posn (if (eq (aref string 0) ?:) (string-search " " string) 0))) @@ -1536,11 +1557,17 @@ erc-parse-server-response (setf (erc-response.command-args msg) (nreverse (erc-response.command-args msg))) - - (erc-decode-parsed-server-response msg) - - (erc-handle-parsed-server-response proc msg))))) - + msg)))) + +;; FIXME this function performs the work of decoding the `contents' slot +;; twice because it's normally `eq' to the last member of +;; `command-args'. Also, `erc-coding-system-for-target' only needs to +;; run once because all slots in an `erc-response' object share the same +;; target and thus the same coding system. ERC's next major version +;; could put off decoding until target discovery, perhaps as a lazy slot +;; on `erc--ztargeted'. If necessary, it could use a heuristic to +;; decode non-ASCII target names for nonstandard "IRC-adjacent" +;; (possibly bridged) protocols. (defun erc-decode-parsed-server-response (parsed-response) "Decode a pre-parsed PARSED-RESPONSE before it can be handled. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 4a8029d68ac..558da5b196f 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -450,6 +450,39 @@ erc-compat--defer-format-spec-in-buffer spec))))) +;;;; Misc 30.1 + +(defmacro erc-compat--with-backtrace-buffer (bufname &rest body) + "When BODY fails, print a backtrace in BUFNAME and re-signal." + (declare (indent 1)) + `(,@(if (fboundp 'handler-bind) + `(handler-bind + ((error + ;; FIXME find out how to propagate properly. Here, + ;; re-signaling `err' the normal way sometimes causes a + ;; segfault when running tests, hence the `cl-assert'. + ;; This may be related to bug#67862: "30.0.50; + ;; Handler-bind and ert-test-error-debug" + (lambda (err) + (when debug-on-error + (cl-assert (null (cdr err)) nil + "FIXME kludge to trigger debugger")) + (let ((standard-output + (if noninteractive + standard-output + (get-buffer-create ,bufname)))) + (terpri) + (let ((print-escape-newlines t)) + (prin1 + (list :err err + :buffer (current-buffer) + :time (format-time-string "%FT%T.%3NZ" nil t)))) + (terpri) + (backtrace)))))) + '(progn)) + ,@body)) + + ;;;; Misc 31.1 (defun erc-compat--window-no-other-p (window) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index c2453e93616..cb57e14ccd5 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -197,6 +197,8 @@ erc-scenarios-common-with-cleanup (ert-info ("Running extra teardown") (funcall erc-scenarios-common-extra-teardown))) + (should-not (match-buffers (rx "*erc-" (+ (any "a-z-")) + "error*"))) (erc-buffer-do #'erc-scenarios-common--assert-date-stamps) (when (and (boundp 'erc-autojoin-mode) (not (eq erc-autojoin-mode ,orig-autojoin-mode))) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0012-WIP-Make-updating-last-message-time-more-flexible-in.patch From c004956892ae20f4adcc72db745c2fce8f182739 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 6 Sep 2023 19:52:20 -0700 Subject: [PATCH 12/17] [WIP] Make updating last-message-time more flexible in ERC ;; FIXME update stale change log before merging. * lisp/erc/erc-common.el (erc--time-pair-from-time-tag): New function. (erc--current-time-pair-function): New variable (erc--current-time-pair): New function and variable of the same name. (erc--current-lisp-time): New function. (erc-call-hooks): Bind `erc--parse-response' when dispatching response handlers. * lisp/erc/erc-compat.el (erc-compat--iso8601-to-time): New function. (erc-compat--27-iso8601-parse-time): New function. * lisp/erc/erc-stamp.el (erc-stamp--current-time): Replace generic function with normal function. Defer to `erc--current-time-pair' so that features related to IRCv3 time stamps don't need to depend on the `stamp' module. * lisp/erc/erc.el (erc-update-current-channel-member): Use `erc--current-time-pair' instead of `current-time' for updating `last-message-time' slot of channel users. (erc--update-cusr-message-time): New function. * test/lisp/erc/erc-fill-tests.el (erc-stamp--current-time): Remove method. (erc-fill-tests--current-time-value): Remove unused variable. (erc-fill-tests--wrap-populate, erc-fill-wrap--merge) (erc-fill-wrap--merge-action): Update variable name. * test/lisp/erc/erc-tests.el (erc-compat--iso8601-to-time): New test. (Bug#49860) --- lisp/erc/erc-common.el | 20 +++++++ lisp/erc/erc-compat.el | 96 +++++++++++++++++++++++++++++++++ lisp/erc/erc-stamp.el | 7 +-- lisp/erc/erc.el | 15 +++--- test/lisp/erc/erc-fill-tests.el | 11 ++-- test/lisp/erc/erc-tests.el | 15 ++++++ 6 files changed, 145 insertions(+), 19 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 87ed78e4f24..f01dea1c54c 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -576,6 +576,26 @@ erc-log (when erc-log-p (erc-log-aux ,string)))) +(defun erc--time-pair-from-time-tag (parsed) + "Return stamp from `tags' slot of PARSED as lisp-time pair if found." + (and-let* ((stamp (alist-get 'time (erc-response.tags parsed))) + ((erc-compat--iso8601-to-time stamp t))))) + +(defvar erc--current-time-pair-function #'erc--current-lisp-time + "Internal advice interface for `erc--current-time-pair'.") + +(defun erc--current-lisp-time () + "Call `current-time', preferring ticks-hertz if available." + (erc-compat--current-lisp-time)) + +(defvar erc--current-time-pair nil + "Override return value for function of the same name.") + +(define-inline erc--current-time-pair () + "Return lisp timestamp in preferred form." + (inline-quote (or erc--current-time-pair + (funcall erc--current-time-pair-function)))) + (defun erc-downcase (string) "Return a downcased copy of STRING with properties. Use the CASEMAPPING ISUPPORT parameter to determine the style." diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 558da5b196f..abff1515561 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -428,6 +428,102 @@ erc-compat--current-lisp-time '(let (current-time-list) (current-time)) '(current-time))) +(declare-function decoded-time-set-defaults "time-date" + (time &optional default-zone)) +(declare-function iso8601-parse "iso8601" (string &optional form)) +(declare-function timezone-make-date-arpa-standard "timezone" + (date &optional local timezone)) + +(defun erc-compat--iso8601-to-time (date &optional form) + "Convert DATE to a timestamp with subsecond precision. +On Emacs 29+, always prefer the (TICKS . HZ) form, even for +stamps lacking a fractional component, meaning they represent the +instant a whole second transpired, on the dot. Expect DATE to be +`iso8601-valid-p' and FORM something accepted by `decode-time'." + (require 'iso8601) + (when (= emacs-major-version 27) + (advice-add 'iso8601-parse-time :override + #'erc-compat--27-iso8601-parse-time)) + (let* ((post-convert-p (< emacs-major-version 29)) + (stamp (condition-case _ + (unwind-protect + (let ((parsed (iso8601-parse date form))) + ;; On 29+, coerce stamps with trailing + ;; zeroes to (TICKS . HZ) form + (unless (consp (car parsed)) + (setq post-convert-p t)) + (when (decoded-time-year parsed) + (decoded-time-set-defaults parsed)) + (encode-time parsed)) + (when (= emacs-major-version 27) + (advice-remove 'iso8601-parse-time + #'erc-compat--27-iso8601-parse-time))) + ;; On <29, trailing fractional 0s, like + ;; "01:00:23.000", cause (truncate -1.0e+INF). + (overflow-error + (let* ((ts (timezone-make-date-arpa-standard date)) + (parsed (if (>= emacs-major-version 29) + (parse-time-string ts form) + (parse-time-string ts)))) + (encode-time parsed)))))) + (if post-convert-p + (time-convert stamp (>= emacs-major-version 29)) + stamp))) + +(declare-function iso8601--match "iso8601" (regexp string)) +(declare-function iso8601--decimalize "iso8601" (fraction base)) +(declare-function iso8601--decoded-time "iso8601" (&rest rest)) +(declare-function iso8601-parse-zone "iso8601" (string)) + +(defun erc-compat--27-iso8601-parse-time (string &optional form) + "Parse STRING, which should be an ISO 8601 time string. +See `decode-time' for the meaning of FORM." + (defvar iso8601--full-time-match) + (defvar iso8601--time-match) + (require 'iso8601) + (cl-assert (= 27 emacs-major-version)) + (if (not (iso8601--match iso8601--full-time-match string)) + (signal 'wrong-type-argument (list string)) + (let ((time (match-string 1 string)) + (zone (match-string 2 string))) + (if (not (iso8601--match iso8601--time-match time)) + (signal 'wrong-type-argument (list string)) + (let ((hour (string-to-number (match-string 1 time))) + (minute (and (match-string 2 time) + (string-to-number (match-string 2 time)))) + (second (and (match-string 3 time) + (string-to-number (match-string 3 time)))) + (frac-string (match-string 4 time)) + fraction fraction-precision) + (when frac-string + ;; Remove trailing zeroes. + (setq frac-string + (replace-regexp-in-string "0+\\'" "" frac-string)) + (when (length> frac-string 0) + (setq fraction (string-to-number frac-string) + fraction-precision (length frac-string)))) + (when (and fraction + (eq form t)) + (cond + ;; Sub-second time. + (second + (setq second (cons (+ (* second (expt 10 fraction-precision)) + fraction) + (expt 10 fraction-precision)))) + ;; Fractional minute. + (minute + (setq second (iso8601--decimalize fraction 60))) + (hour + ;; Fractional hour. + (setq minute (iso8601--decimalize fraction 60))))) + (iso8601--decoded-time :hour hour + :minute (or minute 0) + :second (or second 0) + :dst (if (= (length zone) 1) nil -1) + :zone (and zone + (* 60 (iso8601-parse-zone + zone))))))))) + (defmacro erc-compat--defer-format-spec-in-buffer (&rest spec) "Transform SPEC forms into functions that run in the current buffer. For convenience, ensure function wrappers return \"\" as a diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index d49cf8f05e7..3ad761ddd99 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -209,13 +209,10 @@ erc-stamp--current-time Specifically, this is the same Lisp time object used to create the stamp passed to `erc-insert-timestamp-function'.") -(cl-defgeneric erc-stamp--current-time () +(defun erc-stamp--current-time () "Return a Lisp time object to associate with an IRC message. This becomes the message's `erc--ts' text property." - (erc-compat--current-lisp-time)) - -(cl-defmethod erc-stamp--current-time :around () - (or erc-stamp--current-time (cl-call-next-method))) + (or erc-stamp--current-time (erc--current-time-pair))) (defvar erc-stamp--allow-unmanaged-p nil "Non-nil means run `erc-add-timestamp' almost unconditionally. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c4a4df1c936..1ea97b0bc2f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4206,8 +4206,7 @@ erc-send-input-line "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))) + (erc--update-cusr-message-time (cdr cmem) (erc--current-time-pair))) (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n")) (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) @@ -7432,8 +7431,7 @@ erc--create-current-channel-member info)) (let ((cusr (erc-channel-user--make :status (or status 0) - :last-message-time (and timep - (erc-compat--current-lisp-time))))) + :last-message-time (and timep (erc--current-time-pair))))) (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 @@ -7456,8 +7454,7 @@ erc--update-current-channel-member (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))) + (erc--update-cusr-message-time cusr (erc--current-time-pair))) ;; 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)) @@ -7553,6 +7550,12 @@ erc-update-channel-topic (t (setq erc-channel-topic topic))) (erc-update-mode-line-buffer (current-buffer)))) +(defun erc--update-cusr-message-time (cusr new-time) + "Maybe update message time for `erc-channel-user' CUSR to NEW-TIME." + (let ((old-time (erc-channel-user-last-message-time cusr))) + (when (or (null old-time) (time-less-p old-time new-time)) + (setf (erc-channel-user-last-message-time cusr) new-time)))) + (defun erc-set-modes (tgt mode-string) "Set the modes for the TGT provided as MODE-STRING." (declare (obsolete "see comment atop `erc--update-modes'" "30.1")) diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index 13a3e107d38..97dbeb4e9f8 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -31,11 +31,6 @@ (require 'erc-tests-common))) (defvar erc-fill-tests--buffers nil) -(defvar erc-fill-tests--current-time-value nil) - -(cl-defmethod erc-stamp--current-time - (&context (erc-fill-tests--current-time-value integer)) - erc-fill-tests--current-time-value) (defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) @@ -56,7 +51,7 @@ erc-fill-tests--wrap-populate (erc-fill-function 'erc-fill-wrap) (pre-command-hook pre-command-hook) (inhibit-message noninteractive) - (erc-fill-tests--current-time-value 0) + (erc-stamp--current-time 0) erc-insert-post-hook extended-command-history erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) @@ -219,7 +214,7 @@ erc-fill-wrap--merge ;; Set this here so that the first few messages are from 1970. ;; Following the current date stamp, the speaker isn't merged ;; even though it's continued: "<bob> zero." - (let ((erc-fill-tests--current-time-value 1680332400)) + (let ((erc-stamp--current-time 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "alice" "one.") (erc-fill-tests--insert-privmsg "alice" "two.") @@ -255,7 +250,7 @@ erc-fill-wrap-tests--merge-action (lambda () ;; Allow prior messages to be from 1970. - (let ((erc-fill-tests--current-time-value 1680332400)) + (let ((erc-stamp--current-time 1680332400)) (erc-fill-tests--insert-privmsg "bob" "zero.") (erc-fill-tests--insert-privmsg "bob" "0.5") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b8bc453f498..a38ddc2aa05 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4131,4 +4131,19 @@ erc--ensure-server-user-info (when noninteractive (kill-buffer)))) +(ert-deftest erc-compat--iso8601-to-time () + + ;; This first one is just for comparison. + (should (equal (erc-compat--iso8601-to-time "2023-09-23T07:48:02.933Z" t) + (if (>= emacs-major-version 29) + '(1695455282933 . 1000) + '(25870 38962 933000 0)))) + + ;; Notice the <29 version retains 0s for its micro and pico fields, + ;; which doesn't normally happen when encoding a decoded time obj. + (should (equal (erc-compat--iso8601-to-time "2023-09-23T07:48:02.000Z" t) + (if (>= emacs-major-version 29) + '(1695455282 . 1) + '(25870 38962 0 0))))) + ;;; erc-tests.el ends here -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0013-WIP-Make-erc-insert-line-overridable.patch From 142e0921da66064e0660d192957c38ac3a83dbc8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 18 Jul 2021 04:33:17 -0700 Subject: [PATCH 13/17] [WIP] Make erc-insert-line overridable ;; FIXME update stale change log before merging. ;; See note in "Make ERC response handling more flexible" regarding ;; generics. The same applies here. * lisp/erc/erc-goodies.el (erc-scrolltobottom-confirm): Also recenter when inserting above `erc--insert-marker'. * lisp/erc/erc.el (erc-insert-line): Make obsolete, move body to new internal generic function `erc--insert-line'. (erc--insert-line): Add new generic function to take the place of the now deprecated `erc-insert-line'. (erc--route-insertion): Suppress obsolete warning when calling `erc-insert-line'. (erc--partition-prefixed-names): Convert to generic method. (erc--send-input-lines): Convert to generic function to allow modules control over fundamental insertion and sending operations, which is necessary for next-generation features, like multiline messages. --- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 17 +++++++++++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 5da13409842..1a0ae836523 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -209,7 +209,7 @@ erc--scrolltobottom-confirm (let ((resize-mini-windows nil)) (save-restriction (widen) - (when (>= (window-point) erc-input-marker) + (when (>= (window-point) (or erc--insert-marker erc-input-marker)) (save-excursion (goto-char (point-max)) (recenter (+ (or scroll-to 0) (or erc-input-line-position -1))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 1ea97b0bc2f..c455ae66431 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3538,8 +3538,16 @@ erc-insert-line STRING, which may make it appear incongruous in situ (unless preformatted or anticipated by third-party members of the various modification hooks)." + (declare (obsolete "use higher-level `erc-display-message'" "30.1")) (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) + (erc--insert-line string)))) + +(cl-defmethod erc--insert-line (string) + "Perform work historically done by `erc-insert-line'. +This is always called in the buffer where STRING is to be inserted." + (progn ; Preserve indentation until next major refactoring + (progn (let (insert-position) ;; Initialize ^ below to thwart rogue `erc-insert-pre-hook' ;; members that dare to modify the buffer's length. @@ -3553,7 +3561,7 @@ erc-insert-line '(invisible intangible) string))) (erc-log (concat "erc-display-message: " string (format "(%S)" string) " in buffer " - (format "%s" buffer))) + (format "%s" (current-buffer)))) (setq erc-insert-this t) (run-hook-with-args 'erc-insert-pre-hook string) (setq insert-position (marker-position (or erc--insert-marker @@ -3645,7 +3653,8 @@ erc--route-insertion (when (buffer-live-p buf) (when msg-props (setq erc--msg-props (copy-hash-table msg-props))) - (erc-insert-line string buf) + (with-suppressed-warnings ((obsolete erc-insert-line)) + (erc-insert-line string buf)) (setq seen t))) (unless (or seen (null buffer)) (erc--route-insertion string nil)))) @@ -7263,7 +7272,7 @@ erc-channel-members-changed-hook :group 'erc-hooks :type 'hook) -(defun erc--partition-prefixed-names (name) +(cl-defmethod 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) @@ -8425,7 +8434,7 @@ erc--run-send-hooks (user-error "Multiline command detected" )) lines-obj) -(defun erc--send-input-lines (lines-obj) +(cl-defmethod erc--send-input-lines (lines-obj) "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (let ((insertp (erc--input-split-insertp lines-obj)) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0014-WIP-Fix-some-message-display-bugs-in-erc-backend.patch From da149328fed3b591035626bfd0fea873aa6169af Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 29 Feb 2024 21:14:53 -0800 Subject: [PATCH 14/17] [WIP] Fix some message display bugs in erc-backend * lisp/erc/erc-backend.el (erc-server-PART): Fix thinko involving positional arguments where a channel would be displayed twice when a trailing reason was absent. (erc-server-353): Receive names before inserting message so that insertion hooks have the latest user information. Return nil so that user code wanting to run afterwards on the handler hook can do so, since the return value of `erc-display-message' is undefined. --- lisp/erc/erc-backend.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 4bc3f1de66d..af82434f37b 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2037,7 +2037,8 @@ erc--wrangle-query-buffers-on-nick-change (define-erc-response-handler (PART) "Handle part messages." nil (let* ((chnl (car (erc-response.command-args parsed))) - (reason (erc-trim-string (erc-response.contents parsed))) + (reason (erc-trim-string (and (cdr (erc-response.command-args parsed)) + (erc-response.contents parsed)))) (buffer (erc-get-buffer chnl proc))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) @@ -2713,11 +2714,12 @@ erc--extract-352-full-name "NAMES notice." nil (let ((channel (nth 2 (erc-response.command-args parsed))) (users (erc-response.contents parsed))) + (erc-with-buffer (channel proc) + (erc-channel-receive-names users)) (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) 'active) - 's353 ?c channel ?u users) - (erc-with-buffer (channel proc) - (erc-channel-receive-names users)))) + 's353 ?c channel ?u users)) + nil) (define-erc-response-handler (366) "End of NAMES." nil -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0015-WIP-Add-macro-for-creating-lazy-struct-accessors-in-.patch From f96004d4299c64432a7ab4786c81f226b0249f46 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 4 Mar 2024 06:15:31 -0800 Subject: [PATCH 15/17] [WIP] Add macro for creating lazy struct accessors in ERC * lisp/erc/erc-common.el (erc--define-lazy-accessors): New macro. (erc--define-lazy-struct): New macro. It's often handy to use an alternate constructor for cl-struct types that encapsulates common slot-setup code, primarily for maintainability. This macro leverages the double-hyphen naming convention for internal symbols to define a set of internal "lazy" slots and a corresponding set of "public" single-hyphenated accessors to initialize them on first use. The slots can still be accessed directly through the "real" double-hyphenated accessors. One downside to such redundancy is that definitions obviously create twice the amount of byte code as a normal `cl-defstruct'. * test/lisp/erc/erc-tests.el (erc-tests--my-struct): New struct type for testing purposes. (erc--define-lazy-struct-accessors): New test. --- lisp/erc/erc-common.el | 142 +++++++++++++++++++++++++++++++++++++ test/lisp/erc/erc-tests.el | 46 ++++++++++++ 2 files changed, 188 insertions(+) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index f01dea1c54c..92082af2bcb 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -720,6 +720,148 @@ erc--doarray (cl-incf ,i)) ,(nth 2 spec)))) +;; Despite `require'ing `cl-lib' at the top of this file we still incur +;; warnings that these may not be defined at runtime. +(declare-function cl-struct-slot-info "cl-macs" (struct-type)) +(declare-function cl-struct-slot-offset "cl-macs" (struct-type slot-name)) + +(defmacro erc--define-lazy-accessors (name parent-name sentinel &rest parts) + ;; The struct NAME will already be defined so long as this macro call + ;; appears after NAME's definition. + (declare (indent 3)) + (let ((val-var (make-symbol "val")) + (place-var (make-symbol "place")) + (defuns ()) + (supers ())) + ;; Add an alias for slots of parent not in PARTS. + (when parent-name + (dolist (slot (cdr (cl-struct-slot-info name))) + (when-let* + ((slot-name (car slot)) + ((null (assq slot-name parts))) + (acsr (intern (format "%s-%s" name slot-name)))) + (let ((acsr-par (intern-soft (format "%s-%s" parent-name slot-name))) + (acsr-priv (intern (format "%s--%s" name slot-name)))) + (push (list slot-name acsr (if (and acsr-par (fboundp acsr-par)) + acsr-par + acsr-priv)) + supers)))) + (setq parts (append parts supers))) + (pcase-dolist (`(,slot ,acsr ,acsr-priv ,init-form, inst-var) parts) + ;; For readability and slightly smaller byte code, forgo type + ;; checking and just call `aset' and `aref' directly. In + ;; anecdotal trials, it doesn't significantly improve performance. + ;; Also ensure that wherever `init-form' appears, `inst-var' is + ;; bound to the instance object. + (push + (if-let* ((inst-var) + (offset (cl-struct-slot-offset name slot)) + (esc-var (list backquote-unquote-symbol inst-var))) + ;; Define an explicit expander because `gv-get' doesn't seem + ;; to like an `aset' for the last form of the body. + `(define-inline ,acsr (,inst-var) + ,(concat + (format "Access slot \"%s\" of `%s' INSTANCE." slot name) + "\nAs a side effect, also initialize the slot if unset.") + (declare + (gv-expander + (lambda (do) + (funcall + do (,backquote-backquote-symbol + (let* ((,place-var ,esc-var) + (,val-var (aref ,place-var ,offset))) + (if (eq ,val-var ,sentinel) + (aset ,place-var ,offset + (let ((,inst-var ,place-var)) ,init-form)) + ,val-var))) + (lambda (val) + (,backquote-backquote-symbol + (aset ,esc-var ,offset + (,backquote-unquote-symbol val)))))))) + (inline-letevals (,inst-var) + (inline-quote + (let ((,val-var (aref ,esc-var ,offset))) + (if (eq ,val-var ,sentinel) + (aset ,esc-var ,offset (let ((,inst-var ,esc-var)) + ,init-form)) + ,val-var))))) + `(defalias ',acsr #',acsr-priv)) + defuns)) + ;; Macros referencing these functions need this evaluated. + `(eval-and-compile ,@defuns))) + +(defmacro erc--define-lazy-struct (name-and-options &rest slots) + "Define a cl-struct capable of lazily initializing its slots. +Expect NAME-AND-OPTIONS to be either a symbol with which to NAME the +struct or a list headed by NAME and followed by `cl-defstruct' OPTIONS. +Expect SLOTS to be a list of the struct's slot definitions, with those +intended for lazy initialization marked by a nonstandard `:lazy' keyword +\(more on that below). For each lazy SLOT in SLOTS, create an +\"internal\" (double-hyphenated) accessor function named NAME--SLOT as +well as a \"public\" accessor function, NAME-SLOT, that defers +initialization until first use. If OPTIONS contains an :include +directive, alias public accessors for slots not appearing in SLOTS to +the parent's corresponding public accessors. + +Example usage: + (erc--define-lazy-struct my-struct + (foo (+ 1 2 3) :type integer) + (bar (+ 4 5 6) :type integer :lazy t) + (baz (my-struct-p inst) :type boolean :lazy inst)) + +When code calls (my-struct-bar INSTANCE) for the first time, ERC +initializes INSTANCE's `bar' slot with the result of its initialization +form, (+ 4 5 6). On subsequent calls, ERC returns the stashed value. +The same goes for `baz', except its init form references the current +instance. ERC treats slot `foo' as a normal, non-lazy slot." + (declare (indent defun)) + (cl-assert cl--struct-inline) + (let* ((name (car (ensure-list name-and-options))) + (sentinel (intern (format "%s-empty" name))) + (options (and (listp name-and-options) (cdr name-and-options))) + (parent-name (cadr (assq :include options))) + ;; + def-parts adjusted-slots) + (cl-assert (null (assq :conc-name options))) + (push `(:conc-name ,(intern (concat (symbol-name name) "--"))) options) + ;; Process slots, massaging those marked as `:lazy' for deferred + ;; initialization. + (dolist (slot slots) + (if-let* (((consp slot)) + (found (memq :lazy slot))) + (pcase-let ((`(,slot-name ,init-form . ,rest) slot)) + (setq rest (append (butlast rest (length found)) (cddr found))) + (let ((inst-var (cadr found)) + (acsr (intern (format "%s-%s" name slot-name))) + (acsr-priv (intern (format "%s--%s" name slot-name)))) + ;; Create an internal instance variable if none was given. + (when (or (memq inst-var '(nil t)) (keywordp inst-var) + (not (symbolp inst-var))) + (setq inst-var (make-symbol "inst-var"))) + (push `(,slot-name ,acsr ,acsr-priv ,init-form, inst-var) + def-parts) + (setq slot `(,slot-name ,sentinel ,@rest)))) + ;; Arrange for aliasing accessors for normal slots. + (let* ((slot-name (car (ensure-list slot))) + (acsr (intern (format "%s-%s" name slot-name))) + (acsr-priv (intern (format "%s--%s" name slot-name)))) + (push (list slot-name acsr acsr-priv) def-parts))) + (push slot adjusted-slots)) + `(progn + ;; Define a unique special variable to represent the + ;; "uninitialized" state for slots of this type alone. + (defvar ,sentinel (make-symbol "--uninitialized--")) + (cl-defstruct ,(cons name options) + ,(format (concat "An %s type with lazy slot initialization." + "\nSee `erc--define-lazy-struct' for usage.") + name) + ,@(nreverse adjusted-slots)) + ;; Couch definitions that depend on record offsets from the above + ;; `cl-defstruct' in a separate macro. + (erc--define-lazy-accessors ,name ,parent-name ,sentinel + ,@(nreverse def-parts)) + ',name))) + (provide 'erc-common) ;;; erc-common.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index a38ddc2aa05..27bf9abfda2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3982,6 +3982,52 @@ define-erc-module--local (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) +(erc--define-lazy-struct erc-tests--my-struct + (foo (list 1 2 3) :type (list-of integer)) + (bar (erc-tests--my-struct-p o) :lazy o)) + +(ert-deftest erc--define-lazy-accessors () + :tags '(:unstable) + + ;; Ensure asserted input matches generated form. + (let ((def (car (last (macroexpand + '(erc--define-lazy-struct erc-tests--my-struct + (foo (list 1 2 3) :type (list-of integer)) + (bar (erc-tests--my-struct-p o) :lazy o))) + 2)))) + (should (equal def + '(erc--define-lazy-accessors erc-tests--my-struct nil + erc-tests--my-struct-empty + (foo erc-tests--my-struct-foo erc-tests--my-struct--foo) + (bar erc-tests--my-struct-bar erc-tests--my-struct--bar + (erc-tests--my-struct-p o) o)))) + + (should + (equal + (read (prin1-to-string (macroexpand-1 def))) + '(eval-and-compile + (define-inline erc-tests--my-struct-bar (o) + "Access slot \"bar\" of `erc-tests--my-struct' INSTANCE. +As a side effect, also initialize the slot if unset." + (declare (gv-expander + (lambda (do) + (funcall do + `(let* ((place ,o) + (val (aref place 2))) + (if (eq val erc-tests--my-struct-empty) + (aset place 2 + (let ((o place)) + (erc-tests--my-struct-p o))) + val)) + (lambda (val) `(aset ,o 2 ,val)))))) + (inline-letevals (o) + (inline-quote + (let ((val (aref ,o 2))) + (if (eq val erc-tests--my-struct-empty) + (aset ,o 2 (let ((o ,o)) (erc-tests--my-struct-p o))) + val))))) + (defalias 'erc-tests--my-struct-foo #'erc-tests--my-struct--foo)))))) + (ert-deftest erc-tests-common-string-to-propertized-parts () :tags '(:unstable) ; only run this locally (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'")) -- 2.51.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0016-WIP-Use-bespoke-per-response-handler-data-classes-in.patch From d1aa4eb4aff03bc7e551e61ea4c48e1c729f73ce Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 29 Feb 2024 21:14:53 -0800 Subject: [PATCH 16/17] [WIP] Use bespoke per-response-handler data classes in ERC ;; FIXME update stale change log before merging. ;; FIXME if excluding this patch for 49860, ensure TOPIC handler uses time tag instead of current time. * lisp/erc/erc-backend.el (erc-call-hooks): Defer to specialized parsing function for special response object if available. (erc--zresponse): New struct. (erc--ztargeted): New struct. (erc--zstatused): New struct for PRIVMSG, NOTICE, and TAGMSG. (erc--define-zresponse): New macro. (erc--zJOIN): Define struct for storing structured JOIN data to be shared among JOIN handlers. (erc-server-JOIN): Use `erc--zJOIN'. (erc--zKICK): New struct. (erc-server-KICK): Use `erc--zKICK'. (erc--zMODE): New struct. (erc-server-MODE): Use `erc--zMODE'. (erc--zNICK): New struct. (erc--rename-query-buffer): New function. (erc-server-NICK): Use `erc--zNICK' and `erc--rename-query-buffer'. (erc--zPART): New struct. (erc--zPRIVMSG): Define structure to encapsulate parsed PRIVMSG data. (erc-server-PRIVMSG): Use zPRIVMSG accessors. (erc--zQUIT): New struct. (erc--zTOPIC): New struct. Call `format-time-string' with actual message time. * test/lisp/erc/erc-tests.el (erc-message): Adapt tests to use `erc--zPRIVMSG-from-response' function for parsing PRIVMSG responses. * test/lisp/erc/erc-tests.el (erc--zPRIVMSG): New test. --- lisp/erc/erc-backend.el | 315 ++++++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 32 +++- 2 files changed, 271 insertions(+), 76 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index af82434f37b..6b96b295df1 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -195,6 +195,9 @@ erc-verbose-server-ping (channel nick new-nick &optional add voice halfop op admin owner host login full-name info update-message-time)) +(declare-function erc-update-current-channel-member "erc" + (nick new-nick &optional addp voice halfop op admin owner + host login full-name info update-message-time account)) (declare-function erc-update-user-nick "erc" (nick &optional new-nick host login full-name info account)) @@ -1628,7 +1631,9 @@ erc-get-hook (gethash (format (if (numberp command) "%03i" "%s") command) erc-server-responses)) -(defvar erc--parsed-response nil) +(defvar erc--parsed-response nil + "Instance of an `erc-response' non-nil during response handling. +May also be a subtype, such as an `erc--zreponse'.") (defun erc-call-hooks (process message) "Call hooks associated with MESSAGE in PROCESS. @@ -1638,6 +1643,8 @@ erc-call-hooks (erc--msg-prop-overrides erc--msg-prop-overrides) (hook (or (erc-get-hook (erc-response.command message)) 'erc-default-server-functions))) + (when-let* ((zresp-makr (get hook 'erc--zresponse-constructor))) + (setq erc--parsed-response (funcall zresp-makr message))) (run-hook-with-args-until-success hook process message) ;; Some handlers, like `erc-cmd-JOIN', open new targets without ;; saving excursion, and `erc-open' sets the current buffer. @@ -1837,6 +1844,95 @@ define-erc-response-handler `(defvar ,var #',fn-name ,(format hook-doc a)) `(put ',var 'definition-name ',hook-name)))))) +;; Abstract base response. +(erc--define-lazy-struct (erc--zresponse (:include erc-response)) + ( nuh (erc-parse-user (erc-response.sender parsed)) + :type cons :lazy parsed + :documentation "Triple of (NICK USER HOST) from `erc-parse-user'.") + ( nick-d (erc-downcase (car (erc--zresponse-nuh parsed))) + :type string :lazy parsed + :documentation "Downcased nickname parsed from sender (source).") + ( userhost (let ((nick (car (erc--zresponse-nuh parsed)))) + (if (string= nick (erc-response.sender parsed)) + nick + (substring (erc-response.sender parsed) (1+ (length nick))))) + :type string :lazy parsed + :documentation "Original userhost from sender (source).") + ( mynick-d (erc-downcase (erc-current-nick)) + :type string :lazy t + :documentation "Current (possibly stale) downcased nickname.") + ( self-p (string= (erc--zresponse-nick-d parsed) + (erc--zresponse-mynick-d parsed)) + :type boolean :lazy parsed + :documentation "Non-nil if client's current nick is the sender.") + ( time (erc--time-pair-from-time-tag parsed) + :type list :lazy parsed + :documentation "A lisp-time ticks-hertz pair if non-nil.") + ( time-str (or (alist-get 'time (erc-response.tags parsed)) + (format-time-string "%FT%T.%3NZ" + (or (erc--zresponse-time parsed) + erc--current-time-pair + (erc--current-lisp-time)) + t)) + :type string :lazy parsed + :documentation "Time string from `time' tag or `erc--current-lisp-time'.")) + +(erc--define-lazy-struct (erc--ztargeted (:include erc--zresponse)) + ( target (car (erc-response.command-args parsed)) + :type string :lazy parsed + :documentation "Target of the message: a nick or a channel.")) + +(erc--define-lazy-struct (erc--zstatused (:include erc--zresponse)) + ( target (if (erc--zstatused-statusmsg parsed) + (substring (car (erc-response.command-args parsed)) 1) + (car (erc-response.command-args parsed))) + :type string :lazy parsed + :documentation "Target of the message: a nick or a channel.") + ( statusmsg (and-let* ((target (car (erc-response.command-args parsed))) + ((erc--statusmsg-target target))) + (substring target 0 1)) + :type (or string null) :lazy parsed + :documentation "Target's \"STATUSMSG\" prefix, if any.")) + +(defmacro erc--define-zresponse (command-or-numeric &rest slots) + "Define a \"lazy\" data struct inheriting from `erc-response'. +Look for and honor a plist of zero or more zresponse-compatible +cl-struct OPTIONS at the beginning of SLOTS, followed by zero or more +LAZYSLOTS, which should contain non-nil default fields for deferred +initialization, and append a (:lazy parsed) keyword pair to each slot +definition." + (declare (indent 1)) + (setq command-or-numeric + (mapcar (lambda (c) (if (numberp c) (intern (format "%03i" c)) c)) + (ensure-list command-or-numeric))) + (let* ((name (intern (format "erc--z%s" (car command-or-numeric)))) + (constructor (intern (format "%s-from-parsed" name))) + (puts (mapcar (lambda (c) + `(put ',(intern (format "erc-server-%s-functions" c)) + 'erc--zresponse-constructor #',constructor)) + command-or-numeric)) + (options `(,@(let (options) + (while (keywordp (car slots)) + (push (list (pop slots) (pop slots)) options)) + (unless (assq :include options) + (push '(:include erc--zresponse) options)) + options) + (:constructor + ,constructor + (p &aux + (unparsed (erc-response.unparsed p)) + (sender (erc-response.sender p)) + (command (erc-response.command p)) + (command-args (erc-response.command-args p)) + (contents (erc-response.contents p)) + (tags (erc-response.tags p)))))) + (form (macroexpand + `(erc--define-lazy-struct (,name ,@options) + ,@(mapcar (lambda (s) `(,@s :lazy parsed)) slots))))) + `(progn + ,@puts + ,@(macroexp-unprogn form)))) + (define-erc-response-handler (ERROR) "Handle an ERROR command from the server." nil (setq erc-server-error-occurred t) @@ -1864,55 +1960,74 @@ erc--server-determine-join-display-context alist `((erc-buffer-display . JOIN) ,@alist))) +(erc--define-zresponse (JOIN) + :include erc--ztargeted + ( buffer (if-let* ((target (erc--ztargeted-target parsed)) + ((erc--zresponse-self-p parsed)) + (erc--display-context + (erc--server-determine-join-display-context + target erc--display-context))) + (save-excursion (erc--open-target target)) + (erc-get-buffer target erc-server-process)) + :type buffer + :documentation "Buffer of the joined channel.")) + +;; FIXME it's possible a JOIN message's target buffer already exists +;; and is thought to be joined, even though it isn't. This can +;; happen, for example, when a bouncer loses its upstream connection +;; and resends JOINs upon reconnecting. Measures should be taken to +;; update the joined status and run related hooks so that modules can +;; react to such changes. (define-erc-response-handler (JOIN) - "Handle join messages." + "Handle \"JOIN\" messages." nil + (unless (erc--zJOIN-p parsed) + (setq parsed (or erc--parsed-response (erc--zJOIN-from-parsed parsed)))) (let ((chnl (erc-response.contents parsed)) (buffer nil)) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) + (erc--zJOIN-nuh parsed))) ;; strip the stupid combined JOIN facility (IRC 2.9) (if (string-match "^\\(.*\\)\^g.*$" chnl) - (setq chnl (match-string 1 chnl))) - (save-excursion + (setf chnl (match-string 1 chnl) + (erc--zJOIN-target parsed) chnl)) + (with-current-buffer (setq buffer (erc--zJOIN-buffer parsed)) (let ((args (cond ;; If I have joined a channel - ((erc-current-nick-p nick) - (let ((erc--display-context - (erc--server-determine-join-display-context - chnl erc--display-context))) - (setq buffer (erc--open-target chnl))) - (when buffer - (set-buffer buffer) - (with-suppressed-warnings - ((obsolete erc-add-default-channel)) - (erc-add-default-channel chnl)) - (setf (erc--target-channel-joined-p erc--target) t) - (erc-server-send (format "MODE %s" chnl))) - (erc-with-buffer (chnl proc) - (erc-channel-begin-receiving-names)) + ((erc--zJOIN-self-p parsed) + (with-suppressed-warnings + ((obsolete erc-add-default-channel)) + (erc-add-default-channel chnl)) + (setf (erc--target-channel-joined-p erc--target) t) + (erc-server-send (format "MODE %s" chnl)) + (erc-channel-begin-receiving-names) (erc-update-mode-line) (run-hooks 'erc-join-hook) (list 'JOIN-you ?c chnl)) (t - (setq buffer (erc-get-buffer chnl proc)) (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) - (when buffer (set-buffer buffer)) - (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) + (erc-update-current-channel-member nick nick t nil nil nil nil nil + host login) (unless (erc-current-nick-p nick) (erc--ensure-query-member nick)) - ;; on join, we want to stay in the new channel buffer - ;;(set-buffer ob) (apply #'erc-display-message parsed 'notice buffer args)))))) +(erc--define-zresponse (KICK) + :include erc--ztargeted + ( buffer (erc-get-buffer (erc--ztargeted-target parsed) erc-server-process) + :type buffer + :documentation "Buffer of the affected channel.")) + (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil - (let* ((ch (nth 0 (erc-response.command-args parsed))) + (unless (erc--zKICK-p parsed) + (setq parsed (or erc--parsed-response (erc--zKICK-from-parsed parsed)))) + (let* ((ch (erc--zKICK-target parsed)) (tgt (nth 1 (erc-response.command-args parsed))) (reason (erc-trim-string (erc-response.contents parsed))) - (buffer (erc-get-buffer ch proc))) + (buffer (erc--zKICK-buffer parsed))) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) + (erc--zKICK-nuh parsed))) (cond ((string= tgt (erc-current-nick)) (erc-display-message @@ -1925,7 +2040,7 @@ erc--server-determine-join-display-context (with-suppressed-warnings ((obsolete erc-delete-default-channel)) (erc-delete-default-channel ch buffer)) (erc-update-mode-line buffer)) - ((string= nick (erc-current-nick)) + ((erc--zKICK-self-p parsed) (erc-display-message parsed 'notice buffer 'KICK-by-you ?k tgt ?c ch ?r reason) @@ -1936,30 +2051,40 @@ erc--server-determine-join-display-context (erc-remove-channel-member buffer tgt))))) nil) +(erc--define-zresponse (MODE) + :include erc--ztargeted + ( buffer (and-let* (((not (erc--zMODE-user-p parsed))) + (target (erc--ztargeted-target parsed)) + (buffer (erc-get-buffer target erc-server-process))) + (cl-assert (erc-channel-p buffer)) + buffer) + :type (or null buffer) + :documentation "Buffer of the affected channel, if any.") + ( user-p (erc-current-nick-p (erc--ztargeted-target parsed)) + :type boolean)) + (define-erc-response-handler (MODE) "Handle server mode changes." nil - (let ((tgt (car (erc-response.command-args parsed))) + (unless (erc--zMODE-p parsed) + (setq parsed (or erc--parsed-response (erc--zMODE-from-parsed parsed)))) + (let ((tgt (erc--zMODE-target parsed)) (mode (mapconcat #'identity (cdr (erc-response.command-args parsed)) " "))) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) + (erc--zMODE-nuh parsed))) (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) - ;; dirty hack - (let ((buf (cond ((erc-channel-p tgt) - (erc-get-buffer tgt proc)) - ((string= tgt (erc-current-nick)) nil) - ((erc-active-buffer) (erc-active-buffer)) - (t (erc-get-buffer tgt))))) - (with-current-buffer (or buf - (current-buffer)) + (let ((buf (or (erc--zMODE-buffer parsed) + (and (erc--zMODE-user-p parsed) (current-buffer)) + (error "Could not find buffer for %S" tgt)))) + (with-current-buffer buf (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 - ?t tgt ?m mode) + (if (or (string= login "") (string= host "")) (erc-display-message parsed 'notice buf - 'MODE ?n nick ?u login - ?h host ?t tgt ?m mode))))) + 'MODE-nick ?n nick + ?t tgt ?m mode) + (erc-display-message parsed 'notice buf + 'MODE ?n nick ?u login + ?h host ?t tgt ?m mode))))) nil) (defun erc--wrangle-query-buffers-on-nick-change (old new) @@ -1993,12 +2118,16 @@ erc--wrangle-query-buffers-on-nick-change (erc-update-mode-line))) buffers)) +(erc--define-zresponse (NICK)) + (define-erc-response-handler (NICK) "Handle nick change messages." nil + (unless (erc--zNICK-p parsed) + (setq parsed (or erc--parsed-response (erc--zNICK-from-parsed parsed)))) (let ((nn (erc-response.contents parsed)) bufs) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) + (erc--zNICK-nuh parsed))) (setq bufs (erc-buffer-list-with-nick nick proc)) (erc-log (format "NICK: %s -> %s" nick nn)) ;; if we had a query with this user, make sure future messages will be @@ -2011,7 +2140,7 @@ erc--wrangle-query-buffers-on-nick-change (cl-pushnew buf bufs)) (erc-update-user-nick nick nn host login) (cond - ((string= nick (erc-current-nick)) + ((erc--zNICK-self-p parsed) (cl-pushnew (erc-server-buffer) bufs) ;; Show message in all query buffers. (setq bufs (append (erc--query-list) bufs)) @@ -2034,8 +2163,17 @@ erc--wrangle-query-buffers-on-nick-change (erc-display-message parsed 'notice bufs 'NICK ?n nick ?u login ?h host ?N nn)))))) +(erc--define-zresponse (PART) + :include erc--ztargeted + ( buffer (let ((target (erc--ztargeted-target parsed))) + (erc-get-buffer target erc-server-process)) + :type buffer + :documentation "Buffer of the channel being parted.")) + (define-erc-response-handler (PART) "Handle part messages." nil + (unless (erc--zPART-p parsed) + (setq parsed (or erc--parsed-response (erc--zPART-from-parsed parsed)))) (let* ((chnl (car (erc-response.command-args parsed))) (reason (erc-trim-string (and (cdr (erc-response.command-args parsed)) (erc-response.contents parsed)))) @@ -2049,7 +2187,7 @@ erc--wrangle-query-buffers-on-nick-change 'PART ?n nick ?u login ?h host ?c chnl ?r (or reason "")) (cond - ((string= nick (erc-current-nick)) + ((erc--zPART-self-p parsed) (run-hook-with-args 'erc-part-hook buffer) (erc-with-buffer (buffer) @@ -2096,6 +2234,7 @@ erc--statusmsg-target ((not (eq erc-ensure-target-buffer-on-privmsg 'status))) ((not (erc-channel-p target))) (chars (erc--get-isupport-entry 'STATUSMSG 'single)) + ((not (string-empty-p target))) ((string-search (string (aref target 0)) chars)) (trimmed (substring target 1)) ((erc-channel-p trimmed))) @@ -2150,11 +2289,35 @@ erc--message-speaker-catalog (defvar erc--speaker-status-prefix-wanted-p (gensym "erc-") "Sentinel to detect whether `erc-format-@nick' has just run.") +(erc--define-zresponse (PRIVMSG NOTICE) + :include erc--zstatused + ;; Unlike with erc--zJOIN, this init form can't ensure a buffer + ;; exists because an inordinate amount of conditions must be met. + ;; It follows that this field will be empty in buffer-init hooks, + ;; like `erc-connect-pre-hook' for new queries. + ( buffer (erc-get-buffer (if (erc--zPRIVMSG-query-p parsed) + (car (erc--zresponse-nuh parsed)) + (erc--zstatused-target parsed)) + erc-server-process) + :type buffer) + ( query-p (equal (erc-downcase (erc--zstatused-target parsed)) + (erc--zresponse-mynick-d parsed)) + :type boolean) + ( speaker (car (erc--zPRIVMSG-nuh parsed)) + :type string) + ( notice-p (string= (erc-response.command parsed) "NOTICE") + :type boolean) + ( input-p (string= (erc--zPRIVMSG-mynick-d parsed) + (car (erc--zPRIVMSG-nuh parsed))) + :type boolean)) + (define-erc-response-handler (PRIVMSG NOTICE) "Handle private messages, including messages in channels." nil + (unless (erc--zPRIVMSG-p parsed) + (setq parsed (or erc--parsed-response (erc--zPRIVMSG-from-parsed parsed)))) (let ((sender-spec (erc-response.sender parsed)) (cmd (erc-response.command parsed)) - (tgt (car (erc-response.command-args parsed))) + (tgt (erc--zPRIVMSG-target parsed)) (msg (erc-response.contents parsed))) (defvar erc-minibuffer-ignored) (defvar erc-ignore-list) @@ -2163,24 +2326,24 @@ erc--speaker-status-prefix-wanted-p (and erc-ignore-reply-list (erc-ignored-reply-p msg tgt proc))) (when erc-minibuffer-ignored (message "Ignored %s from %s to %s" cmd sender-spec tgt)) - (let* ((sndr (erc-parse-user sender-spec)) + (let* ((sndr (erc--zPRIVMSG-nuh parsed)) (nick (nth 0 sndr)) (login (nth 1 sndr)) (host (nth 2 sndr)) - (msgp (string= cmd "PRIVMSG")) - (noticep (string= cmd "NOTICE")) + (noticep (erc--zPRIVMSG-notice-p parsed)) + (msgp (not noticep)) ;; S.B. downcase *both* tgt and current nick - (medown (erc-downcase (erc-current-nick))) - (inputp (string= medown (erc-downcase nick))) - (privp (string= (erc-downcase tgt) medown)) + (inputp (erc--zPRIVMSG-input-p parsed)) + (privp (erc--zPRIVMSG-query-p parsed)) (erc--display-context `((erc-buffer-display . ,(intern cmd)) ,@erc--display-context)) (erc--msg-prop-overrides `((erc--tmp) ,@erc--msg-prop-overrides)) (erc--speaker-status-prefix-wanted-p nil) (erc-current-message-catalog erc--message-speaker-catalog) + (statusmsg (erc--zPRIVMSG-statusmsg parsed)) ;; - finalize buffer statusmsg cmem-prefix fnick) - (setq buffer (erc-get-buffer (if privp nick tgt) proc)) + finalize buffer cmem-prefix fnick) + (setq buffer (erc--zPRIVMSG-buffer parsed)) ;; Even worth checking for empty target here? (invalid anyway) (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)) (erc-is-message-ctcp-and-not-action-p msg)) @@ -2196,15 +2359,12 @@ erc--speaker-status-prefix-wanted-p (push `(erc-receive-query-display . ,(intern cmd)) erc--display-context) (setq buffer (erc--open-target nick))) - (cond - ;; Target is a channel and contains leading @+ chars. - ((and-let* ((trimmed(erc--statusmsg-target tgt))) - (setq buffer (erc-get-buffer trimmed proc) - statusmsg (and buffer (substring tgt 0 1))))) - ;; A channel buffer has been killed but is still joined. - (erc-ensure-target-buffer-on-privmsg - (setq buffer (erc--open-target tgt)))))) + ;; A channel buffer has been killed but is still joined. + ;; Or, an "echoed" query has arrived from self to other. + (when erc-ensure-target-buffer-on-privmsg + (setq buffer (erc--open-target tgt))))) (when buffer + (setf (erc--zPRIVMSG-buffer parsed) buffer) ; may have changed (with-current-buffer buffer (when privp (erc--unhide-prompt) @@ -2259,13 +2419,17 @@ erc--speaker-status-prefix-wanted-p (when finalize (funcall finalize))) nil)))) +(erc--define-zresponse (QUIT)) + (define-erc-response-handler (QUIT) "Another user has quit IRC." nil + (unless (erc--zQUIT-p parsed) + (setq parsed (or erc--parsed-response (erc--zQUIT-from-parsed parsed)))) (let ((reason (erc-response.contents parsed)) (erc--msg-prop-overrides erc--msg-prop-overrides) bufs) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) + (erc--zQUIT-nuh parsed))) (setq bufs (erc-buffer-list-with-nick nick proc)) (when (erc-current-nick-p nick) (setq bufs (append (erc--query-list) bufs)) @@ -2277,16 +2441,27 @@ erc--speaker-status-prefix-wanted-p (erc-remove-user nick))) nil) +(erc--define-zresponse (TOPIC) + :include erc--ztargeted + ( buffer (let ((target (erc--ztargeted-target parsed))) + (erc-get-buffer target erc-server-process)) + :type buffer + :documentation "Buffer of the channel whose topic is being set.")) + (define-erc-response-handler (TOPIC) "The channel topic has changed." nil - (let* ((ch (car (erc-response.command-args parsed))) + (unless (erc--zTOPIC-p parsed) + (setq parsed (or erc--parsed-response (erc--zTOPIC-from-parsed parsed)))) + (let* ((ch (erc--zTOPIC-target parsed)) (topic (erc-trim-string (erc-response.contents parsed))) - (time (format-time-string erc-server-timestamp-format))) + (time (format-time-string erc-server-timestamp-format + (erc--zTOPIC-time parsed)))) (pcase-let ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) - (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login) + (erc--zTOPIC-nuh parsed))) + (erc-update-channel-member ch nick nick nil nil nil nil nil nil + host login) (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) - (erc-display-message parsed 'notice (erc-get-buffer ch proc) + (erc-display-message parsed 'notice (erc--zTOPIC-buffer parsed) 'TOPIC ?n nick ?u login ?h host ?c ch ?T topic)))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 27bf9abfda2..f6a8d40748f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2554,12 +2554,13 @@ erc-message (erc-update-current-channel-member "tester" "tester")) (with-current-buffer "ExampleNet" - (erc-server-PRIVMSG erc-server-process - (make-erc-response - :sender "[email protected]" - :command "PRIVMSG" - :command-args '("#chan" "hi") - :unparsed ":[email protected] PRIVMSG #chan :hi")) + (let ((parsed (make-erc-response + :sender "[email protected]" + :command "PRIVMSG" + :command-args '("#chan" "hi") + :unparsed ":[email protected] PRIVMSG #chan :hi"))) + (erc-server-PRIVMSG erc-server-process + (erc--zPRIVMSG-from-parsed parsed))) (should (equal erc-server-last-peers '("alice"))) (should (string-match "<alice>" (pop calls)))) @@ -4028,6 +4029,25 @@ erc--define-lazy-accessors val))))) (defalias 'erc-tests--my-struct-foo #'erc-tests--my-struct--foo)))))) +;; This applies to all erc--zresponse objects. +(ert-deftest erc--zPRIVMSG () + (let* ((inst (make-erc--zPRIVMSG :sender "foo")) + (foo (list 42 inst [42]))) + ;; GV place. + (should (equal '(1 "foo" "" "") (push 1 (erc--zPRIVMSG-nuh (nth 1 foo))))) + (should (equal (erc--zPRIVMSG-nuh inst) '(1 "foo" "" ""))) + (should (equal (erc--zPRIVMSG-speaker inst) 1)) + + ;; Initialized value always reused rather than derived again. + (should (eql 1 (pop (erc--zPRIVMSG-nuh (nth 1 foo))))) + (should (eql 2 (cl-incf (erc--zPRIVMSG-speaker (nth 1 foo))))) + (should (equal (erc--zPRIVMSG-nuh inst) '("foo" "" ""))) + (should (eql 2 (erc--zPRIVMSG-speaker inst))) + + ;; Normal setf. + (should (equal (setf (car (erc--zPRIVMSG-nuh (nth 1 foo))) "bar") "bar")) + (should (equal (erc--zPRIVMSG-nuh inst) '("bar" "" ""))))) + (ert-deftest erc-tests-common-string-to-propertized-parts () :tags '(:unstable) ; only run this locally (unless (>= emacs-major-version 28) (ert-skip "Missing `object-intervals'")) -- 2.51.0 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0017-WIP-Add-IRCv3-building-blocks-to-ERC.patch Content-Transfer-Encoding: quoted-printable From 5309a7882a731f26bbf502d2e7a368c60327ede6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 12 Jul 2021 04:03:42 -0700 Subject: [PATCH 17/17] [WIP] Add IRCv3 building blocks to ERC ;; FIXME update stale change log before merging. * lisp/erc/erc-v3.el: New file. * lisp/erc/erc.el (erc-modules): Add `v3' module. * test/lisp/erc/erc-scenarios-v3-account-notify.el: New file. * test/lisp/erc/erc-scenarios-v3-sasl.el: New file. * test/lisp/erc/erc-scenarios-v3.el: New file. * test/lisp/erc/erc-tests.el (erc-tests--modules): Add `v3'. * test/lisp/erc/erc-v3-tests.el: New file. * test/lisp/erc/resources/erc-scenarios-common.el: (erc-scenarios-common--nick-at-point): New function. * test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld: New file * test/lisp/erc/resources/v3/account-notify/no-extended-join.eld: New file. * test/lisp/erc/resources/v3/away-notify/basic.eld: New file. * test/lisp/erc/resources/v3/cap-notify/basic.eld: New file. * test/lisp/erc/resources/v3/echo-message/basic.eld: New file. * test/lisp/erc/resources/v3/extended-join/basic.eld: New file. * test/lisp/erc/resources/v3/multi-prefix/basic.eld: New file. * test/lisp/erc/resources/v3/sasl/plain-failed.eld: New file. * test/lisp/erc/resources/v3/sasl/plain-unsupported.eld: New file. * test/lisp/erc/resources/v3/sasl/plain.eld: New file. * test/lisp/erc/resources/v3/sasl/scram-sha-1.eld: New file. * test/lisp/erc/resources/v3/sasl/scram-sha-256.eld: New file. * test/lisp/erc/resources/v3/server-time/basic.eld: New file. * test/lisp/erc/resources/v3/userhost-in-names/basic.eld: New file. * test/lisp/erc/resources/v3/whox/basic.eld: New file. * test/lisp/erc/resources/v3/whox/rate-limited.eld: New file. (Bug#49860) --- lisp/erc/erc-v3.el | 2454 +++++++++++++++++ lisp/erc/erc.el | 1 + .../erc/erc-scenarios-v3-account-notify.el | 133 + test/lisp/erc/erc-scenarios-v3-sasl.el | 199 ++ test/lisp/erc/erc-scenarios-v3.el | 587 ++++ test/lisp/erc/erc-tests.el | 1 + test/lisp/erc/erc-v3-tests.el | 1364 +++++++++ .../erc/resources/erc-scenarios-common.el | 25 + .../account-notify/chghost-no-account-tag.eld | 77 + .../v3/account-notify/no-extended-join.eld | 50 + .../erc/resources/v3/away-notify/basic.eld | 63 + .../erc/resources/v3/cap-notify/basic.eld | 66 + .../erc/resources/v3/echo-message/basic.eld | 74 + .../erc/resources/v3/extended-join/basic.eld | 56 + .../erc/resources/v3/multi-prefix/basic.eld | 51 + .../erc/resources/v3/sasl/plain-failed.eld | 18 + .../resources/v3/sasl/plain-unsupported.eld | 7 + test/lisp/erc/resources/v3/sasl/plain.eld | 39 + .../erc/resources/v3/sasl/scram-sha-1.eld | 51 + .../erc/resources/v3/sasl/scram-sha-256.eld | 51 + .../erc/resources/v3/server-time/basic.eld | 57 + .../resources/v3/userhost-in-names/basic.eld | 49 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 24 files changed, 5694 insertions(+) create mode 100644 lisp/erc/erc-v3.el create mode 100644 test/lisp/erc/erc-scenarios-v3-account-notify.el create mode 100644 test/lisp/erc/erc-scenarios-v3-sasl.el create mode 100644 test/lisp/erc/erc-scenarios-v3.el create mode 100644 test/lisp/erc/erc-v3-tests.el create mode 100644 test/lisp/erc/resources/v3/account-notify/chghost-no-ac= count-tag.eld create mode 100644 test/lisp/erc/resources/v3/account-notify/no-extended-j= oin.eld create mode 100644 test/lisp/erc/resources/v3/away-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/cap-notify/basic.eld create mode 100644 test/lisp/erc/resources/v3/echo-message/basic.eld create mode 100644 test/lisp/erc/resources/v3/extended-join/basic.eld create mode 100644 test/lisp/erc/resources/v3/multi-prefix/basic.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-failed.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain-unsupported.eld create mode 100644 test/lisp/erc/resources/v3/sasl/plain.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-1.eld create mode 100644 test/lisp/erc/resources/v3/sasl/scram-sha-256.eld create mode 100644 test/lisp/erc/resources/v3/server-time/basic.eld create mode 100644 test/lisp/erc/resources/v3/userhost-in-names/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/basic.eld create mode 100644 test/lisp/erc/resources/v3/whox/rate-limited.eld diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el new file mode 100644 index 00000000000..34c85696093 --- /dev/null +++ b/lisp/erc/erc-v3.el @@ -0,0 +1,2454 @@ +;;; erc-v3.el --- IRCv3 support for ERC -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2025 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/>. + +;;; Commentary: + +;; This file adds IRCv3 capability negotiation [1] in accordance with +;; version 302 of the spec. It provides a module called `v3' that must +;; be present in `erc-modules' for any IRCv3 features to come to life. +;; All extensions requested by default live in this file. Other +;; IRCv3-related libraries may exist in the ERC tree, and some may +;; contain multiple related extensions. Feature names may not contain +;; the letters "v3", but you can grep for "erc-v3--define" to find them. +;; +;; Unfortunately, there is currently no public library API. +;; +;; [1] https://ircv3.github.io/specs/core/capability-negotiation.html + +;;; Code: +(require 'erc) +(eval-when-compile (require 'erc-sasl)) + +(defgroup erc-v3 nil + "IRCv3 extensions for ERC." + :group 'erc + :package-version '(ERC . "5.7")) ; FIXME sync on release + +(defcustom erc-v3-extensions '(account-tag + echo-message + standard-replies) + "List of extensions to enable for a given session. +In addition to these, ERC attempts to enable all foundational extensions +listed in `erc-v3-base-extensions'. Members of the combined set +represent implementations of IRCv3 specifications, some of which may not +define a corresponding \"requestable\" capability. Extensions with +dependencies need them to also be members of the set." + :type '(set (const account-tag) + (const echo-message) + (const sasl) + (const standard-replies))) + +(defconst erc-v3-base-extensions + '(account-notify + away-notify + cap-notify + chghost + extended-join + extended-monitor + message-tags + multi-prefix + server-time + setname + userhost-in-names + ;; Non-caps + whox + monitor) + "Hard-coded essentials that IRCv3 depends on for basic functionality. +ERC attempts to enable these unconditionally when advertised.") + +(cl-defstruct erc-v3--caps + "Data related to capability negotiation." + ( continued nil + ;; This assumes replies won't be intermingled for adjacent requests. + :documentation "Stashed arguments from a continued LS or LIST reply." + :type (list-of cons)) + ( extensions nil + :documentation "Snapshot of desired canonical extensions on init." + :type (list-of symbol) + :read-only t) + ( objects nil + :documentation "List of `erc-v3--extension' sorted objects." + :type (list-of erc-v3--extension)) + ( queue-out nil + :documentation "Subset of OBJECTS slot used for outgoing requests." + :type list) + ( queue-in nil + :documentation "List of (HANDLER . CAP) for current round of ACK/NAKs." + :type (list-of cons)) + ( timer nil + :documentation "Registration request timer." + :type (or null timer)) + ( negotiated-p nil + :documentation "Non-nil when CAP END has been sent." + :type bool)) + +(defvar-local erc-v3--caps nil + "Unique `erc-v3--caps' object for server process. +Local to the server buffer.") + +;; Could also generate intermediate edges for a less verbose +;; representation. +(defmacro erc-v3--make-edges (name body) + "Define a `defconst' for all unique states in transition graph BODY. +Expect BODY to be an alist of members like (state . transitions) where +transitions is a list of triples of the form (event state phase). +Define a new `defvar' NAME whose value is a copy of BODY with all state +symbols replaced by their generated counterparts." + (declare (indent 1)) + (let* ((states ()) + (events ()) + (phases ()) + (entries + (mapcar + (pcase-lambda (`(,in . ,next)) + (cl-pushnew in states) + `(,@(list (list '\, (intern (format "erc-v3--state-%s" in)))) + ,@(mapcar + (pcase-lambda (`(,event ,out ,phase)) + (cl-pushnew out states) + (cl-pushnew event events) + (cl-pushnew phase phases) + `(,(list '\, (intern (format "erc-v3--event-%s" event)= )) + ,(list '\, (intern (format "erc-v3--state-%s" out))) + ,(list '\, (intern (format "erc-v3--phase-%s" phase)= )))) + next))) + body))) + `(progn + ,@(let (out) + (pcase-dolist (`(,kind . ,items) + (list (cons 'event events) + (cons 'phase phases) + (cons 'state (sort states #'string-lessp))= )) + (push (mapcar + (lambda (s) + `(defconst ,(intern (format "erc-v3--%s-%s" kind s)) + (make-symbol ,(symbol-name s)))) + items) + out)) + (apply #'nconc out)) + (defvar ,name + ,(list '\` entries))))) + +;; States: +;; Server {u: unknown/unavail, a: avail/passive, i: cap enabled} +;; Wanted {o: off, i: on, e: err} +;; Mode {o: off, i: on, e: err} +;; Pending {u: n/a, a: avail, y: queued, o: REQ-, i: REQ+, e: err} +;; +;; Events: +;; mOK: calling extension's mode command succeeds (+1 or -1) +;; mERR: error calling extension's mode command (+1 or -1) +;; pIN: all replies from last round of REQs received +;; pOUT: all requests for new round of REQs ready to be sent +;; pERR: request timed out +;; wON: extension object created on module init +;; wOK: pre-flight validation/prep succeeded +;; wERR: application error during activation inc. timed out +;; s005: 005 received relevant to ISUPPORT-centric extension +;; sACK (sNAK, sDEL, sLS, sNEW): server command received +;; +;; Phases: +;; nil: default value on new struct instance +;; INIT: instantiate, record whether extension is initially wanted +;; TRACK: remember advertised (w. key and value for caps) +;; CHECK: dependencies, validate advertised values, etc. +;; QOUT: mark as needing REQ to be sent +;; QIN: mark as REQ reply needing processing +;; SEND: (possibly negated) REQ sent to server +;; UP: attempt to enable extension's minor mode and dependencies +;; DOWN: attempt to disable extension's minor mode and dependents +;; LOG: insert user-facing "error notice" in server buffer +;; RUN, PASS: do nothing +;; S_-W_-M_-P_ +;; Symbol-name indexes used in related predicates: .1..4..7..a + +(erc-v3--make-edges erc-v3--edges + ;; Unavailable and unwanted (non-cap) extension + ((Su-Wo-Mo-Pu (wON Su-Wi-Mo-Pu INIT) ; new struct on module init + (s005 Sa-Wo-Mo-Pu TRACK)) ; unwanted ISUPPORT-based (1) + ;; Unavailable but wanted (non-cap) extension + (Su-Wi-Mo-Pu (s005 Sa-Wi-Mo-Pu CHECK)) ; wanted ISUPPORT-based + ;; Available and wanted (non-cap) extension + (Sa-Wi-Mo-Pu (mOK Sa-Wi-Mi-Pu RUN) ; minor-mode up success + (mERR Sa-We-Mo-Pu LOG) ; minor-mode up failure (2) + (wERR Sa-We-Mo-Pu LOG)) ; validation failure (2) + ;; Unavailable and unwanted capability + (Su-Wo-Mo-Pa (wON Su-Wi-Mo-Pa INIT) ; new struct on module init + (sLS Sa-Wo-Mo-Pa TRACK) ; passive update, k/v stored + (sNEW Sa-Wo-Mo-Pa TRACK)) ; same as ^ + ;; Available but unwanted capability + (Sa-Wo-Mo-Pa (sDEL Su-Wo-Mo-Pa PASS)) ; server makes unavailable + ;; Unavailable but wanted capability + (Su-Wi-Mo-Pa (sLS Sa-Wi-Mo-Pa CHECK) ; needs pre-flight REQ+ check + (sNEW Sa-Wi-Mo-Pa CHECK)) ; same as ^ + ;; Available and wanted capability + (Sa-Wi-Mo-Pa (wOK Sa-Wi-Mo-Py QOUT) ; check passed, queue as REQ+ + (wERR Sa-We-Mo-Pa LOG)) ; check failed, non-fatal log + ;; Available and wanted capability awaiting outgoing request + (Sa-Wi-Mo-Py (pOUT Sa-Wi-Mo-Pi SEND)) ; send REQ+/-, clear queue + ;; Available and wanted capability awaiting reply + (Sa-Wi-Mo-Pi (sACK Si-Wi-Mo-Py QIN) ; server enabled, queue sync + (sNAK Sa-We-Mo-Py QIN) ; request denied, needs attn (5) + (pERR Su-Wi-Mo-Pe LOG)) ; timeout or transport error (2) + ;; Provided and wanted capability awaiting processing + (Si-Wi-Mo-Py (pIN Si-Wi-Mo-Pa UP) ; REQs all received, do sync + (wERR Sa-We-Mo-Pa LOG)) ; log fatal, e.g., SASL 904 + ;; Available but tainted capability awaiting processing + (Sa-We-Mo-Py (pIN Sa-We-Mo-Pa LOG)) ; log rejection + ;; Provided and wanted capability awaiting local sync + (Si-Wi-Mo-Pa (mOK Si-Wi-Mi-Pa RUN) ; minor-mode +1 sync succeeded + (mERR Si-Wi-Me-Py QOUT)) ; minor-mode +1 sync failed + ;; Provided and wanted cap with activation taint awaiting server sync + (Si-Wi-Me-Py (pOUT Si-Wi-Me-Po SEND)) ; sent REQ- (3) + ;; Provided and wanted cap with activation taint awaiting reply + (Si-Wi-Me-Po (sACK Sa-Wi-Me-Py QIN) ; queue to log error from sync (3) + (sNAK Sa-We-Me-Py QIN) ; rejected REQ-, queue log (3) + (pERR Su-Wi-Me-Pe LOG)) ; REQ- timed out, log (3) + ;; Available and wanted cap with activation taint awaiting processing + (Sa-Wi-Me-Py (pIN Sa-Wi-Me-Pa LOG)) ; log error for *good* REQ- (3) + ;; Available and doubly tainted capability awaiting ingress processing + (Sa-We-Me-Py (pIN Sa-We-Me-Pa LOG)) ; log error for rejected REQ- (3) + ;; Provided, wanted, and active capability (idle) + (Si-Wi-Mi-Pa (sDEL Su-Wi-Mi-Pa DOWN)) ; server mandate to sync down + ;; Unavailable but wanted and active cap awaiting immediate local sync + (Su-Wi-Mi-Pa (mOK Su-Wi-Mo-Pa PASS) ; mode -1 success + (mERR Su-Wi-Me-Pa LOG)))) ; mode -1 failed (2) + +;; Notes for transition table above: +;; 1. Currently not possible because WHOX and MONITOR are hard-coded +;; 2. Not currently part of test suite but plausible +;; 3. Possibly temporary for demo purposes. See `erc-v3--ensure-enabled'. +;; 4. Unlikely, though possible and covered by tests; could be removed +;; 5. Possibly unreachable unless pathological + +(cl-defstruct erc-v3--extension + "\"Abstract class\" for basic info relevant to an IRCv3 extension. +If the `initp' slot's \"init form\" evaluates non-nil when activating +`erc-v3-mode' in a server buffer, ERC marks the extension as being +\"wanted\". By default, this happens if the extension's name appears in +the value of the option `erc-v3-extensions'. Then, if the server +advertises support during negotiation (or sometimes beyond), ERC enables +the extension's associated minor mode via `erc-v3--ensure-enabled'." + ( canon nil + :type symbol ; :allocation class + :read-only t + :documentation "Name in specification as a canonical symbol.") + ( depends nil ; :allocation class + :type (list-of symbol) + :documentation "Hard dependencies as canonical symbols.") + ( supports nil ; merged with ^ when loading + :type (list-of symbol) + :documentation "Optional dependencies loaded first if possible.") + ( aliases nil ; :allocation class + :type (list-of symbol) + :documentation "Alternate names for the same extension.") + ( event nil + :type symbol + :documentation "Last event triggering the current state and phase.") + ( state erc-v3--state-Su-Wo-Mo-Pu + :type symbol + :documentation "Internal symbol representing current negotiation state= .") + ( phase nil + :type symbol + :documentation "Associated phase from latest transition output.") + ( history nil + :type list + :documentation "Append-only snapshot of past states at every transitio= n.") + ( initp (erc-v3--init-p) + :type boolean + :documentation "Whether ERC should attempt to enable this extension.")) + +(cl-defstruct (erc-v3--capability (:include erc-v3--extension + (state erc-v3--state-Su-Wo-Mo-= Pa))) + "\"Abstract class\" for info relevant to an IRCv3 capability. +ERC populates the `key' and `val' slots from pairs advertised during +negotiation. The set of reachable events and states stored in the +`event' and `state' slots is almost entirely unique." + ;; It wouldn't make sense to move `key' and `val' to the base + ;; extension class and overload it to accommodate ISUPPORT parameters + ;; because one extension can be associated with multiple parameters. + ( key nil + :type symbol + :documentation "Name used by server. Must be in (CANON . ALIASES).") + ( val nil + :type (or string null) + :documentation "Value advertised by server, if any.")) + +(defvar erc-v3--init-p nil) + +(defun erc-v3--init-p () + "Non-nil if extension name or alias appears in `erc-v3-extensions'. +Only valid on module init in server buffers." + (declare (ftype (function () boolean))) + (and erc-v3--init-p t)) + +;; This function only exists so it can be instrumented to find +;; unreachable transitions that can be pruned from `erc-v3--edges'. +;; Always use `erc-v3--transition' instead. See related comment in +;; tests. +(defun erc-v3--get-state (state event) + "Return transition triple keyed by EVENT in entry for STATE in graph." + (declare (ftype (function (symbol symbol) list))) + (and-let* ((events (alist-get state erc-v3--edges)) + ((alist-get event events))))) + +(defun erc-v3--log-state-error (ext) + "Display error for `erc-v3--extension' EXT if its phase is `log'." + (when (eq (erc-v3--extension-phase ext) erc-v3--phase-LOG) + (let ((name (if (erc-v3--capability-p ext) + (erc-v3--capability-key ext) + (erc-v3--extension-canon ext)))) + (erc-button--display-error-notice-with-keys + (current-buffer) + "Problem processing extension '%s'. See %s for details." + name (messages-buffer)) + (unless noninteractive + (message "Problem processing extension '%s':" name) + (pp (cons (list :event (erc-v3--extension-event ext) + :state (erc-v3--extension-state ext) + :phase (erc-v3--extension-phase ext)) + (mapcar (pcase-lambda (`(,e ,s ,p)) + (list :event e :state s :phase p)) + (erc-v3--extension-history ext)))))))) + +(defun erc-v3--enqueue-in (extension) + "Add EXTENSION to `erc-v3--caps-queue-in' slot if phase dictates." + (if (eq erc-v3--phase-QIN (erc-v3--extension-phase extension)) + (push (cons (let ((e (erc-v3--extension-event extension))) + (cond ((eq e erc-v3--event-sACK) #'erc-v3--subcmd-ACK) + ((eq e erc-v3--event-sNAK) #'erc-v3--subcmd-NAK) + (t (error "Wrong event: %S" e)))) + extension) + (erc-v3--caps-queue-in erc-v3--caps)))) + +(defun erc-v3--enqueue-out (extension) + "Add EXTENSION to `erc-v3--caps-queue-out' slot if phase dictates." + (if (eq (erc-v3--extension-phase extension) erc-v3--phase-QOUT) + (push extension (erc-v3--caps-queue-out erc-v3--caps)))) + +(defvar erc-v3--transition-functions (list #'erc-v3--enqueue-in + #'erc-v3--enqueue-out + #'erc-v3--log-state-error)) + +(defun erc-v3--transition (ext event) + "Transition `erc-v3--extension' EXT if it accepts EVENT. +Then call `erc-v3--transition-functions' to perform side effects, like +logging and queuing, before returning the new phase symbol." + (declare (ftype (function (erc-v3--extension symbol) symbol))) + (when-let* ((entry (erc-v3--get-state (erc-v3--extension-state ext) even= t))) + (pcase-let* ((`(,state ,phase) entry)) + (cl-assert state) + ;; Add last trio to history before committing the new one. + (push (list (erc-v3--extension-event ext) + (erc-v3--extension-state ext) + (erc-v3--extension-phase ext)) + (erc-v3--extension-history ext)) + (setf (erc-v3--extension-event ext) event + (erc-v3--extension-state ext) state + (erc-v3--extension-phase ext) phase) + (run-hook-with-args 'erc-v3--transition-functions ext) + phase))) + +;; FIXME either cover these with tests or define and use constants for +;; the indexes instead of literal integers. +(defun erc-v3--wanted-p (ext) + "Return non-nil if EXT's state slot has a Wi component." + (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 4))) + +(defun erc-v3--unwanted-p (ext) + "Return non-nil if EXT's state slot has a Wo component." + (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 4))) + +(defun erc-v3--enabled-p (ext) + "Return non-nil if EXT's state slot has a Mi component." + (eq ?i (aref (symbol-name (erc-v3--extension-state ext)) 7))) + +(defun erc-v3--queued-p (ext) + "Return non-nil if EXT's state slot has a Py component." + (eq ?y (aref (symbol-name (erc-v3--extension-state ext)) 10))) + +(defun erc-v3--pending-negated-p (ext) + "Return non-nil if EXT's state slot has a Po component." + (eq ?o (aref (symbol-name (erc-v3--extension-state ext)) 10))) + +(defun erc-v3--error-p (ext) + "Return non-nil if EXT's state slot has a We, Me, or Pe component." + (or (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 4)) + (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 7)) + (eq ?e (aref (symbol-name (erc-v3--extension-state ext)) 10)))) + +(defmacro erc-v3--caps-by-phase (phase) + "Return all extensions whose phase stage matches symbol PHASE." + `(seq-filter (lambda (o) + (eq ,(intern (format "erc-v3--phase-%s" phase)) + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps))) + +(defun erc-v3--sync-mode-value (var value) + "Set VAR in current buffer to server buffer's local VALUE for VAR." + (when-let* ((buf (erc-server-buffer)) + ((or (not (eq buf (current-buffer))) + (not value)))) + (set var (and value (buffer-local-value var buf))))) + +(defmacro erc-v3--define-extension-subclass (default-super body) + "Define a cl-struct and minor mode from DEFAULT-SUPER class and BODY." + (pcase-let* + ((head (pop body)) + (name (if (consp head) (pop head) (prog1 head (setq head nil)))) + (doc (if (stringp (car body)) + (pop body) + (format "IRCv3 `%s' %s." name + (substring (symbol-name default-super) + (length "erc-v3--"))))) + ;; Handle various leading keywords in `body'. + (`(,keymap ,new-slots . ,rev-overs) + (let ((info (cdr (cl-struct-slot-info default-super))) + rev-overs keymap new-slots) + (while (keywordp (car body)) + (pcase-exhaustive (pop body) + (:slots (setq new-slots (pop body))) + (:keymap (setq keymap (pop body))) + ;; Any remaining de-coloned keywords are overriding init + ;; form parameters for the child's `:include' option. + ((and k (let slot (intern-soft (substring (symbol-name k) 1)= )) + (guard (and slot (assq slot info)))) + (push (if (seq-some (lambda (e) + (memq e (ensure-list (car body)))) + '(:type :documentation :read-only)) + (cons slot (pop body)) ; full replacement def + (list slot (pop body))) ; init form + rev-overs)))) + `(,keymap ,new-slots ,@rev-overs))) + (defname (intern (format "erc-v3--%s" name))) + (modname (intern (format "erc-v3--%s-mode" name))) + (overs (reverse rev-overs)) + (inc-def `(:include ,default-super (canon ',name) ,@overs)) + (options (if (keywordp (car (car-safe head))) + (if-let* ((include (alist-get :include head))) + (prog1 head + (unless (assq 'canon include) + (dolist (s `(,@rev-overs (canon ',name))) + (push s (cdr (alist-get :include head)))))) + (push inc-def head)) + (list inc-def)))) + ;; Framework allows other constructors but only calls `defname'. + (setq options `(,@options (:constructor ,defname))) + `(progn + (cl-defstruct (,defname ,@options) + ,doc + ,@new-slots) + ,@(mapcar (lambda (n) + `(put ',n 'erc-v3--extension-class ',defname)) + ;; Find aliases (bar draft/foo) in (quote (bar draft/foo)) + (cons name (cadar (alist-get 'aliases overs)))) + (put ',name 'erc-v3--extension-minor-mode ',modname) + (put ',defname 'erc-v3--extension-canon ',name) + (put ',defname 'erc-v3--extension-super ',default-super) + (defvar-local ,defname nil + ,(format "Local instance of `%s' when enabled." defname)) + (define-minor-mode ,modname + ,(if (stringp (car body)) + (pop body) + (format "Internal minor mode for `%s'." defname)) + :interactive nil + :variable ((buffer-local-value ',defname (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value ',defname v))) + ,@body) + ,@(and keymap `((setf (alist-get ',defname minor-mode-map-alist) + ,keymap)))))) + +(def-edebug-spec erc-v3-extension + (&define [&or symbolp (symbolp &rest sexp)] + [&optional stringp] ; cl-struct doc when present + [&rest [keywordp sexp]] + [&optional stringp] ; minor-mode doc when present + def-body)) + +;; Each extension EXT is a minor mode whose mode variable erc-v3--EXT is +;; normally set to the session's instance of the extension's own +;; `erc-v3--extension'-derived struct of the same name. During module +;; setup, the `erc-v3-mode' "enable body" copies this mode variable's +;; value from the server buffer to the newly created target buffer via +;; the extension's minor-mode command, erc-v3--EXT-mode. +(defmacro erc-v3--define-extension (&rest body) + "Define an `erc-v3--extension'-derived struct and supporting items. +From BODY, create a struct type named erc-v3--NAME with an identically +named constructor, and have it \"subclass\" `erc-v3--extension'. Expect +NAME to be a symbol or, alternatively, a list containing a symbol and +`cl-defstruct' options. If OPTS, which is a span of zero or more +top-level keyword-value pairs, contains a `:slots' keyword, interpret +its paired value as an unquoted alist of `cl-defstruct' slot definitions +suitable for opaque application state. Expect users to favor `:slots' +over local variables for state shared among all buffers of a connection. +If OPTS contains an `:aliases' keyword, interpret its value, a form that +evaluates to a list of symbols, as an overriding default (i.e., +\"initform\", \"sdefault\", etc.) for the resulting class's `aliases' +slot. Moreover, ensure that each member of the list has an +`erc-v3--extension-class' symbol property set to the struct +constructor's symbol, normally erc-v3--NAME, so that ERC can create +equivalent objects from effectively equivalent caps, like `draft/my-cap' +and `my-cap'. Add any other keyword pairs in OPTS matching existing +slots to the superclass' `:include' form in a similar manner. + +Additionally, define a variable sharing the constructor's name, but set +its value to nil, and make it local when set. From this, create an +\"internal\" minor mode with this as its mode variable, and activate it +in all buffers of the connection. Make this mode non-interactive, but +allow a `:keymap' argument in OPTS to specify the minor mode's keymap. +Interpret all forms following the last keyword/value pair or second doc +string as comprising the MODE-BODY. In target buffers, arrange for this +body to run alongside normal local-module activation, where +`erc--target-priors' is populated. In server buffers, have it run +during connection registration, where `erc--server-reconnecting' is +empty and calls to `erc--restore-initialize-priors' ineffective, +although it can also run later if triggered by a \"CAP NEW\". Expect +users to know that modules depended on and activated by a v3 extension +should have no issue sustaining persistent data across reconnects +because ERC adds global modules to `erc-modules' and automatically +reactivates local modules. + +\(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" + (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) + `(erc-v3--define-extension-subclass erc-v3--extension ,body)) + +(defmacro erc-v3--define-capability (&rest body) + "Define an `erc-v3--capability'-derived struct and supporting items. +In almost all respects, act like `erc-v3--define-extension', whose doc +string explains the various parts of BODY. + +\(fn NAME [STRUCT-DOC] [OPTS [MODE-DOC]] [MODE-BODY])" + (declare (doc-string 2) (debug erc-v3-extension) (indent defun)) + `(erc-v3--define-extension-subclass erc-v3--capability ,body)) + +(defun erc-v3--activate-module-for-target () + "Initialize `erc-v3-mode' in a target buffer. +Replicate the server buffer's set of enabled extensions locally by +running their minor-mode commands. Do this in sorted order so that +dependencies come first." + (cl-assert erc--target) + (let ((server-buffer (erc-server-buffer))) + (dolist (cap (erc-v3--caps-objects + (buffer-local-value 'erc-v3--caps server-buffer))) + (when-let* ((canon (erc-v3--extension-canon cap)) + (variable (get canon 'erc-v3--extension-class)) + ((buffer-local-value variable server-buffer)) + (mode (get canon 'erc-v3--extension-minor-mode))) + (funcall mode +1))))) + +(defun erc-v3--activate-module () + "Perform steps to initialize buffer for `erc-v3-mode'. +Create a local `erc-v3--caps' object in the server buffer and populate +its `extensions' slot with a copy of `erc-v3-extensions'." + (cl-assert (null erc--target)) + (let* ((erc-v3-extensions erc-v3-extensions) + (exts (cl-union erc-v3-base-extensions erc-v3-extensions)) + (wanted-constructors ()) + (objects ())) + ;; Load libraries of configured extensions. Additional loading is + ;; not attempted when later reviewing unknown advertised caps. + (dolist (ext exts) + (require (or (get ext 'erc--feature) + (intern (concat "erc-" + (if-let* ((n (symbol-name ext)) + ((string-prefix-p "draft/" n)= )) + (substring n 6) + n)))) + nil 'no-error)) + (setq wanted-constructors ; this must follow loading ^ + (mapcar (lambda (s) (get s 'erc-v3--extension-class)) exts)) + ;; Create objects to track all known extensions. + (dolist (constructor cl-struct-erc-v3--extension-tags) + ;; Skip abstract subtypes, like `erc-v3--capability'. + (when (get constructor 'erc-v3--extension-canon) + (push (let ((erc-v3--init-p (and (memq constructor wanted-construc= tors) + t))) + (funcall constructor)) + objects) + (when (erc-v3--extension-initp (car objects)) + (cl-assert (eq erc-v3--phase-INIT + (erc-v3--transition (car objects) + erc-v3--event-wON)))))) + (setq exts (append erc-v3-base-extensions + (mapcar (lambda (s) + (get (get s 'erc-v3--extension-class) + 'erc-v3--extension-canon)) + erc-v3-extensions)) + objects (erc-v3--deps-tsort objects + (erc-v3--deps-build-dag objects t)) + erc-v3--caps (make-erc-v3--caps :extensions exts :objects object= s)))) + +(define-erc-module v3 nil + "IRCv3 extension support for ERC. +When activating this local module, take steps to ensure capability +negotiation will commence and the necessary bookkeeping performed to +carry the protocol dialog to completion. When deactivating, print an +error message and destroy the entire ERC session. + +Note that in server buffers, `erc-v3-mode-hook' runs before extension +mode variables, like `erc-v3--cap-notify', have been set. Another way +to run code at this juncture is to override an init form in the +extension's definition." + ((unless erc--target + (pcase erc-tags-format + ('legacy + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 is incompatible with an `erc-tags-format' value of" + " `legacy'. Disabling module now...") + (setq erc-v3-mode nil)) + ('overridable + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 overrides legacy `erc-parse-tags' behavior." + " Customize `erc-tags-format' to nil to silence this message."))= )) + (unless (eq erc-tags-format 'legacy) + (if erc--target + (erc-v3--activate-module-for-target) + (erc-v3--activate-module)))) + ;; XXX tearing this down properly is likely not worth implementing + ;; because it would require extensions to provide a cap-negation + ;; implementation. (It's much easier to just destroy the session + ;; and reconnect.) To make this work, you'd have to REQ -foo all + ;; extensions and wait until they're ACK'd before killing relevant + ;; local vars, all while ensuring operations can be run repeatedly. + ((unless erc--target + (erc-button--display-error-notice-with-keys-and-warn + (erc-server-buffer) + "Disabling `erc-v3-mode' is not currently supported." + (and (memq 'v3 erc-modules) + " Please remove v3 from `erc-modules' if unwanted."))) + ;; Although this being a local module makes setting the mode var back + ;; to t technically possible, this practice remains somewhat risky + ;; and experimental until more thoroughly thought through. + (setq erc-v3-mode t)) + localp) + +;; To profile the negotiation sequence, put a `profiler-start' here and +;; a `profiler-stop' in `erc-v3--finish-negotiating'. +(cl-defmethod erc--register-connection (&context (erc-v3-mode (eql t))) + "Start capability negotiation with server when ERC-V3-MODE is non-nil." + (erc-server-send "CAP LS 302") + (erc-login)) + +(defun erc-v3--handle-negotiation-timeout (buffer event) + "Destroy session in server BUFFER and dump info about caps. +Transition all objects with EVENT." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (dolist (o (erc-v3--caps-objects erc-v3--caps)) + (erc-v3--transition o event)) + (delete-process erc-server-process) + (let ((erc-active-buffer buffer)) + (erc-button--display-error-notice-with-keys + buffer "Processing timed out. Destroying session." + " Please report info in %s via \\[erc-bug]." (messages-buffer)) + (pp erc-v3--caps))))) + +(defvar erc-v3--request-timeout-seconds 30 + "Time allowed between last emitted \"REQ\" and last answered.") + +(defvar erc-v3--sync-timeout-seconds 10 + "Time allowed between last answered \"REQ\" and \"END\".") + +(defun erc-v3--run-timer (event secs) + "Run timer SECS seconds from now. +Arrange to call `erc-v3--handle-negotiation-timeout' with EVENT." + (when (erc-v3--caps-timer erc-v3--caps) + (cancel-timer (erc-v3--caps-timer erc-v3--caps))) + (setf (erc-v3--caps-timer erc-v3--caps) + (run-at-time secs nil #'erc-v3--handle-negotiation-timeout + (current-buffer) event))) + +(defun erc-v3--send-requests () + "Request all caps in the `erc-v3--caps-queue-out'. +Create and return a request timer." + (cl-assert (erc-v3--caps-queue-out erc-v3--caps)) + (let (todo) + (while-let ((o (pop (erc-v3--caps-queue-out erc-v3--caps)))) + (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase o))) + (when (eq erc-v3--phase-SEND (erc-v3--transition o erc-v3--event-pOU= T)) + (push (concat (and (erc-v3--pending-negated-p o) "-") + (symbol-name (erc-v3--capability-key o))) + todo))) + (while-let ((todo) + (this (take 10 todo))) + (erc-server-send (format "CAP REQ :%s" (string-join this " "))) + (setq todo (nthcdr 10 todo)))) + (erc-v3--run-timer erc-v3--event-pERR erc-v3--request-timeout-seconds)) + +(defun erc-v3--run-subcmd (key handler) + "Run all \"CAP\" subcmd HANDLERs for capability KEY." + (when-let* ((canon (erc-v3--canon-from-key key)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall handler cap))) + +(defun erc-v3--run-subcmds-piecemeal (subcmd alist) + "Run all SUBCMD handlers for a \"CAP LS\" or a \"CAP NEW\". +Expect ALIST to have members with symbols at the head representing +capabilities." + (pcase-dolist (`(,key . ,_) alist) + (erc-v3--run-subcmd key (pcase-exhaustive subcmd + ('LS #'erc-v3--subcmd-LS) + ('NEW #'erc-v3--subcmd-NEW))))) + +(defun erc-v3--finish-negotiating () + "Finalize \"CAP\" dialog." + (when-let* ((timer (erc-v3--caps-timer erc-v3--caps))) + (cancel-timer timer) + (setf (erc-v3--caps-timer erc-v3--caps) nil)) + (unless (erc-v3--caps-negotiated-p erc-v3--caps) + (erc-server-send "CAP END") + (setf (erc-v3--caps-negotiated-p erc-v3--caps) t))) + +;; FIXME ensure a "CAP NEW" arriving unexpectedly during registration +;; won't cause problems. +(cl-defmethod erc--server-CAP (_proc parsed &context (erc-v3-mode (eql t))) + "Manage a \"CAP\" dialog when ERC-V3-MODE is non-nil. +Handle \"CAP\" subcommands in `erc-response' PARSED, possibly deferring +some for later processing. Do this throughout an IRC session, not only +during connection registration. Skip handlers if PARSED lacks trailing +args but do send queued requests. Always send a \"CAP END\" during +registration if no requests are pending, which may be undesirable in +some cases. Always return nil." + (let* ((subcmd (intern (nth 1 (erc-response.command-args parsed)))) + (contents (if (memq subcmd '(LS LIST)) + (erc-v3--check-continued parsed) ; may be null + (list (erc-response.contents parsed)))) + (server-buffer (current-buffer)) + (pairs ())) + (when contents + (with-temp-buffer + (while-let ((contents (pop contents))) + (insert " " contents)) + (goto-char (point-min)) + (skip-syntax-forward "-") + (while-let (((not (eobp))) + (beg (point)) + ((not (zerop (skip-syntax-forward "^-"))))) + ;; Maybe split token into a k/v pair. + (let* ((end (point)) + (p (and (memq subcmd '(LS NEW)) + (save-excursion (goto-char beg) + (search-forward "=3D" end t)))) + (key (intern (buffer-substring beg (or (and p (1- p)) end= )))) + (val (and p (buffer-substring p end)))) + (with-current-buffer server-buffer + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--mark-offered subcmd key val)) + ((or 'ACK 'NAK) (erc-v3--check-answered subcmd key)) + ('DEL (erc-v3--run-subcmd key #'erc-v3--subcmd-DEL)))) + (push (cons key val) pairs)) + (skip-syntax-forward "-")))) + ;; Perform deferred processing. + (when pairs + (pcase subcmd + ((or 'LS 'NEW) (erc-v3--run-subcmds-piecemeal subcmd (nreverse pai= rs))) + ((or 'ACK 'NAK) (erc-v3--consider-answered)) + ('LIST (erc-v3--handle-subcmd-list parsed (nreverse pairs))) + ('DEL (erc-v3--ensure-disabled (erc-v3--caps-by-phase DOWN)))) + ;; Deal with queued items or finish negotiation. + (cond ((erc-v3--caps-queue-out erc-v3--caps) (erc-v3--send-requests)) + ;; Inhibited ACK/NAK. + ((seq-some #'erc-v3--queued-p (erc-v3--caps-objects erc-v3--ca= ps)) + (cl-assert (erc-v3--caps-by-phase QIN)) + (cl-assert (erc-v3--caps-queue-in erc-v3--caps))) + (t (erc-v3--finish-negotiating))))) + nil) + +(define-erc-response-handler (CAP) + "Handle \"CAP\" response or server-initiated command. +Return nil to allow `erc-call-hooks' to keep going." + nil) + +(defvar erc-message-english-s410 "Invalid CAP subcommand: %s" + "English `erc-format-message' template for key `s410'.") + +;; FIXME destroy session here. +(define-erc-response-handler (410) + "Protocol error 410 (ERR_INVALIDCAPCMD) for unknown subcommand." nil + (erc-display-message parsed '(notice error) (erc-server-buffer) + 's410 ?s (cadr (erc-response.command-args parsed)))) + + +;;;; Dependency sorting + +(defun erc-v3--deps-build-dag (objects &optional softp) + "Return an alist of (DEPENDENCY . DEPENDENTS) from OBJECTS. +Where OBJECTS is a list of `erc--v3-extension' instances. With SOFTP, +include members of the `support' slot." + (let (graph) + (dolist (v objects graph) + (dolist (u-name (if softp ; would be nice to iterate lazily + (append (erc-v3--extension-supports v) + (erc-v3--extension-depends v)) + (erc-v3--extension-depends v))) + (let ((u (cl-find u-name objects :key #'erc-v3--extension-canon))) + (cl-pushnew v (alist-get u graph))))))) + +(defun erc-v3--deps-tsort (objects graph) + "Return `erc-v3--extension' list OBJECTS sorted by GRAPH's dependencies." + (let ((out ())) + (named-let doit ((us objects)) + (dolist (u us) + (unless (memq u out) + (doit (alist-get u graph)) + (push u out)))) + out)) + +(defvar-local erc-v3--session-dag nil) + +(defun erc-v3--deps-gather-dependents (cap &optional filter-predicate) + "Return a subset of `erc-v3--caps-objects' that depend on CAP. +Skip those that don't satisfy FILTER-PREDICATE if given. Populate +`erc-v3--session-dag' via `erc-v3--deps-build-dag' if unset." + (let* ((graph (or erc-v3--session-dag + ;; Thankfully, this signals without `erc-v3--caps'. + (setq erc-v3--session-dag + (erc-v3--deps-build-dag + (erc-v3--caps-objects erc-v3--caps))))) + (seen (list cap)) + (todo (alist-get cap graph)) + out) + (while todo + (let ((next (pop todo))) + (unless (memq next seen) + (push next seen) + (when (or (null filter-predicate) + (funcall filter-predicate next)) + (push next out)) + ;; Still need to explore remaining edges because they might + ;; have transitive hops, right? + (dolist (next (alist-get next graph)) + (push next todo))))) + out)) + + +;;;; Subcommand helpers + +(define-inline erc-v3--cap-negated-p (cap-sym) + "Indicate whether CAP-SYM is negated (has a leading hyphen)." + (inline-quote (eq ?- (aref (symbol-name ,cap-sym) 0)))) + +(defun erc-v3--check-continued (parsed) + "Update the `continued' slot of `erc-v3--caps' from ALIST. +Return the updated value if PARSED response is terminal and not to be +continued." + (let ((contents (push (erc-response.contents parsed) + (erc-v3--caps-continued erc-v3--caps)))) + (unless (string=3D "*" (nth 2 (erc-response.command-args parsed))) + (setf (erc-v3--caps-continued erc-v3--caps) nil) + (nreverse contents)))) + +(defvar erc-message-english-CAP-LIST "Enabled CAPs: %m" + "English `erc-message-template' template for key `CAP-LIST'.") + +(defun erc-v3--handle-subcmd-list (parsed pairs) + "Display PAIRS named for \"LIST\" subcommand in PARSED response." + (when-let* ((m (mapcar (lambda (i) (symbol-name (car i))) pairs))) + (erc-display-message parsed 'notice 'active 'CAP-LIST + ?m (string-join m ", ")))) + +(defun erc-v3--find-capability-by-key (key) + "Return `erc-v3--capability' matching KEY." + (cl-find (erc-v3--canon-from-key key) (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon)) + +(defun erc-v3--subcmd2event (subcmd) + "Return event for SUBCMD." + (pcase-exhaustive subcmd + ('ACK erc-v3--event-sACK) + ('NAK erc-v3--event-sNAK) + ('LS erc-v3--event-sLS) + ('NEW erc-v3--event-sNEW) + ('DEL erc-v3--event-sDEL))) + +(defun erc-v3--mark-offered (subcmd key val) + "Mark cap as ready for checking if named by SUBCMD. +Record KEY and VAL unconditionally, possibly clobbering existing." + (cl-assert (not (erc-v3--cap-negated-p key))) + (when-let* ((o (erc-v3--find-capability-by-key key))) + (cl-assert (erc-v3--capability-p o)) ; not a plain extension + ;; Clobber an existing value even if the cap is already somehow + ;; enabled. + (setf (erc-v3--capability-key o) key + (erc-v3--capability-val o) val) + (erc-v3--transition o (erc-v3--subcmd2event subcmd)))) + +(defun erc-v3--canon-from-key (key) + "Return canonical capability name for KEY." + (when (erc-v3--cap-negated-p key) + (setq key (intern (substring (symbol-name key) 1)))) + (and-let* + ((constructor (get key 'erc-v3--extension-class)) + ;; Skip plain extensions because KEY is from a "CAP" subcmd arg. + ;; `erc-v3--define-extension-subclass' stores the superclass name + ;; as a symbol property of the constructor to avoid having to + ;; search through things like `cl-struct-erc-v3--extension-tags' + ;; or `cl--struct-class-parents'. + (_ (eq 'erc-v3--capability (get constructor 'erc-v3--extension-supe= r)))) + (get constructor 'erc-v3--extension-canon))) + +(defun erc-v3--ensure-deps (extension) + "Check `depends' slot of `erc-v3--extension' EXTENSION. +If dependencies remain unmet, print an error notice and send a `wERR' +into the state machine. Otherwise, transition via `wOK'." + (catch 'done + (dolist (canon (erc-v3--extension-depends extension)) + (when-let* + ((dep (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon)) + ;; Unless dependency is slated to be enabled or already is... + (_ (not (or (memq (erc-v3--extension-phase dep) + (list erc-v3--phase-CHECK erc-v3--phase-QOUT)) + (erc-v3--enabled-p dep))))) + (erc-v3--transition extension erc-v3--event-wERR) + (erc-button--display-error-notice-with-keys + (current-buffer) "Problem resolving dependencies." + " Disabling capability '%s' because of unmet requirement '%s'." + " Try checking option `erc-v3-extensions'." + (erc-v3--capability-key extension) canon) + (throw 'done t))) + (erc-v3--transition extension erc-v3--event-wOK))) + +(defvar erc-v3--fatal-mode-body-failure-p t + "Whether to destroy the session if an extension's mode body signals.") + +;; XXX the attempt to gracefully handle a desync below is just for +;; discussion purposes and will likely be removed, along with related +;; items from the transition table and the test suite. Instead, it +;; should mark the mode as having failed (m=3De) and print a message +;; recommending manual intervention: investigate, /QUIT, report, etc. +(defun erc-v3--ensure-enabled (candidates) + "Enable presorted list of `erc-v3--extension' CANDIDATES. +If a candidate's mode variable is null in any buffer of the connection, +set it to the existing `erc-v3--extension' instance from the `object' +slot of the server buffer's `erc-v3--caps' object, and then call the +equivalent of its \"mode command\"." + (while-let ((cap (pop candidates)) + (variable (get (erc-v3--extension-canon cap) + 'erc-v3--extension-class)) + (mode (get (erc-v3--extension-canon cap) + 'erc-v3--extension-minor-mode))) + ;; Even though extensions are supposed to use the shared struct + ;; for shared state, rogue hooks may blindly assume the "enable + ;; body" always runs first in the server buffer. + (condition-case-unless-debug err + (progn + (unless (symbol-value variable) + (set variable cap) + (funcall mode +1)) + (erc-with-all-buffers-of-server erc-server-process #'erc-target + ;; Unlike some normal minor modes, extensions never disable + ;; themselves if requirements are unmet. + (unless (symbol-value variable) + (funcall mode +1))) + (erc-v3--transition cap erc-v3--event-mOK)) + (error + ;; The remaining members of CANDIDATES that depend on cap must + ;; also be taken offline, in addition to anything already up. + (let* ((others candidates) + (test (lambda (o) + (or (and (erc-v3--enabled-p o) (not (erc-v3--error-p= o))) + (memq o others))))) + (setq candidates nil) ; break loop + (dolist (o (cons cap (erc-v3--deps-gather-dependents cap test))) + (erc-v3--transition o erc-v3--event-mERR) + (let ((mode (get (erc-v3--extension-canon o) + 'erc-v3--extension-minor-mode))) + (erc-button--display-error-notice-with-keys + "Failed to activate %s: %S" mode err) + (if erc-v3--fatal-mode-body-failure-p + (when (eq cap o) + (delete-process erc-server-process)) + (erc-with-all-buffers-of-server erc-server-process nil + (with-demoted-errors "Problem disabling extension: %S" + (funcall mode -1))))))))))) + +(defun erc-v3--ensure-disabled (candidates) + "Disable list of `erc-v3--extension' CANDIDATES and their dependencies. +Do so in reverse-topo order so that the most dependent objects go down +first. Don't attempt to fail gracefully by syncing on mode-command +failure. Destroy the session instead." + (let* ((gathered (delete-dups + `(,@candidates + ,@(mapcan #'erc-v3--deps-gather-dependents candidate= s)))) + (todo (erc-v3--deps-tsort gathered + (erc-v3--deps-build-dag gathered)))) + (dolist (o (nreverse todo)) + (when-let* ((variable (get (erc-v3--extension-canon o) + 'erc-v3--extension-class)) + ((symbol-value variable)) + (mode (get (erc-v3--extension-canon o) + 'erc-v3--extension-minor-mode))) + (set variable nil) + (condition-case-unless-debug err + (progn + (funcall mode -1) + (erc-with-all-buffers-of-server erc-server-process #'erc-tar= get + (funcall mode -1))) + ;; This can happen if an active extension is DEL'd by the + ;; server and its "disable body" signals. + (error + (erc-v3--transition o erc-v3--event-mERR) + (erc-button--display-error-notice-with-keys + "Failed to disable %s properly: %S. ERC is now out of sync wit= h" + " the server and cannot recover." + (if erc-v3--fatal-mode-body-failure-p + (progn (delete-process erc-server-process) " Disconnecting= ...") + "Recommend issuing a /QUIT and investigating.") + mode err))) + (erc-v3--transition o erc-v3--event-mOK))))) + +;; ACK handling is complicated +;; +;; > If an ACK reply originating from the server is spread across +;; > multiple lines, a client MUST NOT change capabilities until the +;; > last ACK of the set is received. +;; +;; What this means is that a server may not send all ACKs for one or +;; more REQs in a single message. (Not to be confused with multi-line +;; LS and LIST responses.) As a consequence of this requirement, the +;; state table gains the "qin" rendezvous, which extensions with special +;; needs, like SASL, can use for suspending the main protocol. + +(defun erc-v3--consider-answered () + "Run subcommand handlers and perform mode (de)activation. +Only do the latter if all queues are empty, and do nothing if all +outstanding \"REQ\"s haven't all been accounted for." + ;; Start a new deadline for processing ACKs. + (unless (seq-some (lambda (o) (eq erc-v3--phase-SEND + (erc-v3--extension-phase o))) + (erc-v3--caps-objects erc-v3--caps)) + (erc-v3--run-timer erc-v3--event-wERR erc-v3--sync-timeout-seconds) + (let ((inhibited ())) + (dolist (item (erc-v3--caps-queue-in erc-v3--caps)) + (funcall (car item) (cdr item)) + ;; Push back if still queued to maintain invariant. + (when (eq erc-v3--phase-QIN (erc-v3--extension-phase (cdr item))) + (push item inhibited))) + (setf (erc-v3--caps-queue-in erc-v3--caps) (nreverse inhibited))) + ;; Check that handlers haven't suspended processing to conduct + ;; external business, such as SASL or `extended-isupport'. + (unless (seq-some #'erc-v3--queued-p (erc-v3--caps-queue-out erc-v3--c= aps)) + ;; Disable negated and DEL'd caps after disabling their dependents. + (when-let* ((down (erc-v3--caps-by-phase DOWN))) + (erc-v3--ensure-disabled down)) + ;; Enable all other caps after their dependencies. + (when-let* ((up (erc-v3--caps-by-phase UP))) + (erc-v3--ensure-enabled up))))) + +(defun erc-v3--check-answered (subcmd key) + "Enqueue KEY's capability to be enabled on SUBCMD \"ACK\". +Or disabled on \"NAK\"." + (let ((cap (erc-v3--find-capability-by-key key))) + (cl-assert (or (eq (erc-v3--cap-negated-p key) (erc-v3--unwanted-p cap= )) + (erc-v3--error-p cap))) + + (cl-assert (eq erc-v3--phase-QIN + (erc-v3--transition cap (erc-v3--subcmd2event subcmd)))= ))) + + +;;;; Subcommand handlers + +;; There's currently no "fallback" LS/NEW handler for unknown caps +;; because the current design views membership in the objects list as +;; immutable. + +;; If ever switching to blind-REQ style without initial CAP LS, move +;; `erc-v3--ensure-deps' call from this handler to the default ACK +;; method and adjust expected negotiation states accordingly. +(cl-defmethod erc-v3--subcmd-LS (capability) + "Handle a \"CAP LS\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--ensure-deps capability)) + +(cl-defmethod erc-v3--subcmd-NEW (capability) + "Handle a \"CAP NEW\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--ensure-deps capability)) + +(cl-defmethod erc-v3--subcmd-DEL (capability) + "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-sDEL)) + +(cl-defmethod erc-v3--subcmd-ACK (capability) + "Handle a \"CAP ACK\" subcommand for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-pIN)) + +(cl-defmethod erc-v3--subcmd-NAK (capability) + "Handle a \"CAP NAK\" subcommand for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-pIN)) + + +;;;; ISUPPORT-based extensions + +;; This is only for simple, old-school extensions associated with a +;; single parameter whose presence advertises support. Not for use with +;; capabilities, like `chathistory', that use ISUPPORT parameters for +;; other purposes. + +(defvar erc-v3--isupport-params '((whox . WHOX) (monitor . MONITOR))) + +(defun erc-v3--check-offered-on-005 (canon param) + "Call handler for extension named CANON with \"ISUPPORT\" PARAM." + (when-let* ((item (erc--get-isupport-entry param)) + (cap (cl-find canon (erc-v3--caps-objects erc-v3--caps) + :key #'erc-v3--extension-canon))) + (funcall #'erc-v3--on-isupport-param cap (car item) (cdr item)))) + +(cl-defmethod erc-v3--on-isupport-param (extension _key _value) + "Call EXTENSION with \"ISUPPORT\" parameter KEY and VALUE." + (when (eq erc-v3--phase-CHECK (erc-v3--transition extension erc-v3--even= t-s005)) + (unless (eq erc-v3--phase-LOG (erc-v3--ensure-deps extension)) + (erc-v3--ensure-enabled (list extension))))) + +(cl-defmethod erc--server-005 (_proc _parsed &context (erc-v3-mode (eql t)= )) + "Run code for params in `erc-v3--isupport-params' in server buffer." + (cl-call-next-method) + (pcase-dolist (`(,canon . ,param) erc-v3--isupport-params) + (erc-v3--check-offered-on-005 canon param))) + + +;;;; Extension: cap-notify + +(erc-v3--define-capability cap-notify) + + +;;;; Extension: multi-prefix + +;; User tables aren't currently updated from /WHOIS responses because +;; servers only send 319, which includes status prefixes, for users in +;; shared channels. And such status info should already be current. + +(erc-v3--define-capability multi-prefix) + +(defvar erc-message-english-s352-v3 "%-11c %-10n %-3s %-2a %u@%h (%f)" + "English `erc-message-template' template for key `s352-v3'.") + +(defun erc-v3--multi-prefix--partition (name statuses) + "Parse NAME as a status-prefixed nick or full NUH. +Use STATUSES to determine the set of valid channel-membership prefixes. +Return a backward-compatible list of (STATUS SUBSET NUH), where STATUS +is the numeric union of all applicable statuses, SUBSET is the string of +enabled status chars, and NUH is the nick or full NUH suffixing NAME." + (declare (ftype (function (string string) list))) + (let ((status 0) + (count 0)) + (catch 'done + (erc--doarray (c name) + (if-let* ((p (erc--strpos c statuses))) + (setq status (logior status (ash 1 p)) + count (1+ count)) + (throw 'done t)))) + (list status (substring name 0 count) (substring name count)))) + +(defun erc-v3--multi-prefix-split-flags (flag-string) + "Return a list of parts from \"RPL_WHOREPLY\" 352 or 354 FLAG-STRING. +Return a list of (AWAY OPER-P (STATUS . PREFIX) REST), where AWAY is the +away char ?H, for here, or ?G, for gone; OPER-P is a boolean indicating +whether the user is an operator; STATUS is an internal number +representing PREFIX; and REST is a list of remaining chars, like ?B for +bot or ?r for registered (varies per IRCd)." + (unless (string-empty-p flag-string) + (let* ((away (aref flag-string 0)) ; either ?H or ?G + (oper (and (> (length flag-string) 1) (eq ?* (aref flag-string = 1)))) + (alist (erc--parsed-prefix-alist (erc--parsed-prefix))) + (statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) + (remaining (substring flag-string (if oper 2 1)))) + ;; Here, `rest' is usually something like (?B ?r) or (?s) + (pcase-let* ((`(,status ,prefix ,rest) + (erc-v3--multi-prefix--partition remaining statuses)) + (letters (apply #'string + (mapcar (lambda (c) (car (rassq c alist= ))) + prefix)))) + (list away oper (cons status letters) (append rest nil)))))) + +(defun erc-v3--update-server-user (nick host full-name login account info) + "Add or update `erc-server-users' entry with params. +Use NICK, HOST, FULL-NAME, LOGIN, and ACCOUNT to init new server user if +needed. Pass INFO to `erc--ensure-server-user-info' before committing." + (if-let* ((server-user (erc-get-server-user nick))) + (erc-update-user server-user nick host login full-name) + (erc-add-server-user nick (make-erc-server-user :nickname nick + :host host + :full-name full-name + :login login + :account account) + info))) + +;; This applies to basic /WHO #chan, etc. Automated WHOs sent by this +;; module are of the WHOX variety. +(cl-defmethod erc--server-352 + (_ parsed &context (erc-v3--multi-prefix erc-v3--multi-prefix)) + "Act like `erc-server-352' and handle PARSED \"RPL_WHOREPLY\". +Attempt to parse multi-prefixes. Update existing user records in server +and query/channel tables." + (pcase-let* ((`(,channel ,login ,host ,_server ,nick ,flags ,hop-real) + (cdr (erc-response.command-args parsed))) + (`(,away-flag ,_oper (,status . ,letters) ,_rest) + (erc-v3--multi-prefix-split-flags flags)) + ;; Discard hops in trailing arg. + (full-name (and (string-match (rx (: bot (+ (any "0-9")) " = ") + (group (* nonl)) eot) + hop-real) + (match-string 1 hop-real)))) + (if (equal channel "*") + (erc-v3--update-server-user nick host full-name login nil nil) + (erc-with-buffer (channel) ; no-op if buffer doesn't exist + (erc--update-current-channel-member + (erc-get-channel-member nick) status nil nick host login full-nam= e) + (erc-display-message parsed 'notice (current-buffer) 's352-v3 + ?c channel ?n nick ?a (string away-flag) + ?s letters + ?u login ?h host ?f full-name)))) + nil) + + +;;;; Extension: userhost-in-names + +(erc-v3--define-capability userhost-in-names) + + +;;;; Extension: message-tags + +;; TODO when a backing store is eventually implemented, this extension +;; should use a native ID, likely a fixnum corresponding to a row ID or +;; similar in the store, instead of retaining the message ID in-buffer +;; via a text property. + +(defvar erc-v3--message-tags-retain-ids-p nil + "Whether to store IDs as a per-message msg property.") + +(erc-v3--define-capability message-tags + (if erc-v3--message-tags + (when erc-v3--message-tags-retain-ids-p + (add-hook 'erc-insert-pre-hook + #'erc-v3--message-tags-add-message-id-text-prop 20 t)) + (remove-hook 'erc-insert-pre-hook + #'erc-v3--message-tags-add-message-id-text-prop t))) + +(defconst erc-v3--message-tags-tag-escapes + '((";" . "\\:") + (" " . "\\s") + ("\\" . "\\\\") + ("\r" . "\\r") + ("\n" . "\\n"))) + +(defconst erc-v3--message-tags-tag-escaped-regexp + (rx (or ?\; ?\ ?\\ ?\r ?\n))) + +(defconst erc-v3--message-tags-tag-unescaped-regexp + (rx (or "\\:" "\\s" "\\\\" "\\r" "\\n" + (seq "\\" (or string-end (not (or ":" "s" "n" "r" "\\"))))))) + +;; These operations are not inverses: unescaping may degenerate the +;; original by dropping stranded or misplaced backslashes. See +;; test/lisp/erc/resources/erc-d/erc-d-tests.el for tests. + +(defun erc-v3--message-tags-unescape-tag-value (str) + "Undo substitution of char placeholders in raw tag value STR." + (replace-regexp-in-string erc-v3--message-tags-tag-unescaped-regexp + (lambda (s) + (or (car (rassoc + s erc-v3--message-tags-tag-escapes= )) + (substring s 1))) + str t t)) + +(defun erc-v3--message-tags-escape-tag-value (str) + "Swap out banned chars in tag value STR with message representation." + (replace-regexp-in-string erc-v3--message-tags-tag-escaped-regexp + (lambda (s) + (cdr (assoc s erc-v3--message-tags-tag-escap= es))) + str t t)) + +(defun erc-v3--message-tags-add-message-id-text-prop (_) + "Add message ID as `erc--msgid' property on inserted message." + (cl-assert erc-v3--message-tags-retain-ids-p) + (when-let* ((parsed erc--parsed-response) + (tags (erc-response.tags parsed)) + (found (alist-get 'msgid tags))) + (puthash 'erc--msgid found erc--msg-props))) + +(cl-defmethod erc--parse-message-tags (raw &context (erc-v3-mode (eql t))) + "Parse RAW string into an alist of cons cells of symbols and strings." + (cl-assert (not (eq 'legacy erc-tags-format))) + (let (tags) + (dolist (part (split-string raw ";") (nreverse tags)) + (let ((pos (string-search "=3D" part))) + ;; Clobber existing items. + (setf (alist-get (intern (if pos (substring part 0 pos) part)) tag= s) + (and-let* ((pos) + (value (substring part (1+ pos))) + ((not (string-empty-p value)))) + (erc-v3--message-tags-unescape-tag-value + (decode-coding-string value 'utf-8 t)))))))) + +;; TODO make this useful. Currently, it just ensures messages don't +;; end up in the server buffer. +(define-erc-response-handler (TAGMSG) + "Handle a TAGMSG command." nil + nil) + +(defun erc-v3--merge-client-tags (tags) + "Reassemble client TAGS in preparation for sending." + (let (parts) + (dolist (tag tags) + (let* ((raw-value (cdr tag)) + (val (and raw-value (not (string-empty-p raw-value)) + (erc-v3--message-tags-escape-tag-value raw-value)))) + (push (concat (symbol-name (car tag)) (and val "=3D") val) parts))) + (encode-coding-string (concat "@" (string-join (nreverse parts) ";") "= ") + 'utf-8))) + +(defvar erc-v3--unescaped-client-tags nil + "Client tags for current outgoing request.") + +(cl-defmethod erc--server-send + (string force target &context (erc-v3--unescaped-client-tags cons)) + (setq string + (concat (erc-v3--merge-client-tags erc-v3--unescaped-client-tags) + string)) + (cl-call-next-method string force target)) + + +;;;; Extension: server-time + +;; For znc.in/server-time-iso, override `erc-stamp--current-time'. + +(erc-v3--define-capability server-time + (if erc-v3--server-time + (progn + (when (and erc--target (erc--module-active-p 'button)) + (require 'erc-button) + (defvar erc-button--phantom-users-mode) + (when erc-button--phantom-users-mode + (erc-v3--server-time-on-phantom-users-mode)) + (add-hook 'erc-button--phantom-users-mode-hook + #'erc-v3--server-time-on-phantom-users-mode 20 t)) + (add-function :before-until (local 'erc--current-time-pair-functio= n) + #'erc-v3--current-time-pair '((depth . 40)))) + (remove-function (local 'erc--current-time-pair-function) + #'erc-v3--current-time-pair) + (kill-local-variable 'erc-v3--server-time-display-latest) + (remove-hook 'erc-button--phantom-users-mode-hook + #'erc-v3--server-time-on-phantom-users-mode t))) + +(defvar-local erc-v3--server-time-display-latest nil) +(defvar erc-v3--server-time-display-nested-p nil) +(defvar erc-v3--server-time-pulse-late-arrivals-p (not noninteractive)) + +(defun erc-v3--server-time-find-splice-point (p target-time) + "Scan backwards to find newest message with TARGET-TIME, starting from P= ." + (while-let ((q (previous-single-property-change (1- p) 'erc--ts)) + (qq (erc--get-inserted-msg-beg q)) + (ts (get-text-property qq 'erc--ts)) + ((time-less-p target-time ts))) + (setq p qq)) + p) + +(defun erc-v3--server-time-pulse () + "Highlight entire narrowed buffer." + (pulse-momentary-highlight-region (point-min) (point-max))) + +(cl-defmethod erc--insert-line + (_ &context (erc-v3--server-time erc-v3--server-time)) + "Insert late-arriving messages earlier in buffer." + (if-let* (((null erc--insert-marker)) + ((not (buffer-narrowed-p))) + ((not erc-v3--server-time-display-nested-p)) + (current (erc--current-time-pair)) ; used in else form + (last-seen erc-v3--server-time-display-latest) + ((time-less-p current last-seen)) + (p (erc--get-inserted-msg-beg erc-insert-marker)) + (pt (erc-v3--server-time-find-splice-point p current))) + (let ((erc-v3--server-time-display-nested-p t) + (erc-insert-post-hook + (if (and erc-v3--server-time-pulse-late-arrivals-p + (eq (window-buffer) (current-buffer)) + ;; Suppress during help text and history. + (time-less-p 1.0 (time-subtract last-seen current))) + `(,@(ensure-list erc-insert-post-hook) + erc-v3--server-time-pulse) + erc-insert-post-hook))) + (erc--with-spliced-insertion pt + (cl-call-next-method))) + (unless (or erc-v3--server-time-display-nested-p + (erc--check-msg-prop 'erc--msg 'datestamp)) + (setq erc-v3--server-time-display-latest current)) + (cl-call-next-method))) + +(defun erc-v3--current-time-pair () + "Return a Lisp time stamp from time tag." + (cond ((erc--zresponse-p erc--parsed-response) + (erc--zresponse-time erc--parsed-response)) + (erc--parsed-response + (erc--time-pair-from-time-tag erc--parsed-response)))) + +(defun erc-v3--server-time-on-phantom-users-mode () + "Perform setup/teardown for server-time extension." + (defvar erc-button--phantom-users-mode) + (if erc-button--phantom-users-mode + (add-function :filter-return (local 'erc--cmem-from-nick-function) + #'erc-v3--server-time-update-phantom-cmem '((depth . 2= 0))) + (remove-function (local 'erc--cmem-from-nick-function) + #'erc-v3--server-time-update-phantom-cmem))) + +(defun erc-v3--server-time-update-phantom-cmem (cmem) + "Update last-message-time slot of channel-user of CMEM." + (when-let* ((cusr (cdr cmem)) + ((eq 'erc--phantom-channel-user (aref cusr 0)))) + (cl-assert (erc-v3--server-time-p erc-v3--server-time)) + (cl-assert (erc-response-p erc--parsed-response)) + (cl-assert (erc-response.tags erc--parsed-response)) + (setf (erc-channel-user-last-message-time cusr) + (erc--current-time-pair))) + cmem) + + +;;;; Extension: echo-message + +;; TODO make sure this works with servers offering a permanent presence +;; feature that specify a different host in the source/sender NUH +;; depending on the originating client. + +(erc-v3--define-capability echo-message + (if erc-v3--echo-message + (progn + (add-function :override (local 'erc--send-action-function) + #'erc--send-action-perform-ctcp) + (add-function :around (local 'erc--send-message-nested-function) + #'erc-v3--echo-message-inhibit-insert-on-send-messag= e) + (add-hook 'erc--input-review-functions + #'erc-v3--echo-message-on-pre-send 75 t)) + (remove-function (local 'erc--send-action-function) + #'erc--send-action-perform-ctcp) + (remove-function (local 'erc--send-message-nested-function) + #'erc-v3--echo-message-inhibit-insert-on-send-message) + (remove-hook 'erc--input-review-functions + #'erc-v3--echo-message-on-pre-send t))) + +(defun erc-v3--echo-message-on-pre-send (input) + "Suppress insertion of `erc-input' object INPUT." + (cl-assert erc-v3--echo-message) + (setf (erc-input-insertp input) nil)) + +(cl-defmethod erc--send-message-external + (line force &context (erc-v3--echo-message erc-v3--echo-message)) + (erc-message "PRIVMSG" (concat (erc-target) " " line) force) + t) + +;; Echoing of command lines for /SAY, /SV, etc. would normally be +;; suppressed on account of their being slash commands. However, +;; since they handle their own insertion, additional steps are +;; required. /ME is different because it uses `erc-display-message' +;; instead of `erc-display-msg', even though it's basically identical +;; to an outgoing chat message. + +(defvar erc-v3--echo-message-allow-noncommands-p nil + "Allow non-commands, such as /SAY, /SV, etc. to emit labeled messages. +This flag does not concern original, submitted command lines themselves +but rather replacement text those commands generate, which is sent via +nested calls to `erc--send-input-lines'.") + +(defun erc-v3--echo-message-inhibit-insert-on-send-message (orig &rest arg= s) + "With `erc-v3--echo-message-allow-noncommands-p', call ORIG function wit= h ARGS. +Otherwise, arrange to do so while suppressing input insertion." + (cl-assert erc-v3--echo-message) + (if erc-v3--echo-message-allow-noncommands-p + (apply orig args) + (let ((erc-pre-send-functions (cons #'erc-v3--echo-message-on-pre-send + (ensure-list erc-pre-send-function= s)))) + (apply orig args)))) + + +;;;; Extension: WHOX + +;; This would seem pretty necessary for full account support, but it +;; stood apart for decades before becoming an official extension [1]. +;; The older specs appear to be more extensive [2]. The quakenet one +;; says the "flags" field always contains all prefixes, as if +;; `multi-prefix' were always enabled: +;; +;; > flags will contain all the information about a user on a channel. +;; > @ for op'd, + for voiced, and ! for zombie. +;; +;; However, as of June 2024, there's some ambiguity as to whether this +;; should be the case when `multi-prefix' is disabled, whether by +;; omission or otherwise. It's been reported that Solanum behaves as +;; if it's enabled whenever WHOX is advertised. +;; +;; [1] https://ircv3.net/specs/extensions/whox (official as of 2022) +;; [2] https://github.com/quakenet/snircd/raw/master/doc/readme.who +;; https://faerion.sourceforge.net/doc/irc/whox.var +;; https://ircu.sourceforge.net/release.2.10.01-who.html + +(erc-v3--define-extension whox + :slots (( token 0 :type natnum + :documentation "Counter for generated tokens.") + ( requests nil :type (list-of erc-v3--whox-request) + :documentation "List of pending jobs.") + ( req-seen nil :type list + :documentation "Finished jobs removed from `requests'.") + ( penalty 10 :type natnum + :documentation "Back-off duration in seconds for delay timer.") + ( timer nil :type (or null vector) + :documentation "Delay timer.")) + (unless erc--target + ;; When `erc-server-flood-queue' is empty, requesting WHO info on + ;; JOIN is too early. + (if erc-v3--whox + (progn + (add-hook 'erc-server-329-functions + #'erc-v3--request-who-after-mode 40 t) + (add-hook 'erc-server-315-functions #'erc-v3--whox-handle-315 -2= 0 t)) + (remove-hook 'erc-server-329-functions + #'erc-v3--request-who-after-mode t) + (remove-hook 'erc-server-315-functions #'erc-v3--whox-handle-315 t))= )) + +(cl-defstruct erc-v3--whox-request + "WHOX request object." + (token (cl-callf (lambda (v) (% (1+ v) 1024)) + (erc-v3--whox-token erc-v3--whox)) + :type natnum) + (target (error "Required `:target' keyword missing") :type string) + (fields (error "Required `:fields' keyword missing") :type string) + (handler (error "Required `:handler' keyword missing") :type function)) + +(defun erc-v3--whox-delete (token) + "Remove request for TOKEN from `requests' slot of `erc-v3--whox'." + (setf (erc-v3--whox-requests erc-v3--whox) + (cl-delete token (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token))) + +(defun erc-v3--whox-make-request (request) + "Prepare a \"WHO\" REQUEST." + (pcase-exhaustive request + ((cl-struct erc-v3--whox-request token target fields) + (cl-assert token) + (setq fields (concat (and (/=3D ?t (aref fields 0)) "t") fields "," + (number-to-string token))) + (erc-server-send (concat "WHO " target " %" fields) nil target)))) + +(defun erc-v3--whox-enqueue (target fields handler) + "Schedule a \"WHO\" request for immediate or deferred sending. +Use TARGET, FIELDS, and HANDLER to make a new request object." + (let ((existing (erc-v3--whox-requests erc-v3--whox)) + (new (make-erc-v3--whox-request :target target + :fields fields + :handler handler))) + (push new (erc-v3--whox-requests erc-v3--whox)) + (unless existing + (erc-v3--whox-make-request new)))) + +(defvar erc-v3--whox-on-354-functions nil) + +(defun erc-v3--whox-handle-channel-user (parsed parts) + "Update channel user from PARSED \"WHOX\" reply with fields \"cuhnflar\". +Do so with response parameters PARTS." + ;; FIXME explain why `idle' is ignored here. + (pcase-let* ((`(,target ,login ,host ,nick ,flags ,_idle ,account) parts) + (account (and (not (string=3D account "0")) account)) + (full-name (erc-response.contents parsed)) + (`(,away ,_oper (,status . ,_) ,_rest) + (erc-v3--multi-prefix-split-flags flags))) + (setq away (if (eq away ?G) "" nil)) + ;; The request may be for a query buffer, whose `erc-channel-member' + ;; table also needs updating. + (when (string=3D target "*") + (setq target nick)) + (erc-with-buffer (target) + (if-let* ((cmem (erc-get-channel-user nick))) + (erc--update-current-channel-member + cmem status nil nick host login full-name `(away . ,away) accou= nt) + (erc--create-current-channel-member + nick status nil nick host login full-name `(away . ,away) account= )) + (run-hooks 'erc-v3--whox-on-354-functions)))) + +(defun erc-v3--request-who-after-mode (_ parsed) + "Schedule a \"WHOX\" request on PARSED \"329\" response." + (when-let* ((channel (cadr (erc-response.command-args parsed)))) + (erc-with-buffer (channel) + (erc-v3--whox-on-join))) + nil) + +;; FIXME reduce the amount of fields, especially those we just ignore. +(cl-defmethod erc-v3--whox-on-join () + "Request WHO info on \"JOIN\" for WHOX-aware target buffers. +Specify fields parameter as \"cuhnflar\" for channel, user, host, nick, +flags, idle, account, and real-name respectively." + (erc-v3--whox-enqueue (erc-target) "cuhnflar" + #'erc-v3--whox-handle-channel-user)) + +(define-erc-response-handler (354) "WHOX RPL_WHOSPCRPL." nil) + +(cl-defmethod erc--server-354 + (_proc parsed &context (erc-v3--whox erc-v3--whox)) + (pcase-let* + ;; The CAR is normally our current nick. + ((`(,_ ,token . ,parts) (erc-response.command-args parsed)) + (token (and token + (string-match-p (rx bot (+ (any "0-9")) eot) token) + (string-to-number token))) + (seen (cl-find token (erc-v3--whox-req-seen erc-v3--whox) + :key #'erc-v3--whox-request-token)) + (new (or seen (cl-find token (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token)))) + ;; At the very least, server sends one 354 with your info. + (unless seen + (push new (erc-v3--whox-req-seen erc-v3--whox)) + (setf (erc-v3--whox-requests erc-v3--whox) + (delq new (erc-v3--whox-requests erc-v3--whox)))) + (funcall (erc-v3--whox-request-handler new) parsed parts)) + nil) + +(defun erc-v3--whox-request-delayed (buffer) + "Request a \"WHOX\" query in BUFFER." + (with-current-buffer buffer + (setf (erc-v3--whox-timer erc-v3--whox) nil) + (cl-assert (erc-v3--whox-requests erc-v3--whox)) + (when (erc-server-process-alive buffer) + (erc-v3--whox-make-request + (car (last (erc-v3--whox-requests erc-v3--whox))))))) + +;; We can't override with an internal method this because it would +;; also run on 318, etc. +(defun erc-v3--whox-handle-315 (_proc parsed) + "Make a \"WHOX\" request from PARSED \"315\" response." + (pcase-let* ((`(,_ ,target . ,_) (erc-response.command-args parsed)) + (found (cl-find target (erc-v3--whox-req-seen erc-v3--whox) + :key #'erc-v3--whox-request-target + :test #'string=3D))) + (when (erc-v3--whox-requests erc-v3--whox) + (if found + (erc-v3--whox-make-request + (cl-find (1+ (erc-v3--whox-request-token found)) + (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-token)) + ;; We could spin for a bit here, but that could hide an actual + ;; concurrency problem. Better to know if the user did + ;; something strange, like quit immediately upon joining a + ;; channel. + ;; + ;; Seems `target' is an asterisk if we've just received a 263. + (unless (erc-v3--whox-timer erc-v3--whox) + (erc-button--display-error-notice-with-keys + (erc-server-buffer) + "Missing responses for " target " %S. Please report." + (list :seen (erc-v3--whox-req-seen erc-v3--whox) + :reqs (erc-v3--whox-requests erc-v3--whox))))))) + nil) + +(defvar erc-message-english-s263-rate-limit + "Rate limit exceeded retrieving user data for %t. Next attempt in %us." + "English `erc-format-message' template for key `s263-rate-limit'.") + +(cl-defmethod erc--server-263 (_proc parsed + &context (erc-v3--whox erc-v3--whox)) + (pcase (erc-response.command-args parsed) + ((and `(,_ "WHO" ,_) + (let `(,oldest . ,_) (last (erc-v3--whox-requests erc-v3--whox))= )) + (erc-display-message parsed 'notice (current-buffer) 's263-rate-limit + ?t (erc-v3--whox-request-target oldest) + ?u (erc-v3--whox-penalty erc-v3--whox)) + (when (and (null (erc-v3--whox-timer erc-v3--whox)) + (erc-v3--whox-requests erc-v3--whox)) + (setf (erc-v3--whox-timer erc-v3--whox) + (run-at-time (erc-v3--whox-penalty erc-v3--whox) nil + #'erc-v3--whox-request-delayed + (current-buffer)) + ;; + (erc-v3--whox-penalty erc-v3--whox) + (* 2 (erc-v3--whox-penalty erc-v3--whox)))))) + nil) + + +;;;; Extension: Monitor + +(erc-v3--define-extension monitor + :slots (( targets nil :type (list-of string) + :documentation "Targets with active monitor jobs.") + ( count 0 :type natnum + :documentation "Number of monitored targets.") + ( max 0 :type natnum + :documentation "Max number of active monitor jobs.")) + (if erc--target + (if erc-v3--monitor + (progn + (add-hook 'erc-connect-pre-hook #'erc-v3--monitor-on-new-query= 40 t) + (add-hook 'erc-kill-buffer-hook #'erc-v3--monitor-forget 40 t) + (when (erc-query-buffer-p) + (add-function :override + (local 'erc--query-table-synced-predicate) + #'erc-v3--monitor-active-p)) + (add-function :override (local 'erc--forget-server-user-functi= on) + #'erc--forget-server-user)) + (remove-hook 'erc-connect-pre-hook #'erc-v3--monitor-on-new-query = t) + (remove-hook 'erc-kill-buffer-hook #'erc-v3--monitor-forget t) + (remove-function (local 'erc--query-table-synced-predicate) + #'erc-v3--monitor-active-p) + (remove-function (local 'erc--forget-server-user-function) + #'erc--forget-server-user)) + (when (erc--module-active-p 'querypoll) + (erc-button--display-error-notice-with-keys + (current-buffer) + "The `monitor' extension obsoletes module `querypoll'." + " Disabling the latter.") + (when (fboundp 'erc-querypoll-mode) + (erc-querypoll-mode -1))))) + +;; Currently, this capability can't easily formally depend on plain +;; `monitor' because it's an ISUPPORT-based extension, which is normally +;; only discovered and enabled after negotiation ends. However, with +;; `extended-isupport', it may be possible to defer activation via +;; overridden "ACK" method or similar, marking the extension as resolved +;; upon seeing a matching 005 before BATCH end. +(erc-v3--define-capability extended-monitor) + +(cl-defmethod erc-v3--on-isupport-param ((o erc-v3--monitor) key value) + (cl-assert (eq key 'MONITOR)) + (setf (erc-v3--monitor-max o) + (or (and value (string-to-number (car value))) most-positive-fixnu= m)) + (cl-call-next-method)) + +(defun erc-v3--monitor-active-p () + "Return non-nil when the monitor extension is enabled." + erc-v3--monitor) + +;; FIXME make this an option, possibly of a different type. +(defvar erc-v3--monitor-exclude-regexp + (rx bot + (or "alis" "NickServ" "ChanServ" "MemoServ" "BouncerServ" "SaslServ") + eot) + "Pattern to ignore common services and bots you regularly query.") + +(defun erc-v3--monitor-on-new-query (&rest _) + "Send \"MONITOR\" request when initializing a query buffer." + (when (and erc-v3--monitor (erc-query-buffer-p)) + (let* ((target (erc-target)) + (nickd (erc-downcase target))) + (unless (or (member nickd (erc-v3--monitor-targets erc-v3--monitor)) + (string-match erc-v3--monitor-exclude-regexp target) + (not (erc-is-valid-nick-p target)) + (erc-current-nick-p nickd) + (>=3D (erc-v3--monitor-count erc-v3--monitor) + (erc-v3--monitor-max erc-v3--monitor))) + (push nickd (erc-v3--monitor-targets erc-v3--monitor)) + (cl-incf (erc-v3--monitor-count erc-v3--monitor)) + (erc-server-send (concat "MONITOR + " target) nil target))))) + +(defun erc-v3--monitor-forget () + "Send a \"MONITOR\" unsubscribe request when killing a query buffer." + (when (erc-query-buffer-p) + (let ((target (erc-target))) + (when (and erc-server-connected + (not erc-networks--target-transplant-in-progress-p)) + (erc-server-send (concat "MONITOR - " target) nil target)) + (cl-decf (erc-v3--monitor-count erc-v3--monitor)) + (setf (erc-v3--monitor-targets erc-v3--monitor) + (delete (erc-downcase target) + (erc-v3--monitor-targets erc-v3--monitor)))))) + +(defvar erc-message-english-s730 "%n is online" + "English `erc-format-message' template for key `s730'.") + +(defvar erc-message-english-s731 "%n is offline" + "English `erc-format-message' template for key `s731'.") + +;; FIXME ensure this is unused and delete. +(defun erc-v3--monitor-display-online () + (cl-assert (erc-query-buffer-p)) + (unless (eq 's730 (erc--get-inserted-msg-prop 'erc--msg)) + (erc-display-message nil 'notice (current-buffer) + 's730 ?n (erc-target)))) + +(define-erc-response-handler (730) "RPL_MONONLINE." nil + (dolist (added (split-string (erc-response.contents parsed) ",")) + (when-let* ((nuh (erc-parse-user added)) + (nick (car nuh)) + (buffer (erc-get-buffer nick erc-server-process))) + (with-current-buffer buffer + (cl-assert (member (erc-downcase nick) + (erc-v3--monitor-targets erc-v3--monitor))) + (unless (erc-get-channel-member nick) + (erc-update-current-channel-member nick nick t nil nil nil nil n= il + (nth 2 nuh) (nth 1 nuh))) + (letrec ((show-fn + (lambda () + (remove-hook 'erc-v3--whox-on-354-functions show-fn t) + ;; Suppress duplicate 730 messages. + (unless (eq 's730 (erc--get-inserted-msg-prop 'erc--ms= g)) + (erc-display-message parsed 'notice (current-buffer) + 's730 ?n nick))))) + (if erc-v3--whox + (progn + (add-hook 'erc-v3--whox-on-354-functions show-fn 20 t) + (erc-v3--whox-on-join)) + (funcall show-fn)))))) + nil) + +(define-erc-response-handler (731) "RPL_MONOFFLINE." nil + (dolist (removed (split-string (erc-response.contents parsed) ",")) + (if-let* ((nuh (erc-parse-user removed)) + (nick (car nuh)) + (nickd (erc-downcase nick)) + (buffer (erc-get-buffer nick erc-server-process))) + (with-current-buffer buffer + (when (and (member nickd (erc-v3--monitor-targets erc-v3--monito= r)) + (or (erc-get-channel-member nick) + ;; User is not in any other target buffer. + (null (erc-get-server-user nick)))) + (unless (eq 's731 (erc--get-inserted-msg-prop 'erc--msg)) + (erc-display-message parsed 'notice (current-buffer) + 's731 ?n nick)) + (erc-remove-current-channel-member nick))) + ;; FIXME how can buffer be non-nil if it's the last item in the VARL= IST? + (unless buffer + (cl-assert nickd) + (cl-decf (erc-v3--monitor-count erc-v3--monitor)) + (setf (erc-v3--monitor-targets erc-v3--monitor) + (delete nickd (erc-v3--monitor-targets erc-v3--monitor)))))) + nil) + + +;;;; Extension: extended-join + +(erc-v3--define-capability extended-join + (if erc-v3--extended-join + (when erc--target + (add-hook 'erc-join-hook #'erc-v3--send-mode-on-join 30 t)) + (remove-hook 'erc-join-hook #'erc-v3--send-mode-on-join t))) + +(defvar erc-message-english-JOIN-X "%n (%a: %u@%h) has joined channel %c" + "English `erc-format-message' template for key `JOIN-X'.") + +;; Move "MODE #chan" to a hook so modules like chathistory can process +;; JOINs for the client's nick. +(defun erc-v3--send-mode-on-join () + "Send a \"MODE\" command for current channel or query." + (erc-server-send (concat "MODE " (erc-target)))) + +;; FIXME explain who "others" are and what traditional behavior this +;; compatibility flag restores. +(defvar erc-v3--create-unknown-channel-buffer-when-others-join-p nil + "When non-nil, create a buffer for unknown targets joined by others.") + +(cl-defmethod erc--server-JOIN + (_ parsed &context (erc-v3--extended-join erc-v3--extended-join)) + "Handle a JOIN command with extra arguments. +Unlike `erc-server-JOIN', do nothing when the buffer has already been +joined. Also, don't bother with `erc-channel-begin-receiving-names' +because the default handler for \"353\" calls it when needed, and +extensions may prevent names from automatically being sent altogether." + (setq parsed erc--parsed-response) + (pcase-let* + ((`(,chnl ,account ,full) (erc-response.command-args parsed)) + (`(,nick ,login ,host) (erc--zJOIN-nuh parsed)) + (account (and (not (string=3D account "*")) account)) + (nickp (erc--zJOIN-self-p parsed)) + (buffer (erc--zJOIN-buffer parsed))) + (when (and (null buffer) + erc-v3--create-unknown-channel-buffer-when-others-join-p + (erc-channel-p chnl)) + (setq buffer (let ((erc--display-context + (erc--server-determine-join-display-context + chnl erc--display-context))) + (save-excursion (erc--open-target chnl))))) + (when buffer + (with-current-buffer buffer + (unless (and nickp (erc--target-channel-joined-p erc--target)) + (erc-update-current-channel-member nick nick t nil nil nil nil n= il + host login full nil nil accou= nt) + (when nickp + (setf (erc--target-channel-joined-p erc--target) t) + (erc-update-mode-line) + (run-hooks 'erc-join-hook)) + (let ((args (cond + (nickp (list 'JOIN-you ?c chnl)) + (account (list 'JOIN-X ?a account + ?n nick ?u login ?h host ?c chnl)) + (t (list 'JOIN ?n nick ?u login ?h host ?c chnl))))) + (apply #'erc-display-message parsed 'notice buffer args)))))) + nil) + + +;;;; Extension: account-notify + +(erc-v3--define-capability account-notify) + +(defvar erc-message-english-ACCOUNT "Account status for %a: %s as %n" + "English `erc-format-message' template for key `ACCOUNT'.") + +;; When a user logs out of an account, all messages from that nick +;; within currently lose their association to that user. This is +;; likely not ideal. + +(defun erc-v3--update-account (account nick &optional login host) + "Update ACCOUNT field for NICK's `erc-server-user' object. +Use LOGIN and HOST for new server user if needed." + (cl-assert (not (string-empty-p account))) + (if-let* ((user (erc-get-server-user nick))) + (erc-update-user user nil nil nil nil nil account) + ;; `erc-update-current-channel-member' will still honor an ADD + ;; argument so long as nothing yet exists in `erc-channel-users'. + (when (string=3D account "*") + (setq account nil)) + (erc-add-server-user nick (make-erc-server-user :nickname nick + :host host + :login login + :account account)))) + +(define-erc-response-handler (ACCOUNT) + "Handle an ACCOUNT message." nil + (pcase-let* ((account (car (erc-response.command-args parsed))) + (`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) + (erc-v3--update-account account nick login host) + (when (erc-current-nick-p nick) + (erc-display-message parsed 'notice (current-buffer) + 'ACCOUNT ?a account ?n nick ?s "logged in")))) + + +;;;; Extension: account-tag + +;; Some servers send `account-tag' whether you ask for it or not, +;; courtesy of `message-tags'. Assuming `extended-join' and `whox' are +;; provided, negotiating `account-tag' may only buy you account +;; knowledge for queries from those you don't share a channel with. It +;; may also help when trying to determine if the speaker of some +;; historical message, possibly residing in a non-contiguous history +;; playback region, was authenticated when first received by the +;; network. + +(defun erc-v3--key-resolved-p (key) + "Return non-nil if associated minor mode for KEY is enabled." + (and-let* ((o (erc-v3--find-capability-by-key key))) + (erc-v3--enabled-p o))) + +(erc-v3--define-capability account-tag + ;; If the server lacks `extended-join' and `account-notify', update + ;; account on certain channel-user server commands, like PRIVMSG, + ;; NOTICE, KICK, JOIN, PART, etc. + (unless erc--target + (if erc-v3--account-tag + ;; FIXME improve these unreliable heuristics or arrange to + ;; remove the timer hook if those extensions later become + ;; active, maybe via `erc-v3--account-notify-mode-hook', etc. + ;; Some servers and proxies send a bunch of single "NEW :my-cap" + ;; offers upon JOIN (after history playback), but the ordering + ;; is not predictable. (Thankfully, ZNC 1.10.1 happens to send + ;; `account-notify' first.) + (unless (and (or erc-v3--extended-join + (erc-v3--key-resolved-p 'extended-join)) + (or erc-v3--account-notify + (erc-v3--key-resolved-p 'account-notify))) + (add-hook 'erc-timer-hook #'erc-v3--ensure-account 0 t)) + (remove-hook 'erc-timer-hook #'erc-v3--ensure-account t)))) + +(defun erc-v3--ensure-account (_) + "Add account info if response is an `erc--zresponse'." + (when-let* (((erc--zresponse-p erc--parsed-response)) + ((erc-response.tags erc--parsed-response)) + (parsed erc--parsed-response)) + (pcase-let ((`(,nick ,login ,host) (erc--zresponse-nuh parsed)) + (account (alist-get 'account (erc-response.tags parsed)))) + (erc-v3--update-account account nick login host)))) + + +;;;; Extension: away-notify + +(erc-v3--define-capability away-notify) + +(define-erc-response-handler (AWAY) + "Handle an AWAY message. +See also RPL_AWAY 301." nil + (pcase-let* ((msg (erc-response.contents parsed)) + (nick (erc-extract-nick (erc-response.sender parsed)))) + (when (string-empty-p msg) + (setq msg nil)) + (erc-update-user-nick nick nil nil nil nil (cons 'away msg) nil)) + nil) + + +;;;; Extension: chghost + +(erc-v3--define-capability chghost) + +(define-erc-response-handler (CHGHOST) + "Handle a CHGHOST message." nil + (pcase-let* ((`(,login ,host) (erc-response.command-args parsed)) + (nick (erc-extract-nick (erc-response.sender parsed)))) + (erc-v3--update-server-user nick host nil login nil nil)) + nil) + + +;;;; Extension: standard-replies + +;; ERC handles arbitrary (unknown) replies regardless of whether the +;; capability has been negotiated because servers can send them +;; regardless. https://github.com/ircv3/ircv3-specifications/pull/506 + +(erc-v3--define-capability standard-replies) + +(defvar erc-message-english-FAIL "%c command failed. %m: %n" + "English `erc-format-message' template for key `FAIL'.") + +(defvar erc-message-english-WARN "Warning re %c command. %m: %n" + "English `erc-format-message' template for key `WARN'.") + +(defvar erc-message-english-NOTE "Note re %c command. %m: %n" + "English `erc-format-message' template for key `NOTE'.") + +(cl-defgeneric erc-v3--standard-replies-handle (type command code rest par= sed) + "Handle a `standard-replies' message of type TYPE. +Expect CODE to be an error code defined in an IRCv3 spec, for example, +\"MULTILINE_INVALID\" from `draft/multiline'. Expect COMMAND to be the +offending command originally sent by ERC. Expect REST to be the +remaining args and PARSED to be an `erc-repsonse' object.") + +(cl-defmethod erc-v3--standard-replies-handle (type command code rest pars= ed) + "Emit a `standard-replies' catch-all message to server buffer." + (let ((msg-type (pcase type + ('NOTE 'notice) + ('WARN '(notice error)) + ('FAIL '(t notice error))))) + (erc-display-message parsed msg-type (erc-server-buffer) + type ?c command ?m code + ?n (string-join rest " ")))) + +(defun erc-v3--standard-replies-dispatch (parsed) + "Call method for PARSED standard reply." + (pcase-let* ((`(,maybe-cmd ,code . ,rest) (erc-response.command-args par= sed)) + (command (and (not (equal "*" maybe-cmd)) (intern maybe-cmd= ))) + (code (intern code)) + (type (intern (erc-response.command parsed)))) + (erc-v3--standard-replies-handle type command code rest parsed))) + +(define-erc-response-handler (FAIL) + "Handle a FAIL `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + +(define-erc-response-handler (WARN) + "Handle a WARN `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + +(define-erc-response-handler (NOTE) + "Handle a NOTE `standard-replies' message." nil + (erc-v3--standard-replies-dispatch parsed)) + + +;;;; Extension: setname + +;; FIXME set `max' from NAMELEN. +(erc-v3--define-capability setname + :slots ((max nil :type (or null integer)))) + +(defvar erc-message-english-name-too-long + "Full-name length (%i) exceeds NAMELEN (%l) defined by the server." + "English `erc-format-message' template for overlong full name.") + +(defun erc-cmd-SETNAME (full-name) + "Tell server to set client's full name to FULL-NAME." + (when-let* ((max (erc-v3--setname-max erc-v3--setname)) + (current (length full-name)) + ((string> current max))) + (erc-display-message nil 'notice 'active 'name-too-long current max)) + (erc-server-send (concat "SETNAME :" (string-remove-prefix " " full-name= )))) +(put 'erc-cmd-SETNAME 'do-not-parse-args t) + +(define-erc-response-handler (SETNAME) + "Handle a \"SETNAME\" message." nil + (pcase-let ((full-name (erc-response.contents parsed)) + (`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) + (erc-v3--update-server-user nick host full-name login nil nil)) + nil) + + +;;;; Extension: sasl + +;; This implementation is merely glue to adapt the `sasl' module to this +;; 302 negotiation business. There's no need to add `sasl' to +;; `erc-modules' because this manages it for you. + +(declare-function erc-sasl--destroy "erc-sasl" (proc)) +(declare-function erc-sasl--mechanism-offered-p "erc-sasl" (offered)) +(declare-function erc-sasl--state-client "erc-sasl" (cl-x)) +(declare-function erc-sasl-mode "erc-sasl" (&optional arg)) +(declare-function sasl-client-mechanism "sasl" (client)) +(declare-function sasl-mechanism-name "sasl" (mechanism)) +(defvar erc-sasl--options) +(defvar erc-sasl-mode) + +;; This works by temporarily treating the mode variable `erc-sasl-mode' +;; as having a "tri-state" value for the current session. If the value +;; is the symbol `v3', then this file's version runs. + +(erc-v3--define-capability sasl + :initp (erc-v3--sasl-on-wantedp-init) + (cl-assert (featurep 'erc-sasl)) + (unless erc-v3--sasl + (remove-hook 'erc-sasl-mode-hook #'erc-v3--sasl-on-minor-mode t) + (erc-sasl-mode -1))) + +(defun erc-v3--sasl-on-minor-mode () + "Inhibit CL methods specializing on `erc-sasl-mode' `eql'ing t." + (when erc-sasl-mode + (setq erc-sasl-mode 'v3))) + +(defun erc-v3--sasl-on-wantedp-init () + "Manage module `sasl'." + (when (erc--module-active-p 'sasl) + (cl-pushnew 'sasl erc-v3-extensions)) + (when (memq 'sasl erc-v3-extensions) + (cl-assert (erc--server-buffer-p)) + ;; This function is ultimately called by `erc-v3-enable', which may + ;; run before or after `erc-sasl-enable' because the ordering of + ;; modules isn't well defined or controlled. + (add-hook 'erc-sasl-mode-hook #'erc-v3--sasl-on-minor-mode nil t) + (require 'erc-sasl) + (cond ((erc-v3--sasl-on-minor-mode)) ; already up, so mark it + ((memq 'sasl erc-modules)) ; will run soon, hook will mark + (t (erc-sasl-mode +1))) ; fully managed by this module + t)) + +(cl-defmethod erc-v3--subcmd-LS ((cap erc-v3--sasl)) + (cl-assert (null erc--target)) + (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) + (cl-assert erc-sasl-mode) + (let ((val (erc-v3--capability-val cap))) + (if (or (null val) (erc-sasl--mechanism-offered-p val)) + (cl-call-next-method) + (erc-v3--transition cap erc-v3--event-wERR) + (erc-button--display-error-notice-with-keys + "Chosen SASL mechanism " + (upcase (symbol-name (alist-get 'mechanism erc-sasl--options))) + " not among those offered: " val ". Aborting.") + (erc-sasl--destroy erc-server-process))))) + +;; This suspends negotiation by ignoring the queued ACK message, which +;; is ready for handling. It then resumes execution when a 9xx response +;; arrives by simulating the arrival of the same "ACK", except limiting +;; processing only to only the cap `sasl'. +;; +;; The `extended-isupport' capability, when implemented, would do much +;; the same: specify an overriding "ACK" method and spoof continued +;; execution on BATCH end instead of on 9xx. +(cl-defmethod erc-v3--subcmd-ACK + ((cap erc-v3--sasl) &context ((bound-and-true-p erc-sasl-mode) (eql v3))) + "Suspend negotiation path for CAP and initiate sub-protocol." + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + ;; Extend request timer by 10 seconds. + (timer-inc-time (erc-v3--caps-timer erc-v3--caps) + erc-v3--sync-timeout-seconds) + (defvar erc-sasl--state) + ;; Not advancing past `qin' inhibits further processing. + (let ((client (erc-sasl--state-client erc-sasl--state))) + ;; When mechanism is unknown this fails with a wrong-type error. + (let ((m (sasl-mechanism-name (sasl-client-mechanism client)))) + (erc-server-send (format "AUTHENTICATE %s" m))))) + +(cl-defmethod erc--register-connection + :around (&context ((bound-and-true-p erc-sasl-mode) (eql v3))) + ;; FIXME during a normal Makefile test run, a failing `cl-assert' on + ;; the following line prints a backtrace and stops execution, but the + ;; test is marked as passed! Witnessed on arbitrary commit + ;; 5be32aa047d18b578412e8b249bb4f128a0dc207 + (unless (memq 'sasl (erc-v3--caps-extensions erc-v3--caps)) + (error "Missing `sasl' from session extensions.")) + (let ((erc-session-password + (and erc-session-password + (not (eq :password (alist-get 'password erc-sasl--options))) + erc-session-password)) + (erc-session-username + ;; The SASL username may contain a colon or a space. + (if (eq :user (alist-get 'user erc-sasl--options)) + (erc-current-nick) + erc-session-username))) + (cl-call-next-method))) + +;; An alternative approach to manually calling the lower-level ACK +;; handlers a la carte like this would be to "roll back" (revert) to the +;; prior state by copying over the current set of relevant slots (with a +;; special fake event, like `w-rev'), but only after pushing the current +;; set atop the history stack. +(cl-defmethod erc--server-903 + (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) + "Call default finalizer to conclude capability negotiation." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + ;; FIXME remove assertions once convinced in case some rogue server + ;; sends a 903 for some reason other than to end an SASL subprotocol + ;; dialog. + (cl-assert (eq erc-v3--phase-QIN (erc-v3--extension-phase cap))) + (cl-assert (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (when (and (eq erc-v3--phase-QIN (erc-v3--extension-phase cap)) + (rassq cap (erc-v3--caps-queue-in erc-v3--caps))) + (let ((erc-sasl-mode nil)) ; ensure the default handler runs + (erc-v3--consider-answered)) + (erc-v3--finish-negotiating))) + nil) + +(defun erc-v3--sasl-finalize-failed () + "Record activation as failed and disable mode if enabled." + (let ((o (erc-v3--find-capability-by-key 'sasl))) + (cl-assert o) + (erc-v3--ensure-disabled (list o)) + (erc-v3--transition o erc-v3--event-wERR))) + +(cl-defmethod erc--server-902 + (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) + (erc-v3--sasl-finalize-failed) + (cl-call-next-method)) + +(cl-defmethod erc--server-904 + (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) + (erc-v3--sasl-finalize-failed) + (cl-call-next-method)) + +(cl-defmethod erc--server-908 + (_ _ &context ((bound-and-true-p erc-sasl-mode) (eql v3))) + (erc-v3--sasl-finalize-failed) + (cl-call-next-method)) + + +;;;; Common extension utilities + +;; This first set of handlers and utilities provides smart(er) +;; collecting of nicknames, using `multi-prefix' and +;; `userhost-in-names', when applicable. + +;; TODO make this a user option or public variable. +(defvar erc-v3--353-names-message-size 512 + "Number of names per simulated NAMES reply (353) message.") + +(defvar erc-message-english-s353-v3 "Users on %c (%d): %u" + "English `erc-format-message' template for key `s353-v3'.") + +(defvar-local erc-v3--353-work nil + "Target-local state for processing large name dumps in chunks.") + +(cl-defstruct erc-v3--353-work + "Pending state while receiving names." + disp count names self) + +(cl-defmethod erc--partition-prefixed-names (name &context + (erc-v3-mode (eql t))) + "Return a list of (STATUS NICK LOGIN HOST). +Act like the base method, except handle multiple prefix chars +before NAME, and perform the side effect of populating the +`names' slot of `erc-v3--353-work'." + (pcase-let* + ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) + (`(,status ,pfx ,nuh) (erc-v3--multi-prefix--partition name + statuses)) + (`(,nick ,login ,host) (erc--parse-nuh nuh))) + (when (and (or nick ; this macro returns nick + (cl-multiple-value-setq (nick login host) + (erc--shuffle-nuh-nickward nick login host)))) + ;; Add to list. + (push (concat pfx nick) (erc-v3--353-work-names erc-v3--353-work)) + `(,status ,nick ,login ,host)))) + +(declare-function erc-button--deemphasize-plebs "erc-button" (nick-object)) + +(defun erc-v3--name-less-p (a b) + "Return the higher priority of status-prefixed nicks A and B." + ;; Don't bother with case tables since this is only for show. + (setq a (downcase a) + b (downcase b)) + (let ((a-statused-p (not (<=3D ?a (aref a 0) ?z))) + (b-statused-p (not (<=3D ?a (aref b 0) ?z)))) + (cond ((xor a-statused-p b-statused-p) ; only one has status + a-statused-p) + (a-statused-p ; both have status + (cl-assert b-statused-p) + (let* ((statuses (erc--parsed-prefix-statuses (erc--parsed-pref= ix))) + (split-a (erc-v3--multi-prefix--partition a statuses)) + (split-b (erc-v3--multi-prefix--partition b statuses))) + (if (=3D (car split-a) (car split-b)) + (string< (nth 2 split-a) (nth 2 split-b)) + (> (car split-a) (car split-b))))) ; bigger status first + (t (string< a b))))) + +(defun erc-v3--print-names (parsed channel names disp) + "Insert aggregated PARSED implicit \"NAMES\" response into current CHANN= EL. +Expect NAMES to be a list of statusted nicks and DISP to be the tally." + (add-function :filter-return (local 'erc-button--modify-nick-function) + #'erc-button--deemphasize-plebs '((depth . 95))) + ;; Since we wait to print 353s in one go (on 366), spoof the former + ;; command so users who ignore it can opt out. + (unless (equal (erc-response.command parsed) "353") + (setf parsed (copy-erc-response parsed) + (erc-response.command parsed) "353")) + (erc-display-message parsed 'notice (current-buffer) + 's353-v3 + ?c channel + ?d (propertize " " 'display disp) + ?u (string-join (sort names #'erc-v3--name-less-p) = " ")) + (remove-function (local 'erc-button--modify-nick-function) + #'erc-button--deemphasize-plebs)) + +(cl-defmethod erc--server-353 (proc parsed &context (erc-v3-mode (eql t))) + "Override 353 default handler for RPL_NAMREPLY, processing PARSED for PR= OC. +Insert entries in buffer, ensuring correct buttonizing." + ;; The first arg may be an asterisk instead of the current nick. + (let ((channel (nth 2 (erc-response.command-args parsed))) + (users (erc-response.contents parsed))) + (erc-with-buffer (channel proc) + (unless erc-v3--353-work + (setq erc-v3--353-work + (make-erc-v3--353-work :count 0 :disp (list "0"))) + (setf (erc-v3--353-work-self erc-v3--353-work) + (erc-get-channel-user (erc-current-nick)))) + (erc-channel-receive-names users) + (when (> (- (hash-table-count erc-channel-users) + (erc-v3--353-work-count erc-v3--353-work)) + erc-v3--353-names-message-size) + (erc-v3--print-names parsed channel + (erc-v3--353-work-names erc-v3--353-work) + (erc-v3--353-work-disp erc-v3--353-work)) + (setf (erc-v3--353-work-names erc-v3--353-work) nil + ;; + (erc-v3--353-work-count erc-v3--353-work) + (hash-table-count erc-channel-users))) + ;; Mutate value in place. + (setf (car (erc-v3--353-work-disp erc-v3--353-work)) + (format "%d" (hash-table-count erc-channel-users))))) + nil) + +;; TODO find out why `erc-channel-end-receiving-names' treats +;; `erc-channel-new-member-names' like a subset of +;; `erc-channel-users'. Aren't they equal (for initial NAMES)? + +(defun erc-v3--bake-display-count (beg end val) + "Find regions with a `display' property `eq' to VAL from BEG to END. +Replace each with the car of VAL. Expect VAL to be a list containing a +single string." + (let ((pos beg) + (inhibit-read-only t) + (inhibit-field-text-motion t)) + (save-excursion + (while (setq pos (text-property-any pos end 'display val)) + (goto-char pos) + (delete-region (point) (+ 3 (point))) + (insert-and-inherit (car val)) + (setq pos (point)))))) + +(cl-defmethod erc--server-366 (proc parsed &context (erc-v3-mode (eql t))) + "Perform same procedure as `erc-channel-begin-receiving-names'." + ;; :test.libera.chat 366 someNick #emacs :End of /NAMES list + ;; FIXME use `erc--skip' for this instead. + (defvar erc-track-exclude) + (let* ((channel (cadr (erc-response.command-args parsed))) + (erc-track-exclude (list channel))) + (erc-with-buffer (channel proc) ; this downcases + (setf (erc-v3--353-work-count erc-v3--353-work) + (hash-table-count erc-channel-users)) + (erc-v3--print-names parsed channel + (erc-v3--353-work-names erc-v3--353-work) + (erc-v3--353-work-disp erc-v3--353-work)) + ;; FIXME leave a marker instead of scanning the entire buffer. + (erc-v3--bake-display-count (point-min) erc-insert-marker + (erc-v3--353-work-disp erc-v3--353-work)) + (setq erc-v3--353-work nil))) + (cl-call-next-method)) + +;; These last two handlers are account aware. + +(cl-defmethod erc--server-900 (_proc parsed &context (erc-v3-mode (eql t))) + "Given `erc-response' PARSED, mark this session's user as being logged i= n. +Only do so when ERC-V3-MODE is non-nil." + (pcase-let* ((`(,nick ,userhost ,account) + (erc-response.command-args parsed)) + (`(,uh-nick ,login ,host) + (when (and userhost + (not (string=3D userhost "*"))) + (erc-parse-user userhost)))) + ;; Servers may (be configured to) ignore the first two fields. + (when (or (null nick) (string=3D nick "*")) + (setq nick (or uh-nick (erc-current-nick)))) + (cl-assert nick) ; erase me + (erc-v3--update-account account nick login host) + (erc-display-message parsed 'notice (current-buffer) + (erc-response.contents parsed))) + nil) + +(define-erc-response-handler (901) + "Handle \"RPL_LOGGEDOUT\" server command." nil + ;; Some servers send * for target (first arg). + (pcase-let* ((`(,nick ,userhost) (erc-response.command-args parsed)) + (`(,uh-nick ,login ,host) + (when (and userhost (not (string=3D userhost "*"))) + (erc-parse-user userhost))) + (account)) + (when (or (not nick) (string=3D nick "*")) + (setq nick (or uh-nick (erc-current-nick)))) + (cl-assert nick) ; erase me + (setq account (erc-server-user-account (erc-get-server-user nick))) + (erc-v3--update-account "*" nick login host) + (erc-display-message parsed 'notice (current-buffer) + 'ACCOUNT ?a account ?n nick ?s "logged out"))) + + +;;;; UI Helpers + +(defun erc-v3--format-prefix (cusr &optional lettersp) + "When applicable, return string of membership prefixes or letters. +Expect CUSR to be an `erc-channel-user' object. With LETTERSP, +return letters. Add `help-echo' descriptions to all characters." + (and (not (zerop (erc-channel-user-status cusr))) + (let ((alist (erc--parsed-prefix-alist (erc--parsed-prefix)))) + (concat + (and (erc-channel-user-owner cusr) + (propertize (if lettersp "q" (string (alist-get ?q alist))) + 'help-echo "owner")) + (and (erc-channel-user-admin cusr) + (propertize (if lettersp "a" (string (alist-get ?a alist))) + 'help-echo "admin")) + (and (erc-channel-user-op cusr) + (propertize (if lettersp "o" (string (alist-get ?o alist))) + 'help-echo "op")) + (and (erc-channel-user-halfop cusr) + (propertize (if lettersp "h" (string (alist-get ?h alist))) + 'help-echo "half-op")) + (and (erc-channel-user-voice cusr) + (propertize (if lettersp "v" (string (alist-get ?v alist))) + 'help-echo "voice")))))) + +(defun erc-v3--assemble-server-user-info-string (user) + "Format an informative string for USER to display in the echo area. +This is basically what `erc-nick-at-point' shows but with some extra +info." + (let ((away-msg (erc--server-user-away-p user))) + ;; Some NUHs don't have a userhost or just have one or the other. + ;; For now, ignore those. + (concat (and-let* ((login (erc-server-user-login user)) + (host (erc-server-user-host user))) + (concat login "@" host)) + (and-let* ((full-name (erc-server-user-full-name user)) + ((not (string-empty-p full-name)))) + (format " %S" full-name)) + (and away-msg " G") + (and away-msg (not (string-empty-p away-msg)) + (format ": %s" away-msg))))) + +(provide 'erc-v3) + +;;; erc-v3.el ends here +;; +;; Local Variables: +;; generated-autoload-file: "erc-loaddefs.el" +;; End: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index c455ae66431..96a4abdecad 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2389,6 +2389,7 @@ erc-modules (const :tag "track: Track channel activity in the mode-line" track) (const :tag "truncate: Truncate buffers to a certain size" truncate) (const :tag "unmorse: Translate morse code in messages" unmorse) + (const :tag "v3: Enable IRCv3 features" v3) (const :tag "xdcc: Act as an XDCC file-server" xdcc) (repeat :tag "Others" :inline t symbol)) :package-version '(ERC . "5.6") diff --git a/test/lisp/erc/erc-scenarios-v3-account-notify.el b/test/lisp/e= rc/erc-scenarios-v3-account-notify.el new file mode 100644 index 00000000000..29f53e49266 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3-account-notify.el @@ -0,0 +1,133 @@ +;;; erc-scenarios-v3-account-notify.el --- Scenarios for account-notify -*= - lexical-binding: t -*- + +;; Copyright (C) 2022-2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + +;; This shows that JOINs for new channel participants still update the +;; account field if the server lacks `extended-join' but supports +;; `account-tag' (unlikely). The full name remains unknown. +(ert-deftest erc-scenarios-v3-account-notify--account-tag-no-extended-join= () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/account-notify") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + (cons `(now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))) + erc-d-tmpl-vars)) + (erc-v3-extensions '(account-tag echo-message standard-replies)) + (dumb-server (erc-d-run "localhost" t 'no-extended-join)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 10 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "#chan")) + (let ((inhibit-message t)) + (funcall expect 10 "dummy ([email protected]) has joined") + + ;; Note the lack of a full name after the UH. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol)= )) + "dummy: [email protected]")) ; +4 from "*** " + + (funcall expect 10 "welcome"))))) + +;; This shows that the account field in user records of channel +;; participants is updated when `account-notify' is present and +;; `account-tag' is not. Note that `extended-join' isn't relevant here +;; because users "hacker" and "fool" are not logged in when they JOIN. +;; WHOX is present but not relevant either because the users in question +;; join after the client. This also happens to test the `chghost' +;; extension. Note that this is somewhat unrealistic because some +;; servers send `account-tag' regardless of whether it's been +;; negotiated, so long as `message-tags' has. +(ert-deftest erc-scenarios-v3-account-notify--no-account-tag/chghost () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/account-notify") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + (cons `(now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))) + erc-d-tmpl-vars)) + (dumb-server (erc-d-run "localhost" t 'chghost-no-account-tag)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message standard-replies)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "Tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 20 (get-buffer "foonet")) + (ert-info ("Join #chan") + (funcall expect 5 "debug mode"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "hacker ([email protected]) has joined") + + ;; Original host and user for "hacker" still on file. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol))) + "*: [email protected] \"hacker\"")) ; +4 for "*** " + (erc-scenarios-common-say "checkpoint 0") + (funcall expect 5 "fool ([email protected]) has joined") + + ;; Account field for user "fool" is empty. + (should (equal (erc-scenarios-common--nick-at-point (+ 4 (pos-bol))) + "*: [email protected] \"fool\"")) ; +4 for "*** " + (erc-scenarios-common-say "checkpoint 1") + + ;; Host and login updated for "hacker" via CHGHOST. + (funcall expect 5 "<hacker> Changed my host") + (should (equal (erc-scenarios-common--nick-at-point (1+ (pos-bol))) + "jph: [email protected] \"hacker\"")) + (erc-scenarios-common-say "checkpoint 2") + + ;; Account field for user "fool" is populated after ACCOUNT msg. + (funcall expect 5 "<fool> Just logged in") + (should (equal (erc-scenarios-common--nick-at-point (1+ (pos-bol))) + "fool: [email protected] \"fool\"")) + + (funcall expect 5 "<alice> bob: Why do they run away ?")))) + +;;; erc-scenarios-v3-account-notify.el ends here diff --git a/test/lisp/erc/erc-scenarios-v3-sasl.el b/test/lisp/erc/erc-sce= narios-v3-sasl.el new file mode 100644 index 00000000000..df8714c4d10 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3-sasl.el @@ -0,0 +1,199 @@ +;;; erc-scenarios-v3-sasl.el --- SASL v3 tests for ERC -*- lexical-binding= : t -*- + +;; Copyright (C) 2022-2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The point of this file is to test the integration between `erc-v3' +;; and `erc-sasl' because the older library has its own limited stub +;; form of CAP negotiation, which can't coexist with the full version. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + +(defun erc-scenarios-v3-sasl--module-sync () + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (erc-email-userid "tester@school") + (dumb-server (erc-d-run "localhost" t 'plain)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-sasl-mechanism 'plain) + (erc-sasl-user :nick) + (erc-sasl-password "password123") + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg")) + + (ert-info ("Notices received") + (with-current-buffer "ExampleOrg" + (funcall expect 10 "This server is in debug mode") + ;; Regression "\0\0\0\0 ..." caused by (fillarray passphrase 0) + (should (string=3D erc-sasl-password "password123")))))) + +(ert-deftest erc-scenarios-v3-sasl--extension-only () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions '(sasl))) + (erc-scenarios-v3-sasl--module-sync))) + +(ert-deftest erc-scenarios-v3-sasl--module-only () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions nil) + (erc-modules (cons 'sasl erc-modules))) + (erc-scenarios-v3-sasl--module-sync))) + +(ert-deftest erc-scenarios-v3-sasl--module-and-extension () + :tags '(:expensive-test) + (should-not (memq 'sasl erc-v3-extensions)) + (should-not (memq 'sasl erc-modules)) + (let ((erc-v3-extensions '(sasl)) + (erc-modules (cons 'sasl erc-modules))) + (erc-scenarios-v3-sasl--module-sync))) + +(defun erc-v3-scenarios--common--v3-sasl (mech) + (defvar sasl-unique-id-function) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-d-linger-secs 0.5) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t mech)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-user :nick) + (erc-sasl-mechanism mech) + (mock-rvs (list "c5RqLCZy0L4fGkKAZ0hujFBs" "")) + (sasl-unique-id-function (lambda () (pop mock-rvs))) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "jilles" + :password "sesame" + :full-name "jilles") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Notices received") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "jaguar")) + (funcall expect 10 "Found your hostname") + (funcall expect 20 "marked as being away"))))) + +;; This has a 3.2 extension value "sasl=3Dmech". It also simulates a user +;; having the `sasl' module loaded. +(ert-deftest erc-scenarios-v3-sasl--scram-sha-1 () + :tags '(:expensive-test) + (defvar erc-sasl-authzid) + (let ((erc-modules (cons 'sasl erc-modules)) + (erc-sasl-authzid "jilles")) + (erc-v3-scenarios--common--v3-sasl 'scram-sha-1))) + +;; This has no associated CAP value: "LS cap-notify sasl batch ..." +(ert-deftest erc-scenarios-v3-sasl--scram-sha-256 () + :tags '(:expensive-test) + (unless (featurep 'sasl-scram-sha256) + (ert-skip "Emacs lacks sasl-scram-sha256")) + (erc-v3-scenarios--common--v3-sasl 'scram-sha-256)) + +(ert-deftest erc-scenarios-v3-sasl--authentication-failure () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-failed)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-password "wrong") + (erc--warnings-buffer-name "*ERC test warnings*") + (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter))) + + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "Opening connection") + (funcall expect 20 "Problem processing extension") + (funcall expect 20 "SASL authentication failed") + (funcall expect 20 "Connection failed!") + (should-not (erc-server-process-alive)) + (should-not erc-v3--sasl)) ; mode disabled + + (with-current-buffer warnings-buffer + (funcall expect 10 "please review SASL settings"))) + + (when noninteractive + (should-not (get-buffer "*ERC test warnings*")))) + +(ert-deftest erc-scenarios-v3-sasl--unsupported-mechanism () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/sasl") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'plain-unsupported)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(sasl)) + (erc-sasl-mechanism 'scram-sha-1) + (erc--warnings-buffer-name "*ERC test warnings*") + (warnings-buffer (get-buffer-create erc--warnings-buffer-name)) + (inhibit-message noninteractive) + (expect (erc-d-t-make-expecter)) + (buf nil)) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (funcall expect 10 "mechanism") + (funcall expect 20 "aborting") + (funcall expect 20 "Connection failed!"))) + + (with-current-buffer warnings-buffer + (funcall expect 10 "please review SASL settings"))) + + (when noninteractive + (should-not (get-buffer "*ERC test warnings*")))) + +;;; erc-scenarios-v3-sasl.el ends here diff --git a/test/lisp/erc/erc-scenarios-v3.el b/test/lisp/erc/erc-scenario= s-v3.el new file mode 100644 index 00000000000..e6af1a83e3b --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3.el @@ -0,0 +1,587 @@ +;;; erc-scenarios-v3.el --- Scenarios for ERC v3 -*- lexical-binding: t -*- + +;; Copyright (C) 2022-2025 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. + +;; This program 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 this program. If not, see +;; <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; To control the set of active base extensions, edit the selection +;; offered by the server in its CAP LS response. That way, ERC will +;; only ever ask for what's available. + +;; FIXME some of these tests assert brittle implementation details. +;; These should be replaced with higher level behavioral assertions. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-scenarios-common) +(require 'erc-v3) + + +;; This only really shows that status prefixes in 352 RPL_WHOREPLY are +;; reflected in channel-member records. The updates from the /WHO +;; aren't necessary, since the info should already be synced as a result +;; of the MODE #chan +v. +(ert-deftest erc-scenarios-v3-multi-prefix () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/multi-prefix") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-autojoin-channels-alist '((ExampleOrg "#chan"))) + (erc-modules (cons 'v3 erc-modules)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "modes for tester"))) + + (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan")) + (erc-d-t-wait-for 5 "Own status updated" + (erc-channel-user-op-p "tester")) + + ;; Statuses from initial NAMES reply are correct. + (should-not (erc-channel-user-owner-p "tester")) + (should-not (erc-channel-user-admin-p "tester")) + (should-not (erc-channel-user-halfop-p "tester")) + (should-not (erc-channel-user-voice-p "tester")) + + (should-not (erc-channel-user-admin-p "fsbot")) + (should-not (erc-channel-user-halfop-p "fsbot")) + (should (erc-channel-user-owner-p "fsbot")) + (should (erc-channel-user-op-p "fsbot")) + (should (erc-channel-user-voice-p "fsbot")) + + ;; NAMES line printed correctly with correct buttonization. + (funcall expect 10 "~@+fsbot") + (should (equal '(erc-button-nick-default-face erc-notice-face) + (get-text-property (+ 3 (match-beginning 0)) + 'font-lock-face))) + + ;; FIXME the face for the user's current-nick should appear in + ;; front of `erc-default-face', but that's no longer the case. + (funcall expect 10 "@tester") + (should (equal 'erc-current-nick-face + (get-text-property (+ 2 (match-beginning 0)) + 'font-lock-face))) + + (ert-info ("Add voice to self") + (erc-scenarios-common-say "/MODE #chan +v tester") + ;; This is redundant and just for presentation purposes because + ;; the MODE reply triggers the initial record update. + (erc-scenarios-common-say "/WHO #chan")) + + (erc-d-t-wait-for 5 "Voice added to self" + (funcall expect 10 '(: "tester" (+ nonl) " ov "))) + + ;; Internal state updated: user tester has both statuses. + (should-not (or (erc-channel-user-owner-p "tester") + (erc-channel-user-admin-p "tester") + (erc-channel-user-halfop-p "tester"))) + (should (erc-channel-user-op-p "tester")) + (should (erc-channel-user-voice-p "tester"))))) + +;; This shows that full NUHs in a NAMES reply update user records. It +;; also shows that status-prefix updates continue to work even though +;; the reply is now a 353 instead of the 352 at play in the standalone +;; `multi-prefix' test above. +(ert-deftest erc-scenarios-v3-userhost-in-names () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/userhost-in-names") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-modules (cons 'v3 erc-modules)) + (erc-autojoin-channels-alist '((ExampleOrg "#chan" "#spam"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "password123" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "modes for tester"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + + (ert-info ("Ensure NAMES reply updates NUH fields") + (funcall expect 10 "+alice") + (goto-char (1+ (match-beginning 0))) + ;; Without this cap, we'd have a login (~user) and a host name + ;; for Bob (because he speaks) but only a nick for Alice. + (let ((user-data (erc-nick-at-point))) + (should (eq user-data (erc-get-server-user "alice"))) + (should (erc-server-user-login user-data)))) ; ~user + + ;; Everything below concerns the multi-prefix integration. + (ert-info ("Prefixes correctly assigned") + (should-not (erc-channel-user-owner-p "alice")) + (should-not (erc-channel-user-admin-p "alice")) + (should-not (erc-channel-user-op-p "alice")) + (should-not (erc-channel-user-halfop-p "alice")) + (should (erc-channel-user-voice-p "alice")) + + (should-not (erc-channel-user-owner-p "bob")) + (should-not (erc-channel-user-admin-p "bob")) + (should (erc-channel-user-op-p "bob")) + (should (erc-channel-user-halfop-p "bob")) + (should (erc-channel-user-voice-p "bob"))) + + (ert-info ("Buttonizing correctly applied") + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (should (search-forward "tester" nil t)) + ;; FIXME the face for the user's current-nick should appear in + ;; front of `erc-default-face', but that's no longer the case. + (should (memq 'erc-current-nick-face + (ensure-list + (get-text-property (1- (point)) 'font-lock-face))))= )) + + ;; Check buttonizing of statused nicks in names list. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + ;; Mike appears before joe because @ is more important than +. + (funcall expect 10 "@mike") + (should (equal (get-text-property (1+ (match-beginning 0)) + 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (funcall expect 10 "+joe") + (should (equal (get-text-property (1+ (match-beginning 0)) + 'font-lock-face) + '(erc-button-nick-default-face erc-notice-face))) + (funcall expect 10 "RELAX") + (should (equal (get-text-property (match-beginning 0) 'font-lock-fac= e) + '(erc-notice-face)))))) + +(ert-deftest erc-scenarios-v3-server-time () + :tags '(:expensive-test) + (let ((erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/server-time") + (erc-server-flood-penalty 0.1) + (erc-stamp--tz t) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (dumb-server-buffer (get-buffer "*erc-d-server*")) + (erc-v3-extensions ()) ; server-time included in base set + ;; See `erc-v3--server-time-update-phantom-cmem' for the + ;; trivial `nicks' and `button' integration. + (erc-modules `(v3 nicks fill-wrap ,@erc-modules)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "password123" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#foo")) + ;; Wait for the last message in replay because messages are + ;; inserted out of order. + (funcall expect 20 "<underpersona> \"Beware the") + (funcall expect 2 "[Wed Sep 23 2020]" (point-min)) + (funcall expect 2 "<underpersona> 'Twas brillig") + (funcall expect 2 "[23:50]") + (funcall expect 2 "<underpersona> Did gyre and gimble") + (funcall expect 2 "[23:51]") + ;; + (funcall expect 2 "[Thu Sep 24 2020]") + (funcall expect 2 "<sneercat> All mimsy") + (funcall expect 2 "[00:00]") + (funcall expect 2 "<sneercat> And the mome") + (funcall expect 2 "[00:01]") + (funcall expect 2 "<underpersona> \"Beware the") + (funcall expect 2 "[00:05]") + (funcall expect 10 "\n\n[") + (funcall expect 10 "*** You have joined channel #foo") + (funcall expect 10 "*** Users on #foo") + (funcall expect 10 "*** #foo modes:") + (funcall expect 10 "*** #foo was created on")) + + (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#bar")) + ;; Wait for the the last message in replay. + (funcall expect 20 "<sneercat> And stood awhile") + (funcall expect 10 "[Thu Sep 24 2020]" (point-min)) + (funcall expect 2 "<underpersona> The jaws that bite") + (funcall expect 2 "[06:46]") + (funcall expect 2 "<sneercat> Beware the Jubjub") + (funcall expect 2 "[06:55]") + (funcall expect 2 "<sneercat> The frumious") + (funcall expect 2 "[06:56]") + (funcall expect 2 "<underpersona> He took") + (funcall expect 2 "[07:03]") + (funcall expect 2 "<underpersona> Long time") + (funcall expect 2 "<sneercat> So rested") + (funcall expect 2 "[07:20]") + (funcall expect 2 "<sneercat> And stood awhile") + (funcall expect 10 "\n\n[") + (funcall expect 10 "*** You have joined channel #bar") + (funcall expect 10 "*** Users on #bar") + (funcall expect 10 "*** #bar modes:") + (funcall expect 10 "*** #bar was created on"))))) + +(ert-deftest erc-scenarios-v3-echo-message () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/echo-message") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `(,@erc-d-tmpl-vars + (now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter)) + ;; Ensure the message text body appears in `erc-input-face'. + (check-input-face + (lambda () + (eq 'erc-input-face + (get-text-property (1- (point)) 'font-lock-face)))) + (check-action-face + (lambda () + (equal '(erc-input-face erc-action-face) + (get-text-property (1- (point)) 'font-lock-face))))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall expect 10 "You have been marked as being away"))) + + (ert-info ("Chan buffer #chan populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + ;; Ensure own messages in non-batch playback history show up. + (funcall expect 5 "<tester> Howdy from the past!") + (should (funcall check-input-face)) + ;; Ensure the speaker looks like that for an outgoing message. + (should (equal '(erc-button-nick-default-face erc-my-nick-face) + (get-text-property (+ 2 (pos-bol)) 'font-lock-face)= )) + + (funcall expect 5 "That lady is not now living") + (erc-scenarios-common-say "hi from the present") + (funcall expect 5 "<tester> hi from the present") + (should (funcall check-input-face)) + ;; Ensure the speaker looks like that for an outgoing message. + (should (equal '(erc-button-nick-default-face erc-my-nick-face) + (get-text-property (+ 2 (pos-bol)) 'font-lock-face)= )) + (erc-d-t-absent-for 0.1 "<tester> hi" (point)) ; no dupes + + (funcall expect 5 "<alice> bob: And reason says you") + (erc-scenarios-common-say "/me sad") + (funcall expect 5 "* tester sad") + (should (funcall check-action-face)) + (erc-d-t-absent-for 0.1 "* tester sad" (point)) + + (funcall expect 5 "<alice> bob: Than all yon fiery") + ;; Sending a /msg opens a query on receipt of the echo. + (erc-scenarios-common-say "/msg bob hi"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "bob")) + (funcall expect 1 "<tester> hi") + (should (funcall check-input-face)) + (erc-d-t-absent-for 0.1 "<tester> hi" (point)) + (funcall expect 5 "<bob> Here lives a caitiff wretch") + + ;; Echoed non-ACTION CTCPs don't trigger an outgoing answer (NOTICE). + (erc-scenarios-common-say "/ctcp bob VERSION") + (funcall expect 10 "*** Version for bob is ERC") + (erc-d-t-absent-for 0.1 "*** Version for tester" (point)) + + (erc-scenarios-common-say "/me tired") + (funcall expect 5 "* tester tired") + (should (funcall check-action-face)) + (erc-d-t-absent-for 0.1 "* tester tired" (point))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: Ha! now I see")))) + +(ert-deftest erc-scenarios-v3-extended-join () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/extended-join") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `(,@erc-d-tmpl-vars + (now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "J. Random Hacker") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "ExampleOrg= ")) + (funcall expect 5 "User modes for tester") + (erc-cmd-JOIN "#chan")) + (erc-d-t-wait-for 10 "buffer #chan ready" (get-buffer "#chan")) + (should (equal erc-autojoin-channels-alist '((ExampleOrg "#chan")))) + + (ert-info ("Chan buffer #chan populated") + (let ((inhibit-message t)) + (with-current-buffer "#chan" + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "alice (aph: [email protected]) has joined") + (should + (equal (erc-scenarios-common--nick-at-point (match-beginning 0)) + "aph: [email protected] \"Alyssa P. Hacker\"")) + (erc-scenarios-common-say "checkpoint 0") + + ;; Historical intel not available when a user leaves (without + ;; backing store). + (funcall expect 5 "alice ([email protected]) has left") + (should-not + (erc-scenarios-common--nick-at-point (match-beginning 0))) + (erc-scenarios-common-say "checkpoint 1") + + ;; Intel available again once user rejoins. + (funcall expect 5 "alice (aph: [email protected]) has joined") + (should + (equal (erc-scenarios-common--nick-at-point (match-beginning 0)) + "aph: [email protected] \"Alyssa P. Hacker\"")) + (erc-scenarios-common-say "checkpoint 2") + + (funcall expect 5 "alice ([email protected]) has quit") + (should-not + (erc-scenarios-common--nick-at-point (match-beginning 0)))))))) + +;; For now, this also demos some `account-tag' stuff +;; +;; TODO add a scenario where names aren't received and instead just a +;; 315 sans token, after a 263 error: +;; +;; :molybdenum.libera.chat 263 me WHO :This command could not be ... +;; :molybdenum.libera.chat 315 me * :End of /WHO list. + +(ert-deftest erc-scenarios-v3-whox--basic () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/whox") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer + (erc-d-t-wait-for 10 "server buffer ready" (get-buffer "foonet")) + (funcall expect 10 "User modes for tester") + (erc-cmd-JOIN "#chan") + (erc-cmd-JOIN "#spam")) + + (ert-info ("Buffer #spam populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 5 "You have joined channel #spam") + (funcall expect 20 "<joe> mike: Excellent"))) + + (ert-info ("Bob's account is known at join time") + (with-current-buffer "foonet" + (should (equal (erc-server-user-account (erc-get-server-user "alic= e")) + "alice")) + (should (equal (erc-server-user-account (erc-get-server-user "bob"= )) + "bob")) + (should-not (erc-server-user-account (erc-get-server-user "fool"))= ))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: With him! why")))) + +(ert-deftest erc-scenarios-v3-whox--rate-limited () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/whox") + (erc-server-flood-penalty 0.1) + erc-accidental-paste-threshold-seconds + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'rate-limited)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (erc-v3--whox-mode-hook + (list (lambda () (when erc-v3--whox + (setf (erc-v3--whox-penalty erc-v3--whox) 1))))) + (expect (erc-d-t-make-expecter)) + (gecosp (lambda (name) + (let ((inhibit-message noninteractive)) + (string-search name (erc-scenarios-common--nick-at-point + (point))))))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "foonet")) + (funcall expect 10 "User modes for tester") + (erc-cmd-JOIN "#chan") + (erc-cmd-JOIN "#foo") + (erc-cmd-JOIN "#bar") + (erc-cmd-JOIN "#baz") + (erc-cmd-JOIN "#spam")) + + (ert-info ("Full names not yet known") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "chan_foo") + (should-not (funcall gecosp "Chan Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + (funcall expect 5 "foo_foo") + (should-not (funcall gecosp "Foo Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#bar")) + (funcall expect 5 "bar_foo") + (should-not (funcall gecosp "Bar Fool"))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#baz")) + (funcall expect 5 "baz_foo") + (should-not (funcall gecosp "Baz Fool")))) + + (ert-info ("Buffer #spam populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 5 "<joe> mike: Excellent"))) + + ;; Full names are now known. + (dolist (chan '("chan" "foo" "bar" "baz" "spam")) + (with-current-buffer (concat "#" chan) + (goto-char (point-min)) + (search-forward (concat chan "_foo")) + (should (funcall gecosp (concat (upcase-initials chan) " Fool"))))= ))) + +(ert-deftest erc-scenarios-v3-away-notify () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/away-notify") + (erc-server-flood-penalty 0.1) + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester:changeme" + :full-name "tester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 5 "User modes for tester"))) + + (ert-info ("Chan buffer #chan populated") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 5 "<alice> bob: That is, hot ice"))) + + (with-current-buffer "foonet" + (let ((user-fool (erc-get-server-user "fool"))) + ;; Incidentally, fool's account was added by the WHOX response. + (should (erc-server-user-account user-fool)) + ;; AWAY messages affect user records. + (should-not (erc--server-user-away-p user-fool)) + (erc-d-t-wait-for 5 "Fool sets AWAY msg" + (equal (erc--server-user-away-p user-fool) "afk")) + (erc-d-t-wait-for 5 "Fool clears AWAY msg" + (not (erc--server-user-away-p user-fool))))) + + (with-current-buffer "#chan" + (funcall expect 5 "<bob> alice: Which the false")))) + +(ert-deftest erc-scenarios-v3-cap-notify () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/cap-notify") + (erc-server-flood-penalty 0.1) + erc-autojoin-channels-alist + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'basic)) + (port (process-contact dumb-server :service)) + (erc-modules (cons 'v3 erc-modules)) + (erc-v3-extensions '(echo-message)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "pretester" + :password "changeme" + :full-name "pretester") + (should (string=3D (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 5 "You have joined channel #chan") + (funcall expect 20 "ty for sharing") + (should erc-v3--extended-join) + (should erc-v3--away-notify)) + + (with-current-buffer "Libera.Chat" + (should-not (erc-v3--caps-timer erc-v3--caps))))) + +;;; erc-scenarios-v3.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index f6a8d40748f..97a24cc6f15 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3560,6 +3560,7 @@ erc-tests--modules track truncate unmorse + v3 xdcc)) =20 ;; Ensure that `:initialize' doesn't change the ordering of the diff --git a/test/lisp/erc/erc-v3-tests.el b/test/lisp/erc/erc-v3-tests.el new file mode 100644 index 00000000000..8f93871703d --- /dev/null +++ b/test/lisp/erc/erc-v3-tests.el @@ -0,0 +1,1364 @@ +;;; erc-v3-tests.el --- Tests for erc-v3 -*- lexical-binding:t -*- + +;; Copyright (C) 2021-2025 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/>. + +;;; Commentary: + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-tests-common))) + +(require 'erc-v3) + +(defvar erc-v3-tests--calls nil) + +(erc-v3--define-capability test/a) +(erc-v3--define-capability test/b) +(erc-v3--define-capability test/c) +(erc-v3--define-capability test/d) +(erc-v3--define-capability test/e) +(erc-v3--define-capability test/f) + +(erc-v3--define-capability test/m + (when erc-v3--test/m + (error "This is an enable failure"))) + +(erc-v3--define-capability test/n + (unless erc-v3--test/n + (error "This is a disable failure"))) + +(erc-v3--define-capability test/m-1 :depends '(test/m)) + +(erc-v3--define-extension test/o + (push erc-v3--test/o erc-v3-tests--calls)) + +(defvar erc-v3-tests--parser-tests + (expand-file-name "erc-d/resources/irc-parser-tests.eld" + (ert-resource-directory))) + +;; To find stray negotiation states that can be pruned from +;; `erc-v3--edges', you can do: +;; +;; (trace-function-background #'erc-v3--get-state) +;; +;; And filter the output with: +;; +;; cat test/lisp/erc/*.log | grep -E '^1 (<|-)' | \ +;; sed -e 's/[^(]\+//' -e 's/erc-v3--transition //' \ +;; -e 's/ [^)]\+//' -e 's/[()]//g' | sort | uniq | less +;; +;; Then compare it to the output of macro-expanding `erc-v3--make-edges' +;; or mapping over atoms that start with: "erc-v3--state-". + +;; These new states are only used by tests for demonstrating that +;; modifying `erc-v3--edges' to accommodate arbitrary behavior is +;; possible but unruly. +(defconst erc-v3--state-Sa-Wo-Me-Pu (make-symbol "Sa-Wo-Me-Pu")) +(defconst erc-v3--state-Sa-Wo-Mi-Pu (make-symbol "Sa-Wo-Mi-Pu")) +(defconst erc-v3--state-Sa-Wo-Mo-Py (make-symbol "Sa-Wo-Mo-Py")) +(defconst erc-v3--state-Si-We-Mo-Pa (make-symbol "Si-We-Mo-Pa")) +(defconst erc-v3--state-Si-We-Mo-Py (make-symbol "Si-We-Mo-Py")) +(defconst erc-v3--state-Si-Wo-Me-Pa (make-symbol "Si-Wo-Me-Pa")) +(defconst erc-v3--state-Si-Wo-Mo-Po (make-symbol "Si-Wo-Mo-Po")) +(defconst erc-v3--state-Si-Wo-Mo-Py (make-symbol "Si-Wo-Mo-Py")) + +(defconst erc-v3--event-wOFF (make-symbol "wOFF")) + +;; This addendum to the main table shows that user code could decide to +;; override an "UP" phase, which normally effects a local Mo -> Mi +;; component change, and still continue a well-behaved protocol flow by +;; telling the server to sync down. +;; +;; Note that this and other tests introduce a made-up "wOFF" event, +;; which means that the extension was declared unwanted externally. +(defvar erc-v3-tests--preempt-up-edges + `((,erc-v3--state-Si-Wi-Mo-Pa + (,erc-v3--event-wOFF ,erc-v3--state-Si-Wo-Mo-Py ,erc-v3--phase-QOUT)) + (,erc-v3--state-Si-Wo-Mo-Py + (,erc-v3--event-pOUT ,erc-v3--state-Si-Wo-Mo-Po ,erc-v3--phase-SEND)) + (,erc-v3--state-Si-Wo-Mo-Po + (,erc-v3--event-sACK ,erc-v3--state-Sa-Wo-Mo-Py + ,erc-v3--phase-QIN) ; queue good REQ- sync + (,erc-v3--event-sNAK ,erc-v3--state-Si-We-Mo-Py + ,erc-v3--phase-QIN) ; queue rejected REQ- log + (,erc-v3--event-pERR ,erc-v3--state-Si-Wo-Me-Pa + ,erc-v3--phase-LOG)) ; timeout REQ- + (,erc-v3--state-Sa-Wo-Mo-Py + (,erc-v3--event-pIN ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS)) ; good REQ- from wOFF + (,erc-v3--state-Si-We-Mo-Py + (,erc-v3--event-pIN ,erc-v3--state-Si-We-Mo-Pa + ,erc-v3--phase-LOG)) ; rejected REQ- for ^ + (,erc-v3--state-Sa-Wo-Mo-Pa ; unrelated to main path above + (,erc-v3--event-wON ,erc-v3--state-Sa-Wi-Mo-Py + ,erc-v3--phase-QOUT)))) ; made wanted during che= ck + +;; This simulates an ISUPPORT-based extension already enabled +;; successfully now becoming unwanted because a better offer arrives, +;; perhaps via NEW, which provides overlapping but incompatible +;; functionality. +(defvar erc-v3-tests--make-unwanted-edges + ;; Disabling of enabled non-cap extension + `((,erc-v3--state-Sa-Wi-Mi-Pu ; e.g., better offer made + (,erc-v3--event-wOFF ,erc-v3--state-Sa-Wo-Mi-Pu ,erc-v3--phase-DOWN)) + ;; Mode deactivation for non-cap extension + (,erc-v3--state-Sa-Wo-Mi-Pu + (,erc-v3--event-mOK ,erc-v3--state-Sa-Wo-Mo-Pu + ,erc-v3--phase-PASS) ; mode deactivation success + (,erc-v3--event-mERR ,erc-v3--state-Sa-Wo-Me-Pu + ,erc-v3--phase-LOG)))) ; mode deactivation failu= re + +(defun erc-v3-tests--modify-edges (additions &optional graph) + "Splice new ADDITIONS into transition GRAPH, returning a copy." + (setq graph (mapcar #'copy-sequence (or graph erc-v3--edges))) + (pcase-dolist (`(,key . ,entries) additions) + (if-let* ((existing (assq key graph))) + (dolist (entry entries) + (cl-pushnew entry (cdr existing) :test #'equal)) + (push (cons key entries) graph))) + graph) + +(defun erc-v3-tests--slots (slots &optional objects) + (mapcar (lambda (o) + (mapcar (lambda (slot) + (let ((v (cl-struct-slot-value (type-of o) slot o))) + (if (memq slot '(state event phase)) + (intern (symbol-name v)) + v))) + slots)) + (or objects (erc-v3--caps-objects erc-v3--caps)))) + +(ert-deftest erc-v3--enabled-p () + (should-not (erc-v3--enabled-p + (erc-v3--test/a :state erc-v3--state-Sa-Wo-Mo-Pa))) + (should (erc-v3--enabled-p + (erc-v3--test/a :state erc-v3--state-Si-Wi-Mi-Pa)))) + +(ert-deftest erc-v3--deps-gather-dependents () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (e (erc-v3--test/e :depends '(test/d))) + (abcd-fn (lambda (o) (memq o (list a b c d)))) + (erc-v3--session-dag (erc-v3--deps-build-dag (list a b c d e)))) + + (should (equal erc-v3--session-dag `((,d ,e) (,c ,d) (,b ,d ,c)))) + (should (equal (erc-v3--deps-gather-dependents a abcd-fn) nil)) + (should (equal (erc-v3--deps-gather-dependents b abcd-fn) (list c d))) + (should (equal (erc-v3--deps-gather-dependents c abcd-fn) (list d))) + (should (equal (erc-v3--deps-gather-dependents d abcd-fn) nil)) + (should (equal (erc-v3--deps-gather-dependents + b (lambda (o) (memq o (list b c)))) + (list c))))) + +(ert-deftest erc-v3--deps-build-dag () + (let ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (e (erc-v3--test/e :depends '(test/d)))) + ;; Only direct dependents make up the tail of each member. + (should (equal (erc-v3--deps-build-dag (list a b c d e)) + `((,d ,e) (,c ,d) (,b ,d ,c)))))) + +(ert-deftest erc-v3--deps-tsort () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :depends '(test/b))) + (d (erc-v3--test/d :depends '(test/b test/c))) + (objects (list a b c d)) + (graph (erc-v3--deps-build-dag objects))) + (should (equal (erc-v3--deps-tsort objects graph) (list b c d a)))) + + (let* ((a (erc-v3--test/a :depends '(test/e test/f))) + (b (erc-v3--test/b :depends '(test/e))) + (c (erc-v3--test/c :depends '(test/f))) + (d (erc-v3--test/d :depends '(test/c))) + (e (erc-v3--test/e)) + (f (erc-v3--test/f)) + (objects (list a b c d e f)) + (graph (erc-v3--deps-build-dag objects))) + (should (equal (erc-v3--deps-tsort objects graph) (list f e c d b a)))= )) + +;; Ask for soft dependencies, which may include unknown extensions. +(ert-deftest erc-v3--deps-build-dag/soft () + (let* ((a (erc-v3--test/a)) + (b (erc-v3--test/b)) + (c (erc-v3--test/c :supports '(test/? test/b))) + (d (erc-v3--test/d :supports '(test/b) :depends '(test/c)))) + (dotimes (_ 8) + (let* ((objects (sort (list a b c d) (lambda (_ _) (zerop (random 2)= )))) + (graph (erc-v3--deps-build-dag objects 'softp))) + (should (member (erc-v3--deps-tsort objects graph) + (list (list a b c d) ; item `a' can go anywhere + (list b a c d) + (list b c a d) + (list b c d a))))))) + + (let* ((a (erc-v3--test/a :supports '(test/?? test/?))) + (b (erc-v3--test/b :supports '(test/? test/a))) + (c (erc-v3--test/c :supports '(test/b tests/?? test/?))) + (d (erc-v3--test/d :supports '(test/? test/c) :depends '(test/a))) + (e (erc-v3--test/e :supports '(test/a test/??) :depends '(test/c)= ))) + (dotimes (_ 10) + (let* ((objects (sort (list a b c d e) + (lambda (_ _) (zerop (random 2))))) + (graph (erc-v3--deps-build-dag objects 'softp)) + (result (erc-v3--deps-tsort objects graph))) + (should (member result (list (list a b c d e) + (list a b c e d)))))))) + +;; FIXME redo this to include error handling. +(ert-deftest erc-v3--ensure-disabled () + (erc-tests-common-make-server-buf) + (let* ((erc-v3--edges (erc-v3-tests--modify-edges + erc-v3-tests--make-unwanted-edges)) + (a (erc-v3--test/a)) + (b (erc-v3--test/b :state erc-v3--state-Sa-Wo-Mi-Pu)) + (c (erc-v3--test/c :depends '(test/b) + :state erc-v3--state-Sa-Wo-Mi-Pu)) + (d (erc-v3--test/d :depends '(test/b test/c) + :state erc-v3--state-Sa-Wo-Mi-Pu)) + (erc-v3--test/a t) + (erc-v3--test/d t) + (erc-v3--test/b t) + (erc-v3--test/c t) + (erc-v3--caps (make-erc-v3--caps :objects (list a b c d)))) + + ;; Accepts empty input. + (erc-v3--ensure-disabled ()) + + (erc-v3--ensure-disabled (list b)) + (should erc-v3--test/a) + (should-not erc-v3--test/b) + (should-not erc-v3--test/c) + (should-not erc-v3--test/d) + (should (eq (erc-v3--extension-state b) erc-v3--state-Sa-Wo-Mo-Pu)) + (should (eq (erc-v3--extension-state c) erc-v3--state-Sa-Wo-Mo-Pu)) + (should (eq (erc-v3--extension-state d) erc-v3--state-Sa-Wo-Mo-Pu)))) + +;; FIXME test error handling in both server and target buffers. +(ert-deftest erc-v3--ensure-enabled () + (erc-tests-common-make-server-buf) + (letrec + ((calls nil) + (a (erc-v3--test/a)) + (b (erc-v3--test/b :initp t)) + (c (erc-v3--test/c :depends '(test/b) :initp t)) + (d (erc-v3--test/d :depends '(test/b test/c) :initp t)) + (erc-v3--test/a-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/a) calls))) + (erc-v3--test/b-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/b) calls))) + (erc-v3--test/c-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/c) calls))) + (erc-v3--test/d-mode-hook + (lambda () (push (erc-v3--extension-canon erc-v3--test/d) calls))) + (erc-v3--caps (make-erc-v3--caps :objects (list a b c d))) + (reset + (lambda () + (setf calls nil + erc-v3--test/b nil + erc-v3--test/c nil + erc-v3--test/d nil + (erc-v3--extension-phase b) erc-v3--phase-UP + (erc-v3--extension-phase c) erc-v3--phase-UP + (erc-v3--extension-phase d) erc-v3--phase-UP + (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mo-Pa + (erc-v3--extension-state c) erc-v3--state-Si-Wi-Mo-Pa + (erc-v3--extension-state d) erc-v3--state-Si-Wi-Mo-Pa))) + (assert-common + (lambda () + (should (eq (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mi-P= a)) + (should (eq (erc-v3--extension-state c) erc-v3--state-Si-Wi-Mi-P= a)) + (should (eq (erc-v3--extension-state d) erc-v3--state-Si-Wi-Mi-P= a)) + (should erc-v3--test/b) + (should erc-v3--test/c) + (should erc-v3--test/d)))) + + (ert-info ("All deps are not yet active") + (funcall reset) + (erc-v3--ensure-enabled (list b c d)) + (funcall assert-common) + (should (equal calls '(test/d test/c test/b)))) + + (ert-info ("Activation skipped when B already active") + (funcall reset) + (setq erc-v3--test/b b) + (setf (erc-v3--extension-state b) erc-v3--state-Si-Wi-Mi-Pa + (erc-v3--extension-phase b) erc-v3--phase-PASS) + (erc-v3--ensure-enabled (list b c d)) + (funcall assert-common) + (should (equal calls '(test/d test/c)))))) + +;; This is meant to show that an extension's mode activation function +;; (non-interactive "mode command") does not set the variable. See the +;; `:variable' value in the expansion of the `define-minor-mode' form. +(ert-deftest erc-v3--extension () + (erc-tests-common-make-server-buf) + + ;; Calling the mode function does not set the variable, and its value + ;; remains nil and isn't set locally. + (let ((erc-v3-tests--calls ())) + (should-not erc-v3--test/o) + (erc-v3--test/o-mode +1) + (should-not erc-v3--test/o) + (should-not (local-variable-p 'erc-v3--test/o)) + (should (equal erc-v3-tests--calls '(nil)))) ; "disable body" ran + + ;; Setting the mode variable beforehand runs the "enable body". + (let ((erc-v3-tests--calls ())) + (setq erc-v3--test/o (erc-v3--test/o)) + (should (local-variable-p 'erc-v3--test/o)) + (erc-v3--test/o-mode +1) + (should (erc-v3--test/o-p erc-v3--test/o)) + (should (equal erc-v3-tests--calls (list erc-v3--test/o)))) + + ;; Running the mode activation function in a target buffer *does* set + ;; the variable as well as run the enable body. + (with-current-buffer (erc--open-target "#chan") + (let ((erc-v3-tests--calls ())) + (should-not erc-v3--test/o) + (erc-v3--test/o-mode +1) + (should (erc-v3--test/o-p erc-v3--test/o)) + (should (local-variable-p 'erc-v3--test/o)) + (should (equal erc-v3-tests--calls (list erc-v3--test/o))))) + + ;; Disabling the mode *does* set the variable to nil but doesn't kill + ;; the local binding, which is consistent with "real" minor modes. + (let ((erc-v3-tests--calls ())) + (erc-v3--test/o-mode -1) + (should-not erc-v3--test/o) + (should (equal erc-v3-tests--calls '(nil))) + (should (local-variable-p 'erc-v3--test/o))) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-v3--define-extension () + (should + (equal + (macroexpand '(erc-v3--define-extension foo)) + '(progn + + (cl-defstruct (erc-v3--foo (:include erc-v3--extension + (canon 'foo)) + (:constructor erc-v3--foo)) + "IRCv3 `foo' extension.") + + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--extension) + + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))))) + +(ert-deftest erc-v3--define-capability () + ;; Baseline, almost identical to expansion of extension, above. + (should + (equal (macroexpand '(erc-v3--define-capability foo :depends '(bar))) + '(progn + (cl-defstruct (erc-v3--foo (:include erc-v3--capability + (canon 'foo) + (depends '(bar))) + (:constructor erc-v3--foo)) + "IRCv3 `foo' capability.") + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))= )) + + ;; With doc string, slots, and aliases. + (should + (equal (macroexpand '(erc-v3--define-capability foo + "Hello World." + :slots ((somefield 1)) + :aliases '(bar baz))) + '(progn + (cl-defstruct (erc-v3--foo (:include erc-v3--capability + (canon 'foo) + (aliases '(bar baz))) + (:constructor erc-v3--foo)) + "Hello World." + (somefield 1)) + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'bar 'erc-v3--extension-class 'erc-v3--foo) + (put 'baz 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "Internal minor mode for `erc-v3--foo'." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v)))))= )) + + (should + (equal (macroexpand '(erc-v3--define-capability + (foo (:include erc-v3--cap-notify) + (:constructor erc-v3--my-foo)) + "Hello World." + :initp erc-button-mode + :keymap my-keymap + "My mode." + (always) (ignore))) + '(progn + (cl-defstruct (erc-v3--foo ( :include erc-v3--cap-notify + (canon 'foo) + (initp erc-button-mode)) + (:constructor erc-v3--my-foo) + (:constructor erc-v3--foo)) + "Hello World.") + ;; Only namesake constructor referenced. + (put 'foo 'erc-v3--extension-class 'erc-v3--foo) + (put 'foo 'erc-v3--extension-minor-mode 'erc-v3--foo-mode) + (put 'erc-v3--foo 'erc-v3--extension-canon 'foo) + (put 'erc-v3--foo 'erc-v3--extension-super 'erc-v3--capabilit= y) + (defvar-local erc-v3--foo nil + "Local instance of `erc-v3--foo' when enabled.") + (define-minor-mode erc-v3--foo-mode + "My mode." + :interactive nil + :variable + ((buffer-local-value 'erc-v3--foo (erc-server-buffer)) + . (lambda (v) (erc-v3--sync-mode-value 'erc-v3--foo v))) + (always) (ignore)) + (setf (alist-get 'erc-v3--foo minor-mode-map-alist) my-keymap= ))))) + +(ert-deftest erc-v3--canon-from-key () + (should (eq (erc-v3--canon-from-key 'cap-notify) 'cap-notify)) + (should (eq (erc-v3--canon-from-key '-cap-notify) 'cap-notify)) + (should-not (erc-v3--canon-from-key 'whox))) + +(ert-deftest erc-v3--define-extension-subclass--minor-mode () + (ert-info ("Callable but not bound as a variable") + (should (fboundp 'erc-v3--test/a-mode)) + (should (boundp 'erc-v3--test/a-mode-hook)) + (should-not (boundp 'erc-v3--test/a-mode)) + (should (eq (get 'test/a 'erc-v3--extension-minor-mode) + 'erc-v3--test/a-mode))) + + (ert-info ("Value in target buffers") + (with-current-buffer (get-buffer-create "FooNet") + (erc-tests-common-prep-for-insertion) + (setq erc-server-process (start-process "t" (current-buffer) "true")) + (set-process-query-on-exit-flag erc-server-process nil) + (with-current-buffer (get-buffer-create "#chan") + (erc-tests-common-prep-for-insertion) + (setq erc-server-process + (with-current-buffer "FooNet" erc-server-process))) + + (ert-info ("Copies server buffer's nil value to targets") + (should-not (local-variable-p 'erc-v3--test/a)) + (should-not erc-v3--test/a) + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode +1)) + (with-current-buffer "#chan" + (should (local-variable-p 'erc-v3--test/a)) + (should-not (eq erc-v3--test/a t))) + ;; Server-buffer's copy not set because redundant + (should-not (local-variable-p 'erc-v3--test/a)) + (should-not erc-v3--test/a)) + + (ert-info ("Copies server buffer's non-nil value to targets") + (let ((v (setq erc-v3--test/a (erc-v3--test/a)))) + (should (erc-v3--test/a-p v)) + ;; Target's copy not updated automatically + (with-current-buffer "#chan" + (should-not erc-v3--test/a)) + ;; Manually call mode activation function + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode +1)) + (ert-info ("Server's value intact") + (should (eq v erc-v3--test/a))) + (with-current-buffer "#chan" + (should (erc-v3--test/a-p erc-v3--test/a)) + (should (eq v erc-v3--test/a))))) + + (ert-info ("Sets all instances to nil when mode disabled.") + (erc-with-all-buffers-of-server erc-server-process nil + (erc-v3--test/a-mode -1)) + (should-not erc-v3--test/a) + (with-current-buffer "#chan" + (should-not erc-v3--test/a))) + + (when noninteractive + (kill-buffer "#chan") + (kill-buffer))))) + +(ert-deftest erc-parse-server-response () + (let* ((data (with-temp-buffer + (insert-file-contents erc-v3-tests--parser-tests) + (read (current-buffer)))) + (tests (assoc-default 'tests (assoc-default 'msg-split data))) + (erc-v3-mode t) + input atoms m ours) + + (cl-letf (((symbol-function 'erc-handle-parsed-server-response) + (lambda (_ m) m))) + (dolist (test tests) + (setq input (assoc-default 'input test) + atoms (assoc-default 'atoms test) + m (erc-parse-server-response nil input)) + + (ert-info ("Parses tags correctly") + (setq ours (erc-response.tags m)) + (if-let* ((tags (assoc-default 'tags atoms))) + (pcase-dolist (`(,key . ,value) ours) + (should (string=3D (cdr (assq key tags)) (or value "")))) + (should-not ours))) + + (ert-info ("Parses verbs correctly") + (setq ours (erc-response.command m)) + (if-let* ((verbs (assoc-default 'verb atoms))) + (should (string=3D (downcase verbs) (downcase ours))) + (should (string-empty-p ours)))) + + (ert-info ("Parses sources correctly") + (setq ours (erc-response.sender m)) + (if-let* ((source (assoc-default 'source atoms))) + (should (string=3D source ours)) + (should (string-empty-p ours)))) + + (ert-info ("Parses params correctly") + (setq ours (erc-response.command-args m)) + (if-let* ((params (assoc-default 'params atoms))) + (should (equal ours params)) + (should-not ours))))))) + +(cl-defun erc-v3-tests--build-message (&key tags source verb params) + "Build an outgoing message string from parts." + (pcase-let* ((`(,n . ,p) (reverse params)) + (rest `(,@(and source (list (concat ":" source))) + ,verb + ,@(nreverse p) + ,@(and n (list (concat ":" n)))))) + (concat (and tags (erc-v3--merge-client-tags tags)) + (string-join rest " ")))) + +;; Unfortunately, we can't really do the same for ERC's +;; message-building functions because they're currently scattered +;; everywhere. + +(ert-deftest erc-v3--merge-client-tags () + (let* ((data (with-temp-buffer + (insert-file-contents erc-v3-tests--parser-tests) + (read (current-buffer)))) + (tests (assoc-default 'tests (assoc-default 'msg-join data)))) + + (dolist (test tests) + (let ((atoms (alist-get 'atoms test)) + (desc (alist-get 'desc test)) + (want (alist-get 'matches test))) + (ert-info (desc) + (should (member (erc-v3-tests--build-message + :tags (alist-get 'tags atoms) + :source (alist-get 'source atoms) + :verb (alist-get 'verb atoms) + :params (alist-get 'params atoms)) + want))))))) + +(ert-deftest erc--server-CAP/continued-LIST () + (erc-tests-common-make-server-buf (buffer-name)) + (cl-letf* ((calls ()) + ((symbol-function 'erc-server-send) + (lambda (msg &rest _) (push msg calls)))) + + (erc-v3-mode +1) + ;; Pretend negotiation is over. + (setf (erc-v3--caps-negotiated-p erc-v3--caps) t) + + (ert-info ("Processing deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST * :test/a test/b") + (should-not calls) + (should (equal (erc-v3--caps-continued erc-v3--caps) + '("test/a test/b")))) + + (ert-info ("Processing deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST * :test/c") + (should-not calls) + (should (equal (erc-v3--caps-continued erc-v3--caps) + '("test/c" "test/a test/b")))) + + (ert-info ("Printed message includes earlier response") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LIST :test/d") + (should-not calls) + (should-not (erc-v3--caps-continued erc-v3--caps)) + (goto-char (point-min)) + (should (search-forward "Enabled CAPs: test/a, test/b," nil t)) + (should (search-forward "test/c," nil t)) + (should (search-forward "test/d" nil t)))) + + (erc-tests-common-kill-buffers)) + +(defun erc-v3-tests--server-CAP--no-request (test) + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/c)) + (cl-struct-erc-v3--extension-tags '(erc-v3--test/a + erc-v3--test/b + erc-v3--extension + erc-v3--capability))) + (erc-v3-mode +1) + (funcall test (lambda () calls))) + (with-current-buffer (messages-buffer) (should-not erc-v3--caps)) + (should-not (erc-v3--caps-timer erc-v3--caps)) + (erc-tests-common-kill-buffers)) + +;; This test shows that when the wanted and advertised sets don't +;; intersect, but the `negotiated-p' flag is set, ERC does *not* send a +;; "CAP END" even though the queue is empty. +(ert-deftest erc--server-CAP/no-request/post-registration () + (erc-v3-tests--server-CAP--no-request + (lambda (get-calls) + + (cl-letf (((erc-v3--caps-negotiated-p erc-v3--caps) t)) + ;; Although the subcommand is "NEW" here, the same would happen + ;; if it were "LS", though that'd be unlikely in real life. + (erc-tests-common-simulate-line + ":irc.example.org CAP * NEW :test/a test/b") + + ;; Advertised caps are shown as OFFERED. + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) + + ;; Request queue empty because no common extensions. + (should-not (funcall get-calls)))))) + +;; This is similar to the previous test, except the `negotiated-p' slot +;; is nil, meaning initial negotiation during registration is still +;; ongoing. And since the wanted and advertised sets share nothing, ERC +;; sends an early "CAP END" because the queue is empty and the +;; negotiation now effectively over. +(ert-deftest erc--server-CAP/no-request/registration () + (erc-v3-tests--server-CAP--no-request + (lambda (get-calls) + (cl-letf (((erc-v3--caps-negotiated-p erc-v3--caps) nil)) + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b") + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wo-Mo-Pa TRACK) + (test/b Sa-Wo-Mo-Pa TRACK)))) + (should (equal (funcall get-calls) '(("CAP END")))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)))))) + +;; This demos basic 302 capability negotiation, including +;; post-registration. It includes some aberrant server behavior +;; regarding the NEW subcommand. +(ert-deftest erc--server-CAP/pre-and-post-registration () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/b test/d test/e)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b + erc-v3--test/c erc-v3--test/d erc-v3--test/e + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (ert-info ("Handlers inert when continuation line arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS * :test/a test/b") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a nil) (test/b INIT) + (test/c nil) (test/d INIT) (test/e INIT))))) + + (ert-info ("Handlers run when terminating line arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/c test/d") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/b test/d"))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b SEND) (test/c TRACK) + (test/d SEND) (test/e INIT)))) ; never arrives + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("All ACKs for arrive, extensions enabled, END sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/b test/d") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e INIT)))) + ;; Minor modes enabled. + (should erc-v3--test/b) + (should erc-v3--test/d) + (should (equal (pop calls) '("CAP END"))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not calls)) + + ;; XXX a server re-advertising an enabled cap in a NEW, much less + ;; changing its associated value, is unlikely. + (ert-info ("NEW offer arrives after connection registration") + (erc-tests-common-simulate-line + ":irc.example.org CAP * NEW :test/e test/b=3Dfoo") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) (test/d = RUN) + (test/e SEND)))) ; b already enabled + (should (equal (pop calls) '("CAP REQ :test/e"))) + (should-not calls) + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/e") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a TRACK) (test/b RUN) (test/c TRACK) + (test/d RUN) (test/e RUN)))) + (should erc-v3--test/e) + (should-not calls)) + + (ert-info ("DEL arrives indicating cap b no longer supported") + (should erc-v3--test/b) ; test/b extension enabled + (should (equal "foo" (erc-v3--capability-val erc-v3--test/b))) + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/b test/a") ; no longer supported + ;; A and B marked as Su (server unknown). + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Su-Wo-Mo-Pa PASS) (test/b Su-Wi-Mo-Pa PASS) + (test/c Sa-Wo-Mo-Pa TRACK) (test/d Si-Wi-Mi-Pa RUN) + (test/e Si-Wi-Mi-Pa RUN)))) + (should-not calls) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/b))) + + (erc-tests-common-kill-buffers)) + +(cl-defmethod erc-v3--subcmd-LS :before + (o &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/subcmd-handlers))) + (push (intern (format "bef-%s" (erc-v3--extension-canon o))) + erc-v3-tests--calls)) + +(cl-defmethod erc-v3--subcmd-LS + ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/subcmd-handlers))) + (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) + (push 'a erc-v3-tests--calls) + (cl-call-next-method)) + +;; Methods can inhibit a request by altering the `initp' slot. +(cl-defmethod erc-v3--subcmd-LS + ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/subcmd-handlers))) + (should (eq erc-v3--phase-CHECK (erc-v3--extension-phase o))) + (erc-v3--transition o erc-v3--event-wOFF) + (push 'c erc-v3-tests--calls) + (cl-call-next-method)) + +;; This shows that methods for subcommand handlers can influence a +;; request decision during the "check" phase by modifying the table and +;; an LS handler. +(ert-deftest erc--server-CAP/subcmd-handlers () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((erc-v3-tests--calls ()) + (erc-v3-extensions '(test/a test/c)) + (erc-v3--edges (erc-v3-tests--modify-edges + `((,erc-v3--state-Sa-Wi-Mo-Pa + (,erc-v3--event-wOFF + ,erc-v3--state-Sa-Wo-Mo-Pa + ,erc-v3--phase-PASS))))) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b erc-v3--test/c + erc-v3--extension erc-v3--capability)) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r erc-v3-tests--calls)))) + + (erc-v3-mode +1) + + (ert-info ("Handlers deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS * :test/a test/c") + (should-not erc-v3-tests--calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil) (test/c INIT))))) + + (ert-info ("Handlers run and requests sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/b") + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/a Sa-Wi-Mo-Pi SEND) + (test/b Sa-Wo-Mo-Pa TRACK) + (test/c Sa-Wo-Mo-Pa PASS)))) ; manually disabled + ;; The LS handler for test/c effectively negates the configuration + ;; expressed by `erc-v3-extensions'. + (should (equal erc-v3-tests--calls + '(("CAP REQ :test/a") + bef-test/b c bef-test/c a bef-test/a))))) + + (erc-tests-common-kill-buffers)) + + +(cl-defmethod erc-v3--subcmd-ACK + ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/NAK-made-unwanted))) + (cl-call-next-method) + (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) + (should (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) erc-v3-tests--calls)) + +(cl-defmethod erc-v3--subcmd-ACK + ((o erc-v3--test/c) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/NAK-made-unwanted))) + (cl-call-next-method) + (should (eq erc-v3--phase-UP (erc-v3--extension-phase o))) + (should (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) erc-v3-tests--calls)) + +(cl-defmethod erc-v3--subcmd-NAK + ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/NAK-made-unwanted))) + (cl-call-next-method) + (should (eq erc-v3--phase-LOG (erc-v3--extension-phase o))) + (should-not (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) erc-v3-tests--calls)) + +;; This shows that CAP END is sent after a NAK because no unmet +;; dependencies are found that require a further negated REQ. +(ert-deftest erc--server-CAP/NAK-made-unwanted () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-tests--calls ()) + (erc-v3-extensions '(test/a test/b test/c)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b erc-v3--test/c + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b INIT) (test/c INIT)))) + + (ert-info ("LS arrives") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b test/c") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c SEND)))) + (should (equal (pop calls) '("CAP REQ :test/a test/b test/c"))) + (should-not calls)) + + (ert-info ("ACK 1 arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/c") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND) (test/c QIN)))) + ;; Extension not activated because outstanding REQs. + (should-not erc-v3--test/c) + (should-not erc-v3-tests--calls) + (should-not calls)) + + (ert-info ("ACK 2 arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/a") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a QIN) (test/b SEND) (test/c QIN)))) + (should-not erc-v3-tests--calls) + (should-not calls) + (should-not erc-v3--test/c) ; still missing reply for test/b + (should-not erc-v3-tests--calls)) + + (ert-info ("NAK arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * NAK :test/b") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a RUN) (test/b LOG) (test/c RUN)))) + (should erc-v3--test/c) + (should (equal calls '(("CAP END")))) + (should (equal erc-v3-tests--calls '(test/c test/a test/b))))) + + (erc-tests-common-kill-buffers)) + +(cl-defmethod erc-v3--subcmd-ACK + ((o erc-v3--test/a) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/preempted-ACK))) + (cl-call-next-method) + (if (eq erc-v3--phase-UP (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wOFF) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) erc-v3-tests--calls)) + +(cl-defmethod erc-v3--subcmd-LS + ((o erc-v3--test/b) &context ((ert-test-name (ert-running-test)) + (eql erc--server-CAP/preempted-ACK))) + (cl-call-next-method) + (if (eq erc-v3--phase-TRACK (erc-v3--extension-phase o)) + (erc-v3--transition o erc-v3--event-wON) + (should-not (erc-v3--enabled-p o)) + (should-not (erc-v3--wanted-p o))) + (push (erc-v3--extension-canon o) erc-v3-tests--calls)) + +;; This shows that it's possible to "reconsider" an ACK and preempt or +;; overturn mode activation and finalization by forcing another REQ +;; round. For example, an extension could decide some non-IRC +;; requirement is unmet and then safely disable itself instead of +;; activating. But it would also need to try to tell the server to +;; disable the cap to maintain sync. +(ert-deftest erc--server-CAP/preempted-ACK () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3--edges (erc-v3-tests--modify-edges + erc-v3-tests--preempt-up-edges)) + (erc-v3-tests--calls ()) + (erc-v3-extensions '(test/a)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/a erc-v3--test/b + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a INIT) (test/b nil)))) + + (ert-info ("LS arrives, REQ sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/a test/b") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/a test/b"))) + (should (equal erc-v3-tests--calls '(test/b))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b SEND)))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("ACK arrives, handler reconsiders, preempts END") + ;; Some other extension sends REQ -test/a + (should-not erc-v3--test/a) + (should-not erc-v3--test/b) + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/a test/b") + (should (equal (pop calls) '("CAP REQ :-test/a"))) + (should-not calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a SEND) (test/b UP)))) + ;; Other ACKs for this round also deferred until no REQs remain. + (should-not erc-v3--test/a) + (should-not erc-v3--test/b) + (should (equal erc-v3-tests--calls '(test/a test/b))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("Reconsidered round answered") + ;; Simulate a reply instigated by overriding handler. + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :-test/a") + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/a) ; remains disabled + (should erc-v3--test/b) ; activated + ;; Handler called a second time. + (should (equal erc-v3-tests--calls '(test/a test/a test/b))) + (should (equal (pop calls) '("CAP END"))) + (should-not calls)) + + (ert-info ("Cap offer rescinded") + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/a") + (should-not erc-v3--test/a) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/a PASS) (test/b RUN)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not calls))) + + (erc-tests-common-kill-buffers)) + +;; This tests the error handling in `erc-v3--ensure-enabled'. +(ert-deftest erc--server-CAP/mode-activation-failure () + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + (erc-v3--fatal-mode-body-failure-p nil) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/m test/m-1)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/m erc-v3--test/m-1 + erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m INIT) (test/m-1 INIT)))) + + (ert-info ("LS arrives, REQ sent") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS :test/m test/m-1") + (should-not (erc-v3--caps-continued erc-v3--caps)) + (should (equal (pop calls) '("CAP REQ :test/m test/m-1"))) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("ACK arrives, mode activation fails, REQ- sent") + (should-not erc-v3--test/m) + (let ((debug-on-error nil)) ; for Emacs versions < 30 + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :test/m test/m-1")) + (should (equal (pop calls) '("CAP REQ :-test/m -test/m-1"))) + (should-not calls) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m SEND) (test/m-1 SEND)))) + ;; Disabling the mode appears to have worked. + (should-not erc-v3--test/m) + (should-not erc-v3--test/m-1) + (should-not (erc-v3--caps-negotiated-p erc-v3--caps))) + + (ert-info ("Attempt to disable via REQ- granted") + (erc-tests-common-simulate-line + ":irc.example.org CAP * ACK :-test/m -test/m-1") + ;; Error message is inserted when interactive. + (should (equal (erc-v3-tests--slots '(canon phase)) + '((test/m LOG) (test/m-1 LOG)))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should-not erc-v3--test/m) + (should (equal calls '(("CAP END")))))) + + (erc-tests-common-kill-buffers)) + +;; FIXME convert this test to a full scenario because it benefits from +;; interactive inspection and having a real network process. +(ert-deftest erc--server-CAP/mode-deactivation-failure () + (set-buffer (erc-tests-common-make-server-buf "foonet")) + (defvar cl-struct-erc-v3--extension-tags) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions '(test/n)) + (cl-struct-erc-v3--extension-tags + '( erc-v3--test/n erc-v3--extension erc-v3--capability))) + + (erc-v3-mode +1) + + (should (equal (erc-v3-tests--slots '(canon phase)) '((test/n INIT)))) + + (ert-info ("LS arrives, REQ sent, ACK arrives") + (erc-tests-common-simulate-line ":irc.example.org CAP * LS :test/n") + (should (equal (pop calls) '("CAP REQ :test/n"))) + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :test/n") + (should (equal (pop calls) '("CAP END"))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should erc-v3--test/n) + (should-not calls)) + + (ert-info ("DEL arrives indicating cap test/n no longer supported") + (let ((debug-on-error nil)) ; for versions < 30 + (with-silent-modifications + (erc-tests-common-simulate-line + ":irc.example.org CAP * DEL :test/n"))) + (should (equal (erc-v3-tests--slots '(canon state phase)) + '((test/n Su-Wi-Me-Pa LOG)))) + (should-not calls) + (should-not erc-v3--test/b))) + + (when noninteractive (erc-tests-common-kill-buffers))) + +(ert-deftest erc-server-410 () + (let ((erc-insert-modify-hook) + (erc-server-current-nick "tester")) + (erc-tests-common-prep-for-insertion) + (erc-server-410 + nil (make-erc-response :unparsed ":irc.gnu.org 410 * FOO :Invalid" + :sender "irc.gnu.org" + :command "410" + :command-args '("*" "FOO") + :contents "Invalid")) + (goto-char (point-min)) + (should (search-forward "*** Invalid CAP subcommand: FOO" nil t)))) + + +;;;; Extension: multi-prefix + +(ert-deftest erc-v3--multi-prefix-split-flags () + (let ((erc-server-process (start-process "nil" (current-buffer) "true")) + (erc--isupport-params (make-hash-table)) + (erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))) + (set-process-query-on-exit-flag erc-server-process nil) + (should (equal (erc-v3--multi-prefix-split-flags "H~&@%+") + '(?H nil (31 . "qaohv") nil))) + (should (equal (erc-v3--multi-prefix-split-flags "H+") + '(?H nil (1 . "v") nil))) + (should (equal (erc-v3--multi-prefix-split-flags "H*!r") + '(?H t (32 . "Y") (?r)))) + (should (equal (erc-v3--multi-prefix-split-flags "H+Bs") + '(?H nil (1 . "v") (?B ?s)))) + (should (equal (erc-v3--multi-prefix-split-flags "H") + '(?H nil (0 . "") nil))) + (should-not (erc-v3--multi-prefix-split-flags "")))) + +(defun erc-v3-tests--multi-prefix (tags test) + (erc-tests-common-make-server-buf) + (defvar cl-struct-erc-v3--extension-tags) + + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + + (cl-letf* ((calls ()) + ((symbol-function #'erc-server-send) + (lambda (&rest r) (push r calls))) + (erc-v3-extensions ()) + (cl-struct-erc-v3--extension-tags + `( ,@tags erc-v3--extension erc-v3--capability))) + + ;; Boilerplate + (erc-v3-mode +1) + (erc-tests-common-simulate-line ":irc.example.org CAP * LS :multi-pref= ix") + (erc-tests-common-simulate-line ":irc.example.org CAP * ACK :multi-pre= fix") + (should (equal calls '(("CAP END") ("CAP REQ :multi-prefix")))) + (should (erc-v3--caps-negotiated-p erc-v3--caps)) + (should erc-v3--multi-prefix) + + (funcall test)) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-server-352 () ; WHO + (erc-v3-tests--multi-prefix + '(erc-v3--multi-prefix) + + (lambda () + (should (equal '((?Y . ?!) (?q . ?~) (?a . ?&) + (?o . ?@) (?h . ?%) (?v . ?+)) + (erc--parsed-prefix-alist (erc--parsed-prefix)))) + + (with-current-buffer (erc--open-target "#chan") + (erc-update-current-channel-member "hugle" "hugle" t)) + + (erc-tests-common-simulate-line + (concat ":irc.example.org 352 * #chan" + " hugle fsf/person/hugle *.fsf.org hugle H%+ :0 F. S. Hugle"= )) + + (with-current-buffer "#chan" + (let ((actual (erc-get-channel-member "hugle")) + (expect `([erc-server-user "hugle" "fsf/person/hugle" "hugle" + "F. S. Hugle" nil nil + (,(current-buffer))] + . [erc-channel-user 3 nil]))) + (should (equal actual expect))))))) + + +;;;; Extension: userhost-in-names + +(ert-deftest erc-v3--multi-prefix--partition () + (let ((s "+%@&~")) + (should (equal '(31 "~&@%+" "bob") + (erc-v3--multi-prefix--partition "~&@%+bob" s))) + (should (equal '(15 "&@%+" "bob") + (erc-v3--multi-prefix--partition "&@%+bob" s))) + (should (equal '(7 "@%+" "bob") + (erc-v3--multi-prefix--partition "@%+bob" s))) + (should (equal '(3 "%+" "bob") + (erc-v3--multi-prefix--partition "%+bob" s))) + (should (equal '(1 "+" "bob") + (erc-v3--multi-prefix--partition "+bob" s))) + (should (equal '(0 "" "bob") + (erc-v3--multi-prefix--partition "bob" s))) + (should (equal '(1 "+" "") + (erc-v3--multi-prefix--partition "+" s))))) + +(defun erc-v3-tests--channel-receive-names (input result-fn) + (erc-tests-common-make-server-buf) + (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+"))) + (should (equal '((?Y . ?!) (?q . ?~) (?a . ?&) (?o . ?@) (?h . ?%) (?v .= ?+)) + (erc--parsed-prefix-alist (erc--parsed-prefix)))) + (with-current-buffer (erc--open-target "#chan") + (let (erc-channel-members-changed-hook) + ;; Skips lone status-prefix char "+" (from orignial impl.). + (erc-channel-receive-names input) + (erc-channel-end-receiving-names) + (let ((result (funcall result-fn))) + (dolist (actual (sort (map-pairs erc-channel-users) + (lambda (a b) (string< (car a) (car b))))) + (let ((expected (pop result))) + (should (equal (car actual) (car expected))) + (should (equal actual expected)) + (should (equal (gethash (car actual) (erc-with-server-buffer + erc-server-users)) + (cadr expected)))))))) + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-channel-receive-names--baseline () + (erc-v3-tests--channel-receive-names + "@ChanServ +susnight + m hugle znebot agnesi" + ;; host login full-name info account buffers + (lambda () + (let ((rest `(nil nil nil nil nil (,(current-buffer))))) + `(("agnesi" [erc-server-user "agnesi" ,@rest] + . [erc-channel-user 0 nil]) + ("chanserv" [erc-server-user "ChanServ" ,@rest] + . [erc-channel-user 4 nil]) + ("hugle" [erc-server-user "hugle" ,@rest] + . [erc-channel-user 0 nil]) + ("m" [erc-server-user "m" ,@rest] + . [erc-channel-user 0 nil]) + ("susnight" [erc-server-user "susnight" ,@rest] + . [erc-channel-user 1 nil]) + ("znebot" [erc-server-user "znebot" ,@rest] + . [erc-channel-user 0 nil])))))) + +(ert-deftest erc-channel-receive-names--enabled () + (should-not erc-v3--userhost-in-names) + (let ((erc-v3--userhost-in-names (erc-v3--userhost-in-names)) + (erc-v3--353-work (make-erc-v3--353-work)) + ;; full-name info account buffers + (rest `(nil nil nil (,(current-buffer))))) + (lambda () + (erc-v3-tests--channel-receive-names + (concat " @+susnight!~susnight@fsf/member/susnight" + " %+hugle!hugle@fsf/person/hugle" + " +" ; pathological (impossible?) case from orig + " [email protected]" ; ignored: can't index w/o nick + " ride@foo" ; ignored: same as ^ (no nick) + " lovelace!bar" ; interpret "bar" as host + " hamilton!" ; see comment re bouncers in `erc-parse-user' + " franklin@" ; allow, discarding @ + " [email protected]" + " +znebot!~znebot@user/pike/bot/znebot" + " +agnesi") + `(("agnesi" + [erc-server-user "agnesi" nil nil ,@rest] + . [erc-channel-user 1 nil]) + ("franklin" + [erc-server-user "franklin" nil nil ,@rest] + . [erc-channel-user 0 nil]) + ("hamilton" + [erc-server-user "hamilton" nil nil ,@rest] + . [erc-channel-user 0 nil]) + ("hugle" + [erc-server-user "hugle" "fsf/person/hugle" "hugle" ,@rest] + . [erc-channel-user 3 nil]) + ("lovelace" + [erc-server-user "lovelace" "bar" nil ,@rest] + . [erc-channel-user 0 nil]) + ("m" + [erc-server-user "m" "example.org" "~u" ,@rest] + . [erc-channel-user 0 nil]) + ("susnight" + [erc-server-user "susnight" "fsf/member/susnight" "~susnight" ,@= rest] + . [erc-channel-user 5 nil]) + ("znebot" + [erc-server-user "znebot" "user/pike/bot/znebot" "~znebot" ,@res= t] + . [erc-channel-user 1 nil])))))) + + +;;;; Extension WHOX + +;; This also (sort of) touches `erc-v3--whox-enqueue' and also +;; `erc-v3--whox-make-request'. +(ert-deftest erc-v3--whox-delete () + (setq erc-v3--whox (erc-v3--whox)) + (cl-letf* ((calls ()) + ((symbol-function 'erc-server-send) + (lambda (&rest r) (push r calls)))) + (erc-v3--whox-enqueue "#foo" "cuhnflar" #'ignore) + (should (equal calls '(("WHO #foo %tcuhnflar,1" nil "#foo")))) + (should (equal (erc-v3--whox-requests erc-v3--whox) + '(#s(erc-v3--whox-request 1 "#foo" "cuhnflar" ignore)))) + (erc-v3--whox-enqueue "#bar" "cuhnflar" #'ignore) + (should (equal (car (erc-v3--whox-requests erc-v3--whox)) + #s(erc-v3--whox-request 2 "#bar" "cuhnflar" ignore))) + (erc-v3--whox-delete 1) + (should (equal (car (erc-v3--whox-requests erc-v3--whox)) + #s(erc-v3--whox-request 2 "#bar" "cuhnflar" ignore))))) + +;; An earlier version recorded "idle time" as an item in +;; `erc-server-user-info'. If re-adding, use 1580601600, as in +;; +;; $ date --date @1580601600 --utc Sun Feb 2 12:00:00 AM UTC 2020 +;; +(ert-deftest erc-server-354--whox () + (erc-v3-tests--multi-prefix + '(erc-v3--multi-prefix erc-v3--whox) + + (lambda () + ;; Extension only activated once ISUPPORT token arrives after CAP END. + (should-not erc-v3--whox) + (erc-tests-common-simulate-line + ":irc.foonet.org 005 tester PREFIX=3D(qaohv)~&@%+ WHOX=3D390 :suppor= ted") + (should erc-v3--whox) + (should (equal (erc-v3-tests--slots '(canon phase)) + '((multi-prefix RUN) (whox RUN)))) + + ;; Simulate outgoing request for members in #chan. + (push (make-erc-v3--whox-request + :token 1 + :target "#chan" + :fields "cuhnflar" + :handler #'erc-v3--whox-handle-channel-user) + (erc-v3--whox-requests erc-v3--whox)) + (cl-incf (erc-v3--whox-token erc-v3--whox)) + + (with-current-buffer (erc--open-target "#chan") + (erc-v3-mode +1) ; because not added to `erc-modules' + (should erc-v3--whox) + (should erc-v3--multi-prefix) + (erc-update-current-channel-member "hugle" "hugle" t)) + + ;; Simulate a single entry arriving for nick "hugle". + (setq erc-active-buffer (get-buffer "#chan")) ; why? + (erc-tests-common-simulate-line + (concat ":irc.example.org 354 tester 1 #chan" + " ~hugle fsf/person/hugle hugle H@+Br 90 fshugle" + " :F. S. Hugle")) + + ;; Store successfully updated. + (with-current-buffer "#chan" + (let ((actual (gethash "hugle" erc-channel-users))) + (should (equal (car actual) + `[erc-server-user "hugle" "fsf/person/hugle" "~hug= le" + "F. S. Hugle" nil "fshugle" + ,(list (current-buffer))])) + (should (eq (car actual) (erc-get-server-user "hugle"))) + (should (equal (cdr actual) [erc-channel-user 5 nil]))))))) + +;;; erc-v3-tests.el ends here diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/er= c/resources/erc-scenarios-common.el index cb57e14ccd5..e5899ab6209 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -786,6 +786,31 @@ erc-scenarios-common--join-network-id (with-current-buffer chan-buf-bar (funcall expect 10 "hath an uncle here"))))) =20 +;;;; v3 + +;; A temporary stand-in for some future "contextual-hover" feature. +;; See eldoc demo. +(declare-function erc-v3--format-prefix "erc-v3" + (cuser-or-status &optional status)) +(declare-function erc-v3--assemble-server-user-info-string "erc-v3" (user)) + +(defun erc-scenarios-common--nick-at-point (point) + "Echo info as \"<account>: <login>@<host>\" for user at POINT, if any. +Show an asterisk instead of account if user is not logged in." + (interactive (list (point))) + (require 'erc-v3) + (when-let* ((nick (car (get-text-property point 'erc-data))) + (cmem (erc-get-channel-member nick)) + (user (car cmem)) + (account (or (erc-server-user-account user) "*"))) + (message "%s: %s%s" + account + (or (and-let* ((cusr (cdr cmem)) + (s (erc-v3--format-prefix cusr t))) + (concat s " ")) + "") + (erc-v3--assemble-server-user-info-string user)))) + (provide 'erc-scenarios-common) =20 ;;; erc-scenarios-common.el ends here diff --git a/test/lisp/erc/resources/v3/account-notify/chghost-no-account-t= ag.eld b/test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.e= ld new file mode 100644 index 00000000000..3e46b01fad5 --- /dev/null +++ b/test/lisp/erc/resources/v3/account-notify/chghost-no-account-tag.eld @@ -0,0 +1,77 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :Tester") + (0.0 ":irc.foonet.org CAP * LS * :account-notify account-tag away-notify = batch cap-notify chghost draft/channel-rename draft/chathistory draft/event= -playback draft/languages=3D17,en,~bs,~de,~el,~en-AU,~es,~fi,~fr-FR,~it,~nl= ,~no,~pl,~pt-BR,~ro,~sq-AL,~tr-TR,~zh-CN draft/multiline=3Dmax-bytes=3D4096= ,max-lines=3D100 draft/register=3Dbefore-connect draft/relaymsg=3D/ draft/r= esume-0.5 echo-message extended-join invite-notify labeled-response message= -tags multi-prefix oragono.io/nope server-time setname") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names znc.in/playback znc.in/= self-message")) +((cap-req 10 "CAP REQ :account-notify away-notify cap-notify chghost echo-= message extended-join message-tags multi-prefix server-time setname") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify chghost messa= ge-tags multi-prefix account-notify extended-join away-notify server-time e= cho-message")) +((cap-req-2 10 "CAP REQ :userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :setname userhost-in-name= s")) +((cap-end 10 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Sun, 08 Aug 2021 10:34:09 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 3= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 3 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 3 3 :Current local users= 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 3 3 :Current global user= s 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug mode and is logging all user I/O. If you do not wish for everything you= send to be readable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.0 "@time=3D" now " :[email protected] JOIN #chan iamtester T= ester") + (0.0 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@alice!~u@yjg= jjtcq939u8.irc [email protected] [email protected]") + (0.0 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES list= ")) + +((~mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1628418852")) + +((who 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :tester, we= lcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :tester, = welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u yjgjjtcq939u8= .irc alice H@r 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u yjgjjtcq939u8= .irc bob Hr 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 8ch3ur22f9p4q= .irc tester Hr 39 iamtester Tester") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + + (0.0 "@time=3D" now " :[email protected] JOIN #chan * :hacker") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: The= woman falls: sure, he has kill'd his wife.") + (0.0 "@time=3D" now " :[email protected] QUIT :quit: WeeChat 3= .8") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Mad= am, I will, if suddenly I may.") + (0.0 "@time=3D" now " :[email protected] JOIN #chan * :hacker")) + +((privmsg-0 10 "PRIVMSG #chan :checkpoint 0") + (0.0 "@time=3D" now " :[email protected] JOIN #chan * fool")) + +((privmsg-1 10 "PRIVMSG #chan :checkpoint 1") + + (0.0 "@time=3D" now " :[email protected] ACCOUNT :jph") + (0.0 "@time=3D" now " :[email protected] CHGHOST ~jph gnu.org") + + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :hacker, = welcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :Changed my host= ")) + +((privmsg-2 10 "PRIVMSG #chan :checkpoint 2") + (0.0 "@time=3D" now " :[email protected] QUIT :poof") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :fool, we= lcome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :fool, welc= ome!") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Not= hing at this time but my visitation; only, I will promise him an excellent = piece.") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: But= few of any sort, and none of name.") + + (0.0 "@time=3D" now " :[email protected] ACCOUNT fool") + + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :Just logg= ed in") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Tha= n Aquitaine, a dowry for a queen.") + (0.0 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Why= do they run away ? this is a knavery of them to make me afeard.")) diff --git a/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld= b/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld new file mode 100644 index 00000000000..500986a7aef --- /dev/null +++ b/test/lisp/erc/resources/v3/account-notify/no-extended-join.eld @@ -0,0 +1,50 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.00 ":irc.foonet.org CAP * LS * :account-notify account-tag away-notify= batch cap-notify chghost draft/account-registration=3Dbefore-connect draft= /channel-rename draft/chathistory draft/event-playback draft/languages=3D17= ,en,~bs,~de,~el,~en-AU,~es,~fi,~fr-FR,~it,~nl,~no,~pl,~pt-BR,~ro,~sq-AL,~tr= -TR,~zh-CN draft/multiline=3Dmax-bytes=3D4096,max-lines=3D100 draft/persist= ence draft/read-marker draft/relaymsg=3D/ echo-message ergo.chat/nope exten= ded-monitor invite-notify labeled-response message-tags multi-prefix") + (0.00 ":irc.foonet.org CAP * LS :sasl=3DPLAIN,EXTERNAL server-time setnam= e userhost-in-names znc.in/playback znc.in/self-message")) +((cap 10 "CAP REQ :account-notify account-tag away-notify cap-notify chgho= st echo-message extended-monitor message-tags multi-prefix server-time") + (0.00 ":irc.foonet.org CAP * ACK :account-notify account-tag away-notify = cap-notify chghost echo-message extended-monitor message-tags multi-prefix"= )) +((cap 10 "CAP REQ :setname userhost-in-names") + (0.00 "@time=3D" now " :irc.foonet.org CAP * ACK :server-time setname use= rhost-in-names")) +((cap 10 "CAP END") + (0.00 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet = IRC Network tester") + (0.01 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foone= t.org, running version ergo-v2.11.1") + (0.01 "@time=3D" now " :irc.foonet.org 003 tester :This server was create= d Sun, 14 Sep 2025 20:20:42 UTC") + (0.00 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org ergo-v2.= 11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB C= ASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANN= ELLEN=3D64 CHANTYPES=3D# CHATHISTORY=3D25 ELIST=3DU EXCEPTS EXTBAN=3D,m FOR= WARD=3Df INVEX :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester KICKLEN=3D390 MAXLIST= =3DbeI:60 MAXTARGETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 = PREFIX=3D(qaohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:,WHOI= S:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8= ONLY WHOX :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D25 = :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and = 5 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online= ") + (0.00 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connect= ions") + (0.01 "@time=3D" now " :irc.foonet.org 254 tester 2 :channels formed") + (0.00 "@time=3D" now " :irc.foonet.org 255 tester :I have 5 clients and 0= servers") + (0.00 "@time=3D" now " :irc.foonet.org 265 tester 5 5 :Current local user= s 5, max 5") + (0.00 "@time=3D" now " :irc.foonet.org 266 tester 5 5 :Current global use= rs 5, max 5") + (0.01 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing") + (0.00 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.00 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in d= ebug mode and is logging all user I/O. If you do not wish for everything yo= u send to be readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.00 "@time=3D" now " :irc.foonet.org 221 tester +i")) +((join 10 "JOIN #chan") + (0.01 "@time=3D" now ";msgid=3Df2sf9fq52kqw46db2uaasgais2 :tester!~u@ywvg= n2436ga2c.irc JOIN #chan") + (0.01 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :alice!~u@rh2= xhwpq48gfn.irc [email protected] [email protected] @fsbot!= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now ";msgid=3Duxepbgnu2nhq5yde6uffhkgu26;account=3Dalice= :[email protected] PRIVMSG #chan :tester, welcome!") + (0.00 "@time=3D" now ";account=3Dbob;msgid=3Dh9qwf69b98iurmn69kfsi9teha := [email protected] PRIVMSG #chan :tester, welcome!")) +((mode 10 "MODE #chan") + (0.00 "@time=3D" now " :irc.foonet.org 324 tester #chan +Cnt") + (0.00 "@time=3D" now " :irc.foonet.org 329 tester #chan 1757881247")) +((who 10 "WHO #chan %tcuhnflar,1") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc bob Hr 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u ywvgn2436ga2= c.irc tester H 28 0 tester") + (0.00 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u rh2xhwpq48gf= n.irc fsbot H@ 324 0 fsbot") + (0.00 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.05 "@time=3D" now ";account=3Dbob;msgid=3Dx6b5k6dkfugudwgtsw4amsni4e := [email protected] PRIVMSG #chan :Come, Marcus, let us go. Publius, f= ollow me.") + (0.03 "@time=3D" now ";account=3Ddummy;msgid=3Dmt3jnbrqeusir5ne38kimtcvx2= :[email protected] JOIN #chan") + (0.02 "@time=3D" now ";account=3Dalice;msgid=3Dj9tfhq2ecaef7d3gzbutcfwrpi= :[email protected] PRIVMSG #chan :dummy, welcome!") + (0.00 "@time=3D" now ";account=3Dbob;msgid=3Dbdhtn9cqnzzi7n3s4dv2t3fuw6 := [email protected] PRIVMSG #chan :dummy, welcome!")) diff --git a/test/lisp/erc/resources/v3/away-notify/basic.eld b/test/lisp/e= rc/resources/v3/away-notify/basic.eld new file mode 100644 index 00000000000..d7b304c790f --- /dev/null +++ b/test/lisp/erc/resources/v3/away-notify/basic.eld @@ -0,0 +1,63 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) + +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag away-notify batch cap-notif= y echo-message extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNA= L server-time") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names") + ;; SASL handler not triggered + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 903 * :Authentication successful")) +((cap-req 3.2 "CAP REQ :away-notify cap-notify echo-message extended-join = message-tags multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join away-notify server-time echo-m= essage")) + +((cap-end 3.21 "CAP END") + (0.00 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet = IRC Network tester") + (0.02 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foone= t.org, running version oragono-2.6.0-7481bf0385b95b16") + (0.01 "@time=3D" now " :irc.foonet.org 003 tester :This server was create= d Sat, 31 Jul 2021 07:09:01 UTC") + (0.01 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-= 2.6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB C= ASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANN= ELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KI= CKLEN=3D390 :are supported by this server") + (0.01 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTAR= GETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)= ~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10= ,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc82= 65 UTF8ONLY WHOX :are supported by this server") + (0.01 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100= :are supported by this server") + (0.00 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and = 4 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online= ") + (0.00 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connect= ions") + (0.00 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.00 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0= servers") + (0.02 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local user= s 4, max 4") + (0.00 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global use= rs 4, max 4") + (0.00 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug mode and is logging all user I/O. If you do not wish for everything you= send to be readable by the server owner(s), please disconnect.")) + +((join 23.39 "JOIN #chan") + (0.04 "@time=3D" now ";msgid=3Diyjsum9v7ann2chmxbczvu3hss :tester!~u@pevu= fvju5igb4.irc JOIN #chan tester tester") + (0.01 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@bob!~u@wgbc= gvmj77t7q.irc [email protected] [email protected] tester!~= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now ";msgid=3Dceyngmc9ma4sjcu8nugh32pytw :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :tester, welcome!") + (0.00 "@time=3D" now ";msgid=3Dw6d57jstir3mdedecn27vd597a :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :tester, welcome!")) + +((mode 1 "MODE #chan") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627715341") + (0.0 "@time=3D" now ";msgid=3Dpevm3qdtxtvxre8quauqiwd8ge :bob!~u@wgbcgvmj= 77t7q.irc PRIVMSG #chan :alice: Here comes Signior Claudio, led by the prov= ost to prison; and there's Madam Juliet.")) + +((who 1 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u wgbcgvmj77t7q= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u wgbcgvmj77t7q= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u pevufvju5igb4= .irc fool Hr 152 fool fool") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u pevufvju5igb4= .irc tester Hr 30 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + + (0.09 "@time=3D" now ";msgid=3Ddf5s3atpdt39izvtnfg85vwq8a :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: That is, hot ice and wonderous strange sno= w.") + (0.01 "@time=3D" now ";msgid=3Dk2czbnr6ve3ppdnxyz92xcsdq6 :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Inhuman traitors, you constrain'd and forc= 'd.") + (0.05 "@time=3D" now " :[email protected] AWAY afk") + (0.05 "@time=3D" now ";msgid=3D3wcau6b443qwswa4uu5iuwnemw :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: With baleful weeds and precious-juiced flo= wers.") + (0.01 "@time=3D" now ";msgid=3D9c456v6gauijkqpiptem9ds7ie :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: And rape, I fear, was root of thine annoy.= ") + (0.00 "@time=3D" now ";msgid=3Dswf3q7myzk6yvz6fin6k58cqxe :alice!~u@wgbcg= vmj77t7q.irc PRIVMSG #chan :bob: Lies my consent and fair according voice.") + (0.01 "@time=3D" now ";msgid=3Dvzprmznjewv2gm5h5zdqarppjw :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Never came trouble to my house in the like= ness of your Grace, for trouble being gone, comfort should remain; but when= you depart from me, sorrow abides and happiness takes his leave.") + (0.08 "@time=3D" now " :[email protected] AWAY") + (0.01 "@time=3D" now ";msgid=3D45mc34i8d2gk5evy9vcp448vbs :bob!~u@wgbcgvm= j77t7q.irc PRIVMSG #chan :alice: Which the false man does easy. I'll to Eng= land.")) diff --git a/test/lisp/erc/resources/v3/cap-notify/basic.eld b/test/lisp/er= c/resources/v3/cap-notify/basic.eld new file mode 100644 index 00000000000..3ed4cb94bef --- /dev/null +++ b/test/lisp/erc/resources/v3/cap-notify/basic.eld @@ -0,0 +1,66 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK pretester")) +((user 1 "USER user 0 * :pretester") + (0.02 ":irc.znc.in CAP unknown-nick LS :batch cap-notify echo-message mul= ti-prefix server-time userhost-in-names znc.in/batch znc.in/self-message zn= c.in/server-time-iso")) + +((cap-req 3.2 "CAP REQ :cap-notify echo-message multi-prefix server-time u= serhost-in-names") + (0.03 "@time=3D" now " :irc.znc.in CAP pretester ACK :cap-notify multi-pr= efix userhost-in-names server-time echo-message")) + +((~cap-req-a 4 "CAP REQ :account-notify away-notify extended-join") + (0.13 "@time=3D" now " :irc.znc.in CAP tester ACK :away-notify") + (0.02 "@time=3D" now " :irc.znc.in CAP tester ACK :extended-join") + (0.02 "@time=3D" now " :irc.znc.in CAP tester ACK :account-notify")) + +((cap-end 3.2 "CAP END") + ;; ZNC dangles some treats + (0.04 "@time=3D" now " :irc.znc.in CAP tester NEW :account-notify away-no= tify extended-join") + + (0.0 "@time=3D" now " :calcium.libera.chat 001 pretester :Welcome to the = Libera.Chat Internet Relay Chat Network tester") + (0.1 "@time=3D" now " :calcium.libera.chat 002 pretester :Your host is ca= lcium.libera.chat[64.86.243.186/6697], running version solanum-1.0-dev") + (0.0 "@time=3D" now " :calcium.libera.chat 003 pretester :This server was= created Sat Jun 19 2021 at 12:58:41 UTC") + (0.1 "@time=3D" now " :calcium.libera.chat 004 pretester calcium.libera.c= hat solanum-1.0-dev DGQRSZaghilopsuwz CFILMPQSbcefgijklmnopqrstuvz bkloveqj= fI") + (0.0 "@time=3D" now " :calcium.libera.chat 005 pretester ETRACE SAFELIST = ELIST=3DCTU MONITOR=3D100 FNC WHOX KNOCK CHANTYPES=3D# EXCEPTS INVEX CHANMO= DES=3DeIbq,k,flj,CFLMPQScgimnprstuz CHANLIMIT=3D#:250 :are supported by thi= s server") + (0.1 "@time=3D" now " :calcium.libera.chat 005 pretester PREFIX=3D(ov)@+ = MAXLIST=3DbqeI:100 MODES=3D4 NETWORK=3DLibera.Chat STATUSMSG=3D@+ CASEMAPPI= NG=3Drfc1459 NICKLEN=3D16 MAXNICKLEN=3D16 CHANNELLEN=3D50 TOPICLEN=3D390 DE= AF=3DD TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,M= ONITOR: :are supported by this server") + (0.0 "@time=3D" now " :calcium.libera.chat 005 pretester EXTBAN=3D$,ajrxz= CALLERID=3Dg :are supported by this server") + (0.0 "@time=3D" now " :calcium.libera.chat 251 pretester :There are 62 us= ers and 43177 invisible on 27 servers") + (0.0 "@time=3D" now " :calcium.libera.chat 252 pretester 35 :IRC Operator= s online") + (0.0 "@time=3D" now " :calcium.libera.chat 254 pretester 19494 :channels = formed") + (0.0 "@time=3D" now " :calcium.libera.chat 255 pretester :I have 2066 cli= ents and 1 servers") + (0.0 "@time=3D" now " :calcium.libera.chat 265 pretester 2066 2181 :Curre= nt local users 2066, max 2181") + (0.1 "@time=3D" now " :calcium.libera.chat 266 pretester 43239 47407 :Cur= rent global users 43239, max 47407") + (0.0 "@time=3D" now " :calcium.libera.chat 250 pretester :Highest connect= ion count: 2182 (2181 clients) (18443 connections received)") + (0.0 "@time=3D" now " :pretester!pretester@localhost NICK :tester") + (0.0 "@time=3D" now " :calcium.libera.chat 375 tester :- calcium.libera.c= hat Message of the Day - ") + (0.0 "@time=3D" now " :calcium.libera.chat 372 tester :- Welcome to Liber= a Chat, the IRC network for") + (0.0 "@time=3D" now " :calcium.libera.chat 376 tester :End of /MOTD comma= nd.")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :tester!pretester@localhost MODE tester :+Zi") + (0.0 "@time=3D" now " :irc.znc.in 306 tester :You have been marked as bei= ng away") + (0.0 "@time=3D" now " :tester!pretester@localhost JOIN #chan") + (0.0 "@time=3D" now " :calcium.libera.chat 332 tester #chan :ERC: the pow= erful, modular, and extensible IRC client | https://gnu.org/s/emacs/erc | Q= uestions welcome! | See https://gnu.org/server/irc-rules and https://gnu.or= g/p/kind-communication") + (0.0 "@time=3D" now " :calcium.libera.chat 333 tester #chan onaqnyv!~onaq= nyv@tah/onaqnyv 1621566282") + (0.0 "@time=3D" now " :calcium.libera.chat 353 tester =3D #chan :@onaqnyv= !~onaqnyv@tah/onaqnyv pbejva!fbzrbar@sbffubfg/qverpgbe/pbejva crierc!~ERC@u= ser/crierc tester!pretester@localhost") + (0.0 "@time=3D" now " :calcium.libera.chat 366 tester #chan :End of /NAME= S list.") + + (0.0 "@time=3D2021-07-30T12:59:26.172Z :crierc!~ERC@user/crierc PRIVMSG #= chan :~ \2Nzva Onaqnyv\17 ~ Fri, 30 Jul 2021 08:27:26 -0400 ~ https://lists= .gnu.org/archive/html/bug-gnu-emacs/2021-07/msg01639.html =E2=97=8F bug#467= 77: 28.0.50; ERC: NickServ identification: Prompt for password after other = sources, overall simplifications | Hi Ynef, all, Ynef Vatroevtgfra writes: = Apologies for my slow reply and absence. I haven't been well for a few...") + (0.0 "@time=3D2021-07-30T12:59:30.373Z :crierc!~ERC@user/crierc PRIVMSG #= chan :~ \2Ynef Vatroevtgfra\17 ~ Fri, 30 Jul 2021 14:43:46 +0200 ~ https://= lists.gnu.org/archive/html/bug-gnu-emacs/2021-07/msg01645.html =E2=97=8F bu= g#46777: 28.0.50; ERC: NickServ identification: Prompt for password after o= ther sources, overall simplifications | Great! (Well, not great that you h= aven't been feeling well, but that you're better. :-)) -- (domestic p...") + (0.0 "@time=3D2021-07-31T14:48:33.324Z :[email protected]= ragregry.cy PRIVMSG #chan :hi all, what is official # for gnus ?") + (0.0 "@time=3D2021-07-31T14:48:59.060Z :[email protected]= ragregry.cy PRIVMSG #chan :#gnus =C3=96D") + (0.0 "@time=3D2021-07-31T14:49:00.479Z :[email protected]= ragregry.cy PRIVMSG #chan ::D") + (0.0 "@time=3D2021-07-31T16:04:34.182Z :pbejva!fbzrbar@sbffubfg/qverpgbe/= pbejva PRIVMSG #chan ::D (wascally gnubians)")) + +((mode 1.95 "MODE #chan") + (0.0 "@time=3D" now " :calcium.libera.chat 305 tester :You are no longer = marked as being away") + (0.03 "@time=3D" now " :calcium.libera.chat 324 tester #chan +nt") + (0.02 "@time=3D" now " :calcium.libera.chat 329 tester #chan 1621432871")) + +((who 1.36 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan ~ERC user/c= rierc crierc H 0 crierc :0.0.0.0") + (0.1 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan ~onaqnyv ta= h/onaqnyv onaqnyv G 0 onaqnyv :Nzva Onaqnyv") + (0.8 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan pretester l= ocalhost tester H 376784 pretester :Pre Tester") + (0.0 "@time=3D" now " :calcium.libera.chat 354 tester 1 #chan fbzrbar sbf= fubfg/qverpgbe/pbejva pbejva G 0 pbejva :fbzrbar") + (0.0 "@time=3D" now " :calcium.libera.chat 315 tester #chan :End of /WHO = list.") + (0.8 "@time=3D" now " :pbejva!fbzrbar@sbffubfg/qverpgbe/pbejva PRIVMSG #c= han :noice. ty for sharing!")) diff --git a/test/lisp/erc/resources/v3/echo-message/basic.eld b/test/lisp/= erc/resources/v3/echo-message/basic.eld new file mode 100644 index 00000000000..71e59a751b1 --- /dev/null +++ b/test/lisp/erc/resources/v3/echo-message/basic.eld @@ -0,0 +1,74 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK tester")) + +((user 1 "USER user 0 * :tester") + (0.0 ":irc.znc.in CAP unknown-nick LS :batch cap-notify echo-message mult= i-prefix server-time userhost-in-names")) +((cap-req 3.2 "CAP REQ :cap-notify echo-message multi-prefix server-time u= serhost-in-names") + (0.0 "@time=3D" now " :irc.znc.in CAP tester ACK :cap-notify multi-prefix= userhost-in-names server-time echo-message")) + +((cap-end 3.2 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Sat, 24 Jul 2021 08:34:26 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 3= invisible on 1 server(s)") + (0.2 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 3 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 3 3 :Current local users= 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 3 3 :Current global user= s 3, max 3") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 1.2 "MODE tester +i") + ;; unrequited ^ + (0.0 "@time=3D" now " :irc.znc.in 306 tester :You have been marked as bei= ng away") + (0.0 "@time=3D" now " :[email protected] JOIN #chan") + (0.0 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :@alice!~u@ifb= q62z6ccbj8.irc [email protected] [email protected]") + (0.0 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of /NAMES lis= t.") + (0.0 "@time=3D2021-07-24T09:26:19.211Z :[email protected] PRIVMSG = #chan :alice: Plead your deserts in peace and humbleness.") + (0.0 "@time=3D2021-07-24T09:26:21.215Z :[email protected] PRIVMS= G #chan :bob: To the rest, and I 'mongst lords be thought a fool.") + (0.0 "@time=3D2021-07-24T09:26:22.030Z :[email protected] PRIVM= SG #chan :Howdy from the past!") + (0.0 "@time=3D2021-07-24T09:26:24.220Z :[email protected] PRIVMSG = #chan :alice: You are deceived, my lord: this is Monsieur Parolles, the gal= lant militarist,that was his own phrase,that had the whole theorick of war = in the knot of his scarf, and the practice in the chape of his dagger.") + (0.0 "@time=3D2021-07-24T09:26:29.227Z :[email protected] PRIVMS= G #chan :bob: The worst fault you have is to be in love.") + (0.0 "@time=3D" now " :irc.foonet.org 305 tester :You are no longer marke= d as being away")) + +((mode 10 "MODE #chan") + (0.00 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.00 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627115669") + (0.08 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: He= re will I rest me till the break of day.") + (0.07 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Th= at lady is not now living, or this gentleman's opinion by this worn out.")) + +((privmsg-chan 10 "PRIVMSG #chan :hi from the present") + (0.03 "@time=3D" now " :[email protected] PRIVMSG #chan :hi fro= m the present") + (0.10 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Yo= u should have said, sir, before a knave thou'rt a knave; that is, before me= thou'rt a knave: this had been truth, sir.") + (0.00 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: An= d reason says you are the worthier maid.")) + +((privmsg-chan-action 10.5 "PRIVMSG #chan :\1ACTION sad\1") + (0.04 "@time=3D" now " :[email protected] PRIVMSG #chan :\1ACTI= ON sad\1") + (0.10 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: He= re will I rest me till the break of day.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Th= an all yon fiery oes and eyes of light.")) + +((privmsg-bob 10 "PRIVMSG bob :hi") + (0.04 "@time=3D" now " :[email protected] PRIVMSG bob :hi")) + +((monitor-bob 10 "MONITOR + bob") + (0.01 "@time=3D" now " :irc.foonet.org 730 tester bob") + (0.18 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: He= 's very near the truth in this.") + (0.09 "@time=3D" now " :[email protected] PRIVMSG tester :Here liv= es a caitiff wretch would sell it him.") + (0.02 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Pe= ace! you dull fool: I found them on a tree.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Wa= s I, in sooth ? and I was the first that lost thee.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: An= d therefore hath the wind-swift Cupid wings.")) + +((version 10 "PRIVMSG bob :\1VERSION\1") + (0.0 "@time=3D" now " :[email protected] PRIVMSG bob :\1VERSION= \1") + (0.0 "@time=3D" now " :[email protected] NOTICE tester :\1VERSION = \2ERC\2 5.x (IRC client for GNU Emacs) (\2https://www.gnu.org/software/emac= s/erc.html (mailing list: [email protected])\2)\1")) + +((privmsg-bob-action 10 "PRIVMSG bob :\1ACTION tired\1") + (0.01 "@time=3D" now " :[email protected] PRIVMSG bob :\1ACTION= tired\1") + (0.14 "@time=3D" now " :[email protected] PRIVMSG #chan :bob: Wh= en lion rough in wildest rage doth roar.") + (0.01 "@time=3D" now " :[email protected] PRIVMSG #chan :alice: Ha= ! now I see thou art a fool, and fit for thy master.")) diff --git a/test/lisp/erc/resources/v3/extended-join/basic.eld b/test/lisp= /erc/resources/v3/extended-join/basic.eld new file mode 100644 index 00000000000..44072806cda --- /dev/null +++ b/test/lisp/erc/resources/v3/extended-join/basic.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((cap 10 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :J. Random Hacker") + (0.00 ":irc.example.org CAP * LS * :cap-notify extended-join message-tags= multi-prefix") + (0.00 ":irc.example.org CAP * LS :userhost-in-names server-time") + (0.01 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.00 ":irc.example.org 903 * :Authentication successful")) + +((cap 10 "CAP REQ :cap-notify extended-join message-tags multi-prefix user= host-in-names server-time") + (0.0 "@time=3D" now " :irc.example.org CAP * ACK :cap-notify message-tags= multi-prefix userhost-in-names extended-join server-time")) + +((cap 10 "CAP END") + (0.00 "@time=3D" now " :irc.example.org 001 tester :Welcome to the Exampl= eOrg IRC Network tester") + (0.02 "@time=3D" now " :irc.example.org 002 tester :Your host is irc.exam= ple.org, running version oragono-2.6.1-937b9b02368748e5") + (0.01 "@time=3D" now " :irc.example.org 003 tester :This server was creat= ed Tue, 27 Jul 2021 23:47:08 UTC") + (0.01 "@time=3D" now " :irc.example.org 004 tester irc.example.org oragon= o-2.6.1-937b9b02368748e5 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=3D" now " :irc.example.org 005 tester AWAYLEN=3D390 BOT=3DB = CASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHAN= NELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX K= ICKLEN=3D390 :are supported by this server") + (0.01 "@time=3D" now " :irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTA= RGETS=3D4 MODES MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(q= aohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHO= ST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3D= rfc8265 UTF8ONLY :are supported by this server") + (0.01 "@time=3D" now " :irc.example.org 005 tester draft/CHATHISTORY=3D10= 0 :are supported by this server") + (0.00 "@time=3D" now " :irc.example.org 251 tester :There are 0 users and= 2 invisible on 1 server(s)") + (0.00 "@time=3D" now " :irc.example.org 252 tester 0 :IRC Operators onlin= e") + (0.00 "@time=3D" now " :irc.example.org 253 tester 0 :unregistered connec= tions") + (0.00 "@time=3D" now " :irc.example.org 254 tester 0 :channels formed") + (0.00 "@time=3D" now " :irc.example.org 255 tester :I have 2 clients and = 0 servers") + (0.00 "@time=3D" now " :irc.example.org 265 tester 2 2 :Current local use= rs 2, max 2") + (0.00 "@time=3D" now " :irc.example.org 266 tester 2 2 :Current global us= ers 2, max 2") + (0.00 "@time=3D" now " :irc.example.org 375 tester :- irc.example.org Mes= sage of the day - ") + (0.00 "@time=3D" now " :irc.example.org 372 tester :- This is the default= Oragono MOTD.") + (0.00 "@time=3D" now " :irc.example.org 376 tester :End of MOTD command")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.example.org 221 tester +i")) + +((join 10 "JOIN #chan") + ;; This may also be like :[email protected] JOIN #chan * tester + (0.05 "@msgid=3Dhbxvgjgbdpa9tjeyecyjajdma2;time=3D" now " :tester!~u@r7s6= xb547r7hc.irc JOIN #chan tester :J. Random Hacker")) + +((mode 10 "MODE #chan") + (0.02 "@time=3D" now " :irc.example.org 353 tester =3D #chan :@tester!~u@= r7s6xb547r7hc.irc") + (0.00 "@time=3D" now " :irc.example.org 366 tester #chan :End of NAMES li= st") + (0.00 "@time=3D" now " :irc.example.org 324 tester #chan +nt") + (0.00 "@time=3D" now " :irc.example.org 329 tester #chan 1627444487") + (0.06 "@msgid=3Dd8jc73cquhxj78x56zs49drgan;time=3D" now " :alice!~u@r7s6x= b547r7hc.irc JOIN #chan aph :Alyssa P. Hacker") + ;; Server might send account tag even though we never REQ'd + (0.04 "@time=3D" now ";account=3Daph;msgid=3Drgicm5nt9uvqr6nkrub4b6jqp6 := [email protected] PRIVMSG #chan :hi")) + +((privmsg-0 10 "PRIVMSG #chan :checkpoint 0") + (0.05 "@msgid=3Dbfifbrejgjxkysmkkzur3q3pgw;time=3D" now ";account=3Daph := [email protected] PART #chan :" quit)) + +((privmsg-1 10 "PRIVMSG #chan :checkpoint 1") + (0.09 "@msgid=3Djhqvgy9i6nasbtgy5emcewegs2;time=3D" now " :alice!~u@r7s6x= b547r7hc.irc JOIN #chan aph :Alyssa P. Hacker")) + +((privmsg-2 10 "PRIVMSG #chan :checkpoint 2") + (0.05 "@time=3D" now ";account=3Daph;msgid=3Drmzd9sp8djmwrn46e9dnauziqn := [email protected] QUIT :Quit: " quit)) diff --git a/test/lisp/erc/resources/v3/multi-prefix/basic.eld b/test/lisp/= erc/resources/v3/multi-prefix/basic.eld new file mode 100644 index 00000000000..20801111260 --- /dev/null +++ b/test/lisp/erc/resources/v3/multi-prefix/basic.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.0 ":irc.example.org CAP * LS :cap-notify multi-prefix") + (0.16 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify multi-prefix") + (0.0 ":irc.example.org CAP * ACK :cap-notify multi-prefix")) + +;; Note absence of WHOX among ISUPPORT params. +((cap-end 10 "CAP END") + (0.00 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network= tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running= version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Fri, 16 Jul 2= 021 09:14:47 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios= CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.example.org 005 tester AWAYLEN=3D200 BOT=3DB CASEMAPPING=3Das= cii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNELLEN=3D64 CHAN= TYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KICKLEN=3D390 :ar= e supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTARGETS=3D4 MODES = MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(qaohv)~&@%+ STATU= SMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,= TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc8265 UTF8ONLY= :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=3D100 :are supported= by this server") + (0.00 ":irc.example.org 251 tester :There are 1 users and 0 invisible on = 1 server(s)") + (0.00 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.example.org 253 tester 0 :unregistered connections") + (0.00 ":irc.example.org 254 tester 0 :channels formed") + (0.00 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.00 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.00 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.00 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is= logging all user I/O. If you do not wish for everything you send to be rea= dable by the server owner(s), please disconnect.")) + +((join 10 "JOIN #chan") + (0.0 ":tester!~user@localhost JOIN #chan") + (0.29 ":irc.example.org 353 tester =3D #chan :@tester ~@+fsbot alice bob = dummy") + (0.0 ":irc.example.org 366 tester #chan :End of NAMES list")) + +((mode-chan 10 "MODE #chan") + (0.0 ":irc.example.org 324 tester #chan +nt") + (0.01 ":irc.example.org 329 tester #chan 1626426898")) + +((mode-change 10 "MODE #chan +v tester") + (0.00 ":tester!~user@localhost MODE #chan +v tester")) + +((who 10 "WHO #chan") + (0.01 ":irc.example.org 352 tester #chan ~alice 4gf9njv5ccr96.irc irc.foo= net.org alice Hr :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.org 352 tester #chan ~bob 4gf9njv5ccr96.irc irc.foone= t.org bob Hr :0 Irc bot based on irc3 http://irc3.readthedocs.io") + (0.01 ":irc.example.org 352 tester #chan ~user localhost irc.example.org = tester H@+ :0 tester") + (0.01 ":irc.example.org 352 tester #chan ~fsbot 4gf9njv5ccr96.irc irc.foo= net.org fsbot H~@+ :0 fsbot") + (0.01 ":irc.example.org 315 tester #chan :End of WHO list")) diff --git a/test/lisp/erc/resources/v3/sasl/plain-failed.eld b/test/lisp/e= rc/resources/v3/sasl/plain-failed.eld new file mode 100644 index 00000000000..c174596d44f --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain-failed.eld @@ -0,0 +1,18 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + + (0.0 ":irc.foonet.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0.0 ":irc.foonet.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 10 "AUTHENTICATE PLAIN") + (0.0 ":irc.foonet.org AUTHENTICATE +")) + +((authenticate-gimme 10 "AUTHENTICATE AHRlc3RlcgB3cm9uZw=3D=3D") + (0.0 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 904 * :SASL authentication failed: Invalid account = credentials")) diff --git a/test/lisp/erc/resources/v3/sasl/plain-unsupported.eld b/test/l= isp/erc/resources/v3/sasl/plain-unsupported.eld new file mode 100644 index 00000000000..dc5d2e465c2 --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain-unsupported.eld @@ -0,0 +1,7 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.foonet.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.foonet.org NOTICE * :*** Found your hostname")) diff --git a/test/lisp/erc/resources/v3/sasl/plain.eld b/test/lisp/erc/reso= urces/v3/sasl/plain.eld new file mode 100644 index 00000000000..3bd99916855 --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/plain.eld @@ -0,0 +1,39 @@ +;; -*- mode: lisp-data; -*- +((cap-ls 10 "CAP LS 302")) +((nick 10 "NICK tester")) +((user 10 "USER tester@school 0 * :tester") + + (0.0 ":irc.example.org CAP * LS :cap-notify sasl=3DPLAIN,EXTERNAL") + (0.0 ":irc.example.org NOTICE * :*** Looking up your hostname...") + (0.0 ":irc.example.org NOTICE * :*** Found your hostname")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0.0 ":irc.example.org CAP * ACK :cap-notify sasl")) + +((authenticate-plain 10 "AUTHENTICATE PLAIN") + (0.0 ":irc.example.org AUTHENTICATE +")) + +((authenticate-gimme 10 "AUTHENTICATE AHRlc3RlcgBwYXNzd29yZDEyMw=3D=3D") + (0.0 ":irc.example.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.example.org 903 * :Authentication successful")) + +((cap-end 10 "CAP END") + (0.0 ":irc.example.org 001 tester :Welcome to the ExampleOrg IRC Network = tester") + (0.01 ":irc.example.org 002 tester :Your host is irc.example.org, running= version oragono-2.6.1") + (0.01 ":irc.example.org 003 tester :This server was created Sat, 17 Jul 2= 021 09:06:42 UTC") + (0.01 ":irc.example.org 004 tester irc.example.org oragono-2.6.1 BERTZios= CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 ":irc.example.org 005 tester AWAYLEN=3D200 BOT=3DB CASEMAPPING=3Dasc= ii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNELLEN=3D64 CHANT= YPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KICKLEN=3D390 :are= supported by this server") + (0.01 ":irc.example.org 005 tester MAXLIST=3DbeI:60 MAXTARGETS=3D4 MODES = MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN=3D32 PREFIX=3D(qaohv)~&@%+ STATU= SMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,= TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc8265 UTF8ONLY= :are supported by this server") + (0.01 ":irc.example.org 005 tester draft/CHATHISTORY=3D100 :are supported= by this server") + (0.0 ":irc.example.org 251 tester :There are 1 users and 0 invisible on 1= server(s)") + (0.0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0.0 ":irc.example.org 253 tester 0 :unregistered connections") + (0.0 ":irc.example.org 254 tester 0 :channels formed") + (0.0 ":irc.example.org 255 tester :I have 1 clients and 0 servers") + (0.0 ":irc.example.org 265 tester 1 1 :Current local users 1, max 1") + (0.21 ":irc.example.org 266 tester 1 1 :Current global users 1, max 1") + (0.0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 ":irc.example.org 221 tester +Zi") + (0.0 ":irc.example.org NOTICE tester :This server is in debug mode and is= logging all user I/O. If you do not wish for everything you send to be rea= dable by the server owner(s), please disconnect.")) diff --git a/test/lisp/erc/resources/v3/sasl/scram-sha-1.eld b/test/lisp/er= c/resources/v3/sasl/scram-sha-1.eld new file mode 100644 index 00000000000..994163d876c --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/scram-sha-1.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0.0 ":jaguar.test CAP unknown-nick LS :cap-notify sasl=3DSCRAM-SHA-1")) + +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :sasl cap-notify")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-1") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE bixhPWppbGxlcyxuPWppbGxlcyxyPWM1UnFMQ1p5= MEw0ZkdrS0FaMGh1akZCcw=3D=3D") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNYUW9LY2l2cUN3OWlEWlBT= cGIscz01bUpPNmQ0cmpDbnNCVTFYLGk9NDA5Ng=3D=3D")) + +((auth-final 10 "AUTHENTICATE Yz1iaXhoUFdwcGJHeGxjeXc9LHI9YzVScUxDWnkwTDRm= R2tLQVowaHVqRkJzWFFvS2NpdnFDdzlpRFpQU3BiLHA9T1ZVaGdQdTh3RW0yY0RvVkxmYUh6VlV= ZUFdVPQ=3D=3D") + (0 "AUTHENTICATE dj1aV1IyM2M5TUppcjBaZ2ZHZjVqRXRMT242Tmc9")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles [email protected] jilles :You = are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~ji= [email protected]") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version In= spIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020= ") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHI= JLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=3D30 AWAYLEN=3D200 BOT=3DB CALLERID=3D= g CASEMAPPING=3Drfc1459 CHANLIMIT=3D#:120 CHANMODES=3DIXbeg,k,BEFHJLfjl,AMN= OQRSTcimnprstuz CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DCMNTU ESILENCE=3DCcdi= NnPpTtx EXCEPTS=3De :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=3D,ANOQRSTUacmnprz HOSTLEN=3D64 INVEX= =3DI KEYLEN=3D32 KICKLEN=3D255 LINELEN=3D512 MAXLIST=3DI:100,X:100,b:100,e:= 100,g:100 MAXTARGETS=3D20 MODES=3D20 MONITOR=3D30 NAMELEN=3D128 NAMESX NETW= ORK=3Djaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=3D31 PREFIX=3D(Yqaohv)!~&@%+ REMOVE S= AFELIST SECURELIST=3D60 SILENCE=3D32 STATUSMSG=3D!~&@%+ TOPICLEN=3D307 UHNA= MES USERIP USERLEN=3D11 USERMODES=3D,,s,BILRSWcghiorwz WATCH=3D30 :are supp= orted by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 = servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 10 "MODE jilles +i") + (0 ":[email protected] MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/v3/sasl/scram-sha-256.eld b/test/lisp/= erc/resources/v3/sasl/scram-sha-256.eld new file mode 100644 index 00000000000..8049da1de6c --- /dev/null +++ b/test/lisp/erc/resources/v3/sasl/scram-sha-256.eld @@ -0,0 +1,51 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0.0 ":jaguar.test CAP unknown-nick LS :cap-notify sasl")) + +((nick 10 "NICK jilles")) +((user 10 "USER user 0 * :jilles")) + +((cap-req 10 "CAP REQ :cap-notify sasl") + (0 "NOTICE AUTH :*** Processing connection to jaguar.test") + (0 "NOTICE AUTH :*** Looking up your hostname...") + (0 "NOTICE AUTH :*** Checking Ident") + (0 "NOTICE AUTH :*** No Ident response") + (0 "NOTICE AUTH :*** Found your hostname") + (0 ":jaguar.test CAP jilles ACK :cap-notify sasl")) + +((auth-init 10 "AUTHENTICATE SCRAM-SHA-256") + (0 "AUTHENTICATE +")) + +((auth-challenge 10 "AUTHENTICATE biwsbj1qaWxsZXMscj1jNVJxTENaeTBMNGZHa0tB= WjBodWpGQnM=3D") + (0 "AUTHENTICATE cj1jNVJxTENaeTBMNGZHa0tBWjBodWpGQnNkNDA2N2YwYWZkYjU0YzNk= YmQ0ZmU2NDViODRjYWUzNyxzPVpUZzFNbUUxWW1GaFpHSTFORGN5TWprM056WXdabVJqWkRNM1k= ySTFPVE09LGk9NDA5Ng=3D=3D")) + +((auth-final 10 "AUTHENTICATE Yz1iaXdzLHI9YzVScUxDWnkwTDRmR2tLQVowaHVqRkJz= ZDQwNjdmMGFmZGI1NGMzZGJkNGZlNjQ1Yjg0Y2FlMzcscD1MUDRzakpyakpLcDVxVHNBUnlaQ3B= wWHBLTHU0Rk1NMjg0aE5FU1B2R2hJPQ=3D=3D") + (0 "AUTHENTICATE dj04NDdXWGZubVJlR3lFMXFscTFBbmQ2UjRiUEJOUk9UWjdFTVMvUXJK= dFVNPQ=3D=3D")) + +((auth-done 10 "AUTHENTICATE +") + (0 ":jaguar.test 900 jilles [email protected] jilles :You = are now logged in as jilles") + (0 ":jaguar.test 903 jilles :SASL authentication successful")) + +((cap-end 10 "CAP END") + (0 ":jaguar.test 001 jilles :Welcome to the jaguar IRC Network jilles!~ji= [email protected]") + (0 ":jaguar.test 002 jilles :Your host is jaguar.test, running version In= spIRCd-3") + (0 ":jaguar.test 003 jilles :This server was created 09:44:05 Dec 24 2020= ") + (0 ":jaguar.test 004 jilles jaguar.test InspIRCd-3 BILRSWcghiorswz ABEFHI= JLMNOQRSTXYabcefghijklmnopqrstuvz :BEFHIJLXYabefghjkloqv") + (0 ":jaguar.test 005 jilles ACCEPT=3D30 AWAYLEN=3D200 BOT=3DB CALLERID=3D= g CASEMAPPING=3Drfc1459 CHANLIMIT=3D#:120 CHANMODES=3DIXbeg,k,BEFHJLfjl,AMN= OQRSTcimnprstuz CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DCMNTU ESILENCE=3DCcdi= NnPpTtx EXCEPTS=3De :are supported by this server") + (0 ":jaguar.test 005 jilles EXTBAN=3D,ANOQRSTUacmnprz HOSTLEN=3D64 INVEX= =3DI KEYLEN=3D32 KICKLEN=3D255 LINELEN=3D512 MAXLIST=3DI:100,X:100,b:100,e:= 100,g:100 MAXTARGETS=3D20 MODES=3D20 MONITOR=3D30 NAMELEN=3D128 NAMESX NETW= ORK=3Djaguar :are supported by this server") + (0 ":jaguar.test 005 jilles NICKLEN=3D31 PREFIX=3D(Yqaohv)!~&@%+ REMOVE S= AFELIST SECURELIST=3D60 SILENCE=3D32 STATUSMSG=3D!~&@%+ TOPICLEN=3D307 UHNA= MES USERIP USERLEN=3D11 USERMODES=3D,,s,BILRSWcghiorwz WATCH=3D30 :are supp= orted by this server") + (0 ":jaguar.test 005 jilles :are supported by this server") + (0 ":jaguar.test 251 jilles :There are 740 users and 108 invisible on 11 = servers") + (0 ":jaguar.test 252 jilles 10 :operator(s) online") + (0 ":jaguar.test 254 jilles 373 :channels formed") + (0 ":jaguar.test 255 jilles :I have 28 clients and 1 servers") + (0 ":jaguar.test 265 jilles :Current local users: 28 Max: 29") + (0 ":jaguar.test 266 jilles :Current global users: 848 Max: 879") + (0 ":jaguar.test 375 jilles :jaguar.test message of the day") + (0 ":jaguar.test 372 jilles : ~~ some message of the day ~~") + (0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~") + (0 ":jaguar.test 376 jilles :End of message of the day.")) + +((mode-user 10 "MODE jilles +i") + (0 ":[email protected] MODE jilles :+ri") + (0 ":jaguar.test 306 jilles :You have been marked as being away")) diff --git a/test/lisp/erc/resources/v3/server-time/basic.eld b/test/lisp/e= rc/resources/v3/server-time/basic.eld new file mode 100644 index 00000000000..1d95cb850ef --- /dev/null +++ b/test/lisp/erc/resources/v3/server-time/basic.eld @@ -0,0 +1,57 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 9 "CAP LS 302") + (0 ":irc.example.org CAP you LS :cap-notify server-time")) + +((pass 0.2 "PASS :password123")) +((nick 0.2 "NICK tester")) +((user 0.2 "USER user 0 * :tester")) + +((cap-req 5.2 "CAP REQ :cap-notify server-time") + (0 "@time=3D" now " :irc.example.org CAP tester ACK :cap-notify server-ti= me")) + +((cap-end 5.2 "CAP END") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 001 tester :Welcome= ") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 002 tester :Your ho= st is irc.example.org, running version oragono-2.6.1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 003 tester :This se= rver was created Fri, 16 Jul 2021 09:14:47 UTC") + ;; Abnormal trailing param leads to `erc-server-announced-name' + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 004 tester :irc3d 1= .1.6") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester AWAYLEN= =3D200 BOT=3DB CASEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,C= EMRUimnstu CHANNELLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORW= ARD=3Df INVEX KICKLEN=3D390 :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester MAXLIST= =3DbeI:60 MAXTARGETS=3D4 MODES MONITOR=3D100 NETWORK=3DExampleOrg NICKLEN= =3D32 PREFIX=3D(qaohv)~&@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK= :1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D3= 90 UTF8MAPPING=3Drfc8265 UTF8ONLY :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 005 tester draft/CH= ATHISTORY=3D100 :are supported by this server") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 251 tester :There a= re 1 users and 0 invisible on 1 server(s)") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 252 tester 0 :IRC O= perators online") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 253 tester 0 :unreg= istered connections") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 254 tester 0 :chann= els formed") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 255 tester :I have = 1 clients and 0 servers") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 265 tester 1 1 :Cur= rent local users 1, max 1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 266 tester 1 1 :Cur= rent global users 1, max 1") + (0 "@time=3D2024-01-30T03:42:00.179Z :irc.example.org 422 tester :MOTD Fi= le is missing")) + +((mode-user 1.2 "MODE tester +i") + (0 "@time=3D" now " :irc.example.org 221 tester +Zi") + (0 "@time=3D" now " :tester JOIN :#foo") + (0 "@time=3D" now " :irc.example.org 353 tester =3D #foo :tester sneercat= ") + (0 "@time=3D" now " :irc.example.org 366 tester #foo :End of /NAMES list.= ") + (0 "@time=3D" now " :tester JOIN :#bar") + (0 "@time=3D" now " :irc.example.org 353 tester =3D #bar :tester underper= sona") + (0 "@time=3D" now " :irc.example.org 366 tester #bar :End of /NAMES list.= ") + (0 "@time=3D2020-09-23T23:50:00.324Z :[email protected] PRIVMSG = #foo :'Twas brillig, and the slithy toves") + (0 "@time=3D2020-09-23T23:51:40.118Z :[email protected] PRIVMSG = #foo :Did gyre and gimble in the wabe;") + (0 "@time=3D2020-09-24T00:00:00.167Z :[email protected] PRIVMSG #f= oo :All mimsy were the borogoves,") + (0 "@time=3D2020-09-24T00:01:40.350Z :[email protected] PRIVMSG #f= oo :And the mome raths outgrabe.") + (0 "@time=3D2020-09-24T00:05:00.284Z :[email protected] PRIVMSG = #foo :\"Beware the Jabberwock, my son!") + (0 "@time=3D2020-09-24T06:46:40.324Z :[email protected] PRIVMSG = #bar :The jaws that bite, the claws that catch!") + (0 "@time=3D2020-09-24T06:55:00.118Z :[email protected] PRIVMSG #b= ar :Beware the Jubjub bird, and shun") + (0 "@time=3D2020-09-24T06:56:40.167Z :[email protected] PRIVMSG #b= ar :The frumious Bandersnatch!\"") + (0 "@time=3D2020-09-24T07:03:20.350Z :[email protected] PRIVMSG = #bar :He took his vorpal sword in hand:") + (0 "@time=3D2020-09-24T07:03:30.841Z :[email protected] PRIVMSG = #bar :Long time the manxome foe he sought=E2=80=94") + (0 "@time=3D2020-09-24T07:20:20.697Z :[email protected] PRIVMSG #b= ar :So rested he by the Tumtum tree,") + (0 "@time=3D2020-09-24T07:20:30.385Z :[email protected] PRIVMSG #b= ar :And stood awhile in thought.")) + +((~mode-foo 3.68 "MODE #foo") + (0.0 ":irc.example.org 324 tester #foo +nt") + (0.01 ":irc.example.org 329 tester #foo 1626426898")) + +((~mode-bar 3.68 "MODE #bar") + (0.0 ":irc.example.org 324 tester #bar +nt") + (0.01 ":irc.example.org 329 tester #bar 1626426898")) diff --git a/test/lisp/erc/resources/v3/userhost-in-names/basic.eld b/test/= lisp/erc/resources/v3/userhost-in-names/basic.eld new file mode 100644 index 00000000000..3360729b56f --- /dev/null +++ b/test/lisp/erc/resources/v3/userhost-in-names/basic.eld @@ -0,0 +1,49 @@ +;;; -*- mode: lisp-data -*- +((cap-ls 10 "CAP LS 302") + (0 ":irc.example.org CAP you LS :sasl=3Dfoo,plain cap-notify multi-prefix= userhost-in-names")) + +((pass 10 "PASS :password123")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester")) + +((cap-req 10 "CAP REQ :cap-notify multi-prefix userhost-in-names") + (0 ":irc.example.org CAP tester ACK :cap-notify multi-prefix userhost-in-= names")) + +((cap-end 10 "CAP END") + (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network te= ster") + (0 ":irc.example.org 002 tester :Your host is irc.example.org") + (0 ":irc.example.org 003 tester :This server was created just now") + (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv= Iabehkloqv") + (0 ":irc.example.org 005 tester MODES NETWORK=3DExampleOrg NICKLEN=3D32 P= REFIX=3D(qaohv)~&@%+ :are supported by this server") + (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 s= erver(s)") + (0 ":irc.example.org 252 tester 0 :IRC Operators online") + (0 ":irc.example.org 253 tester 0 :unregistered connections") + (0 ":irc.example.org 254 tester 1 :channels formed") + (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers") + (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3") + (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3") + (0 ":irc.example.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0 ":irc.example.org 221 tester +Zi")) + +((join-chan 10 "JOIN #chan") + (0.1 ":tester!~tester@localhost JOIN #chan") + (0.0 ":irc.example.org 353 tester =3D #chan :[email protected] @%= [email protected] tester!~tester@localhost") + (0.0 ":irc.example.org 366 tester #chan :End of NAMES list")) + +((~mode-chan 10 "MODE #chan") + (0 ":irc.foonet.org 324 tester #chan +nt") + (0 ":irc.foonet.org 329 tester #chan 1619593200") + (0 ":[email protected] PRIVMSG #chan :hey")) + +((join-spam 10 "JOIN #spam") + (0.1 ":tester!~tester@localhost JOIN #spam") + (0.0 ":irc.example.org 353 tester =3D #spam :[email protected] TRUST!= ~trus@xsx/dvdovt/nzhjz ecstatic!~ecstatic@196-99-4-98 gallant!gallant@xsx/p= vtson/qzomnjm") + (0.0 ":irc.example.org 353 tester =3D #spam :tester!~tester@localhost REL= AX!~relax@unmxxzqzmhvj/jvvno/ooh/xsooh focused-ne!~focuse@dykosh/qvmjvt/otg= zndpqsY") + (0.0 ":irc.example.org 353 tester =3D #spam :@[email protected] SHA!= [email protected]") + (0.0 ":irc.example.org 366 tester #spam :End of NAMES list")) + +((mode-spam 10 "MODE #spam") + (0 ":irc.foonet.org 324 tester #spam +nt") + (0 ":irc.foonet.org 329 tester #spam 1619593200")) diff --git a/test/lisp/erc/resources/v3/whox/basic.eld b/test/lisp/erc/reso= urces/v3/whox/basic.eld new file mode 100644 index 00000000000..397bb7cccbf --- /dev/null +++ b/test/lisp/erc/resources/v3/whox/basic.eld @@ -0,0 +1,85 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :tester:changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag batch cap-notify echo-messa= ge extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNAL server-tim= e") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names") + ;; Ensure SASL handlers don't fire when we haven't enabled SASL + (0.1 ":irc.foonet.org 900 * * tester :You are now logged in as tester") + (0.0 ":irc.foonet.org 903 * :Authentication successful")) + +((cap-req 3.19 "CAP REQ :cap-notify echo-message extended-join message-tag= s multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join server-time echo-message")) + +((cap-end 3.21 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Fri, 30 Jul 2021 08:19:35 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 4= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local users= 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global user= s 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug mode and is logging all user I/O. If you do not wish for everything you= send to be readable by the server owner(s), please disconnect.")) + +((join-chan 28.07 "JOIN #chan") + (0.02 "@msgid=3Dusc2rfuyc5mvi637awz2s5s58w;time=3D" now ";account=3Dteste= r :[email protected] JOIN #chan tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] @ChanS= erv [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + (0.00 "@time=3D" now " :soju.im 332 tester #chan :Chan - Some channel | i= nstall: www.example.com/install | source: www.example.com/repositories | fr= ee stickers: https://example.com/6uEMkD | help us: www.example.com/todo | m= ailing list: https://lists.example.com/mailman/listinfo") + (0.00 "@time=3D" now " :soju.im 333 tester #chan [email protected]= 1623754902")) + +((join-spam 10 "JOIN #spam") + (0.02 "@msgid=3Dusc2rfuyc5mvi637awz2s5s58w;time=3D" now ";account=3Dteste= r :[email protected] JOIN #spam tester tester") + (0.00 "@time=3D" now " :irc.foonet.org 353 tester =3D #spam :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] fool!~u= @24rqshnawe9w4.irc") + (0.00 "@time=3D" now " :irc.foonet.org 366 tester #spam :End of NAMES lis= t")) + +((mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dz9w6983p4acgcdrr4n4vaxuk4a = :[email protected] PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwgmypkcvxk2yieuuhapgq3n23a :b= [email protected] PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627633175")) + +((mode-spam 10 "MODE #spam") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3Dm9j6983c4nptpqee4a4inkhx4n :j= [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Djtzlcxpikx2lvrhhunctd3a23n := [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #spam +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #spam 1627633175") + + (0.0 "@time=3D" now " :[email protected] NOTICE teste= r :[#chan] Welcome! If you are experiencing problems with getting this to w= ork, and you are using GNU Linux, please see the following link to obtain s= ome useful troubleshooting information: https://example.com/inA0bbQf") + + (0.3 "@time=3D" now ";account=3Dbob;msgid=3Dzt3jsscdawv9am42sjmakh3tsa :b= [email protected] PRIVMSG #chan :alice: For the Lord's tokens on you = do I see.") + (0.3 "@time=3D" now ";account=3Dalice;msgid=3D66ankiwmfdmfpb8ve4npywrrhe = :[email protected] PRIVMSG #chan :bob: Or say, sweet love, what th= ou desir'st to eat.") + (0.2 "@account=3Dbob;msgid=3Ddvipjy2385ngjinb3ti5dp4m8w;time=3D" now " :b= [email protected] PRIVMSG #chan :alice: For I ne'er saw true beauty t= ill this night.") + (0.7 "@msgid=3Dyvrvi7icv4uf2n7eqybd5vm8ye;time=3D" now ";account=3Dalice = :[email protected] PRIVMSG #chan :bob: His leather skin and horns = to wear.") + (0.2 "@time=3D" now ";account=3Dbob;msgid=3Dmjbaj3d96qg62mgs57ninrk6ae :b= [email protected] PRIVMSG #chan :alice: Every letter he hath writ hat= h disvouched other.") + (0.1 "@account=3Dalice;msgid=3Duifkmta383cxfr4m35z9683rww;time=3D" now " = :[email protected] PRIVMSG #chan :bob: The more I have, for both a= re infinite.")) + +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ChanServ service= s.foonet.org ChanServ H@ 0 0 :Channel Services") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc fool H 62 0 fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dpzisncnmb34ty67wfzzrz833ye :b= [email protected] PRIVMSG #chan :alice: With him! why, 'tis not possi= ble.")) + +((who-spam 10 "WHO #spam %tcuhnflar,2") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u u89c2b39vyqt6= .irc mike H@r 0 mike :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u u89c2b39vyqt6= .irc joe Hr 0 joe :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #spam ~u 24rqshnawe9w4= .irc fool H 62 0 fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #spam :End of WHO list") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Dmg3wffpqnji9nz42fwznxu3gfn := [email protected] PRIVMSG #spam :joe: All that he is hath reference= to your highness.") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3D66naxvjzsqzsco8ir4acljeeur :j= [email protected] PRIVMSG #spam :mike: Excellent workman! Thou canst = not paint a man so bad as is thyself.")) diff --git a/test/lisp/erc/resources/v3/whox/rate-limited.eld b/test/lisp/e= rc/resources/v3/whox/rate-limited.eld new file mode 100644 index 00000000000..1994c05b5db --- /dev/null +++ b/test/lisp/erc/resources/v3/whox/rate-limited.eld @@ -0,0 +1,136 @@ +;; -*- mode: lisp-data; -*- +((cap 1 "CAP LS 302")) +((pass 1 "PASS :changeme")) +((nick 1 "NICK tester")) +((user 1 "USER user 0 * :tester") + (0.0 ":irc.foonet.org CAP * LS * :account-tag batch cap-notify echo-messa= ge extended-join message-tags multi-prefix sasl=3DPLAIN,EXTERNAL server-tim= e") + (0.0 ":irc.foonet.org CAP * LS :userhost-in-names")) + +((cap-req 3.19 "CAP REQ :cap-notify echo-message extended-join message-tag= s multi-prefix server-time userhost-in-names") + (0.0 "@time=3D" now " :irc.foonet.org CAP * ACK :cap-notify message-tags = multi-prefix userhost-in-names extended-join server-time echo-message")) + +((cap-end 3.21 "CAP END") + (0.0 "@time=3D" now " :irc.foonet.org 001 tester :Welcome to the foonet I= RC Network tester") + (0.0 "@time=3D" now " :irc.foonet.org 002 tester :Your host is irc.foonet= .org, running version oragono-2.6.0-7481bf0385b95b16") + (0.0 "@time=3D" now " :irc.foonet.org 003 tester :This server was created= Fri, 30 Jul 2021 08:19:35 UTC") + (0.0 "@time=3D" now " :irc.foonet.org 004 tester irc.foonet.org oragono-2= .6.0-7481bf0385b95b16 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester AWAYLEN=3D390 BOT=3DB CA= SEMAPPING=3Dascii CHANLIMIT=3D#:100 CHANMODES=3DIbe,k,fl,CEMRUimnstu CHANNE= LLEN=3D64 CHANTYPES=3D# ELIST=3DU EXCEPTS EXTBAN=3D,m FORWARD=3Df INVEX KIC= KLEN=3D390 :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester MAXLIST=3DbeI:60 MAXTARG= ETS=3D4 MODES MONITOR=3D100 NETWORK=3Dfoonet NICKLEN=3D32 PREFIX=3D(qaohv)~= &@%+ STATUSMSG=3D~&@%+ TARGMAX=3DNAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,= PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=3D390 UTF8MAPPING=3Drfc826= 5 UTF8ONLY WHOX :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 005 tester draft/CHATHISTORY=3D100 = :are supported by this server") + (0.0 "@time=3D" now " :irc.foonet.org 251 tester :There are 0 users and 4= invisible on 1 server(s)") + (0.0 "@time=3D" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.0 "@time=3D" now " :irc.foonet.org 253 tester 0 :unregistered connecti= ons") + (0.0 "@time=3D" now " :irc.foonet.org 254 tester 1 :channels formed") + (0.0 "@time=3D" now " :irc.foonet.org 255 tester :I have 4 clients and 0 = servers") + (0.0 "@time=3D" now " :irc.foonet.org 265 tester 4 4 :Current local users= 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 266 tester 4 4 :Current global user= s 4, max 4") + (0.0 "@time=3D" now " :irc.foonet.org 422 tester :MOTD File is missing")) + +((mode-user 10 "MODE tester +i") + (0.0 "@time=3D" now " :irc.foonet.org 221 tester +i") + (0.0 "@time=3D" now " :irc.foonet.org NOTICE tester :This server is in de= bug mode and is logging all user I/O. If you do not wish for everything you= send to be readable by the server owner(s), please disconnect.")) + +((join-chan 10 "JOIN #chan")) +((join-foo 10 "JOIN #foo")) +((join-bar 10 "JOIN #bar")) +((join-baz 10 "JOIN #baz")) + +((join-spam 10 "JOIN #spam") + (0.02 "@msgid=3Djoin-spam-1;time=3D" now ";account=3Dtester :tester!~u@24= rqshnawe9w4.irc JOIN #chan tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #chan :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] chan_f= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #chan :End of NAMES lis= t") + + (0.02 "@msgid=3Djoin-foo-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #foo tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #foo :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] foo_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #foo :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-bar-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #bar tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #bar :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] bar_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #bar :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-baz-1;time=3D" now ";account=3Dtester :tester!~u@24r= qshnawe9w4.irc JOIN #baz tester tester") + (0.21 "@time=3D" now " :irc.foonet.org 353 tester =3D #baz :tester!~u@24r= qshnawe9w4.irc @[email protected] [email protected] baz_foo= [email protected]") + (0.01 "@time=3D" now " :irc.foonet.org 366 tester #baz :End of NAMES list= ") + + (0.02 "@msgid=3Djoin-spam-1;time=3D" now ";account=3Dtester :tester!~u@24= rqshnawe9w4.irc JOIN #spam tester tester") + (0.00 "@time=3D" now " :irc.foonet.org 353 tester =3D #spam :tester!~u@24= rqshnawe9w4.irc @[email protected] [email protected] spam_fo= [email protected]") + (0.00 "@time=3D" now " :irc.foonet.org 366 tester #spam :End of NAMES lis= t")) + +((~mode-chan 10 "MODE #chan") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-chan-1 :alice!~u@u89c2= b39vyqt6.irc PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-chan-2 :bob!~u@u89c2b39v= yqt6.irc PRIVMSG #chan :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #chan +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #chan 1627633175")) + +((~mode-foo 10 "MODE #foo") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-foo-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #foo :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-foo-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #foo :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #foo +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #foo 1627633175")) + +((~mode-bar 10 "MODE #bar") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-bar-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #bar :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-bar-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #bar :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #bar +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #bar 1627633175")) + +((~mode-baz 10 "MODE #baz") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dmode-baz-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #baz :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dmode-baz-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #baz :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #baz +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #baz 1627633175")) + +((~mode-spam 10 "MODE #spam") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3Dm9j6983c4nptpqee4a4inkhx4n :j= [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Djtzlcxpikx2lvrhhunctd3a23n := [email protected] PRIVMSG #spam :tester, welcome!") + (0.0 "@time=3D" now " :irc.foonet.org 324 tester #spam +nt") + (0.0 "@time=3D" now " :irc.foonet.org 329 tester #spam 1627633175")) + +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u u89c2b39vyqt6= .irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 1 #chan ~u 24rqshnawe9w4= .irc chan_fool H 62 0 :Chan Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwho-chan-1 :bob!~u@u89c2b39vy= qt6.irc PRIVMSG #chan :alice: For the Lord's tokens on you do I see.") + (0.0 "@time=3D" now ";account=3Dalice;msgid=3Dwho-chan-2 :alice!~u@u89c2b= 39vyqt6.irc PRIVMSG #chan :bob: Or say, sweet love, what thou desir'st to e= at.")) + +((who-foo 10 "WHO #foo %tcuhnflar,2") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 2 #foo ~u 24rqshnawe9w4.= irc foo_fool H 62 0 :Foo Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #foo :End of WHO list") + (0.0 "@account=3Dbob;msgid=3Dwho-foo-1;time=3D" now " :bob!~u@u89c2b39vyq= t6.irc PRIVMSG #foo :alice: For I ne'er saw true beauty till this night.") + (0.0 "@msgid=3Dwho-foo-2;time=3D" now ";account=3Dalice :alice!~u@u89c2b3= 9vyqt6.irc PRIVMSG #foo :bob: His leather skin and horns to wear.")) + +((who-bar 10 "WHO #bar %tcuhnflar,3") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 3 #bar ~u 24rqshnawe9w4.= irc bar_fool H 62 0 :Bar Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #bar :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dwho-bar-1 :bob!~u@u89c2b39vyq= t6.irc PRIVMSG #bar :alice: Every letter he hath writ hath disvouched other= .") + (0.0 "@account=3Dalice;msgid=3Dwho-bar-2;time=3D" now " :alice!~u@u89c2b3= 9vyqt6.irc PRIVMSG #bar :bob: The more I have, for both are infinite.")) + +;; Server rejects this request. +((who-baz 10 "WHO #baz %tcuhnflar,4") + (0.0 "@time=3D" now " :irc.foonet.org 263 neverwas WHO :This command coul= d not be completed because it has been used recently, and is rate-limited.") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester * :End of /WHO list")) + +((who-baz-again 20 "WHO #baz %tcuhnflar,4") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u 24rqshnawe9w4.= irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u u89c2b39vyqt6.= irc bob H@r 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u u89c2b39vyqt6.= irc alice Hr 0 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 4 #baz ~u 24rqshnawe9w4.= irc baz_fool H 62 0 :Baz Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #baz :End of WHO list") + (0.0 "@time=3D" now ";account=3Dbob;msgid=3Dpzisncnmb34ty67wfzzrz833ye :b= [email protected] PRIVMSG #baz :alice: With him! why, 'tis not possib= le.")) + +((who-spam 10 "WHO #spam %tcuhnflar,5") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u 24rqshnawe9w4= .irc tester Hr 34 tester tester") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u u89c2b39vyqt6= .irc mike H@r 0 mike :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u u89c2b39vyqt6= .irc joe Hr 0 joe :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.0 "@time=3D" now " :irc.foonet.org 354 tester 5 #spam ~u 24rqshnawe9w4= .irc spam_fool H 62 0 :Spam Fool") + (0.0 "@time=3D" now " :irc.foonet.org 315 tester #spam :End of WHO list") + (0.0 "@time=3D" now ";account=3Dmike;msgid=3Dmg3wffpqnji9nz42fwznxu3gfn := [email protected] PRIVMSG #spam :joe: All that he is hath reference= to your highness.") + (0.0 "@time=3D" now ";account=3Djoe;msgid=3D66naxvjzsqzsco8ir4acljeeur :j= [email protected] PRIVMSG #spam :mike: Excellent workman! Thou canst = not paint a man so bad as is thyself.")) --=20 2.51.0 --=-=-=--