Re: bug#49860: 28.0.50; add IRCv3 building blocks to ERC
"J.P." <[email protected]> Sat, 15 Nov 2025 11:32:55 -0800
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
--=-=-= Content-Type: text/plain v6. [WIP] Add IRCv3 building blocks to ERC [WIP] Make some core ERC functions more flexible [WIP] Add erc--echo msg property for self messages - Convert additional generic functions to locally advised function-valued variables (second patch renamed from "[WIP] Make erc-insert-line overridable") [WIP] Adapt some ERC functions for multiple prefixes - New patch replacing common UI utilities formerly in erc-v3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v5-v6.diff From 7f3eb954c94dcbe3952dedb9120042bc3caa6774 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 15 Nov 2025 00:59:33 -0800 Subject: [PATCH 00/18] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (18): [5.6.2] ; Tweak autojoin display-context test for ERC [5.7] ; Remove some forward declarations from ERC tests [5.7] Prevent some ERC tests from mutating options [5.7] Preserve order of local ERC modules for activation [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] Break up early ERC response processing [WIP] Clearly define erc-server-user info field as an alist [WIP] Add account slot to erc-server-user [WIP] Make updating last-message-time more flexible in ERC [WIP] Make some core ERC functions more flexible [WIP] Adapt some ERC functions for multiple prefixes [WIP] Fix some message display bugs in erc-backend [WIP] Add IRCv3 building blocks to ERC [WIP] Add erc-names module etc/ERC-NEWS | 31 + lisp/erc/erc-backend.el | 274 +- lisp/erc/erc-button.el | 28 +- lisp/erc/erc-common.el | 101 +- lisp/erc/erc-compat.el | 128 + lisp/erc/erc-goodies.el | 16 +- lisp/erc/erc-imenu.el | 8 +- lisp/erc/erc-names.el | 353 +++ lisp/erc/erc-sasl.el | 173 +- lisp/erc/erc-speedbar.el | 35 +- lisp/erc/erc-stamp.el | 15 +- lisp/erc/erc-track.el | 4 +- lisp/erc/erc-truncate.el | 4 +- lisp/erc/erc-v3.el | 2374 +++++++++++++++++ lisp/erc/erc.el | 462 +++- test/lisp/erc/erc-fill-tests.el | 11 +- .../erc/erc-scenarios-join-display-context.el | 43 +- test/lisp/erc/erc-scenarios-log.el | 6 +- test/lisp/erc/erc-scenarios-names.el | 125 + 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 | 200 ++ test/lisp/erc/erc-scenarios-v3.el | 588 ++++ test/lisp/erc/erc-tests.el | 397 ++- test/lisp/erc/erc-v3-tests.el | 1463 ++++++++++ test/lisp/erc/resources/erc-d/erc-d-tests.el | 5 +- .../erc/resources/erc-scenarios-common.el | 119 +- test/lisp/erc/resources/erc-tests-common.el | 25 +- .../join/buffer-display/mode-context.eld | 20 +- .../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 | 67 + .../erc/resources/v3/echo-message/basic.eld | 74 + .../erc/resources/v3/extended-join/basic.eld | 56 + .../erc/resources/v3/multi-prefix/basic.eld | 51 + .../v3/no-implicit-names/reconnect-a.eld | 57 + .../v3/no-implicit-names/reconnect-b.eld | 45 + .../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 | 59 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 47 files changed, 7794 insertions(+), 393 deletions(-) create mode 100644 lisp/erc/erc-names.el create mode 100644 lisp/erc/erc-v3.el create mode 100644 test/lisp/erc/erc-scenarios-names.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/no-implicit-names/reconnect-a.eld create mode 100644 test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.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 a0acd47d1c6..2abfe373b26 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1250,6 +1250,9 @@ erc-send-line (funcall display-fn)) (erc-split-line text))) +(defvar erc--server-send-function #'erc--server-send + "Function to send message, maybe sans queuing, encoded for a target.") + ;; From Circe, with modifications (defun erc-server-send (string &optional force target) "Send STRING to the current server. @@ -1264,9 +1267,9 @@ erc-server-send See `erc-server-flood-margin' for an explanation of the flood protection algorithm." - (erc--server-send string force target)) + (funcall erc--server-send-function string force target)) -(cl-defmethod erc--server-send (string force target) +(defun erc--server-send (string force target) "Encode and send STRING to `erc-server-process'. Expect STRING, FORCE, and TARGET to originate from `erc-server-send'." (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")")) @@ -1446,9 +1449,12 @@ erc-tags-format (const legacy) (const warn))) +(defvar erc--parse-message-tags-function #'erc--parse-message-tags + "Function to convert the tags portion of a message into an alist.") + (defun erc-parse-tags (string) "Parse IRCv3 tags list in STRING to a (tag . value) alist." - (erc--parse-message-tags string)) + (funcall erc--parse-message-tags-function string)) (defun erc--parse-tags (string) (let ((tags) @@ -1488,7 +1494,7 @@ erc--tags-get ;; `legacy' always wins. A downside is that module code must take ;; care to preserve that promise manually. -(cl-defgeneric erc--parse-message-tags (string) +(defun erc--parse-message-tags (string) "Parse STRING into an alist of (TAG . VALUE) conses. Expect TAG to be a symbol and VALUE nil or a nonempty string. Don't split composite raw-input values containing commas; @@ -1530,8 +1536,8 @@ erc--partition-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))))))) + (funcall erc--parse-message-tags-function + (substring full-line 1 end))))))) (defun erc-parse-server-response (process raw-line) "Parse and act upon a RAW-LINE from PROCESS." diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el index e9252b37aac..3153e67cf67 100644 --- a/lisp/erc/erc-v3.el +++ b/lisp/erc/erc-v3.el @@ -410,8 +410,8 @@ erc-v3--caps-by-phase (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)))) + (_ (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) @@ -553,7 +553,7 @@ erc-v3--activate-module-for-target (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)) + (_ (buffer-local-value variable server-buffer)) (mode (get canon 'erc-v3--extension-minor-mode))) (funcall mode +1))))) @@ -580,7 +580,7 @@ erc-v3--activate-module (require (or (get ext 'erc--feature) (intern (concat "erc-" (if-let* ((n (symbol-name ext)) - ((string-prefix-p "draft/" n))) + (_ (string-prefix-p "draft/" n))) (substring n 6) n)))) nil 'no-error)) @@ -623,8 +623,14 @@ v3 (erc--warn-once-before-connect 'erc-v3-mode "Module v3 has changed the format of the `erc-response' slot" " for this session to an alist of (SYMBOL . STRING-OR-NIL)."))) + (add-function :override (local 'erc--parse-message-tags-function) + #'erc-v3--parse-message-tags '((depth . 50))) (add-function :before (local 'erc--register-connection-function) #'erc-v3--register-connection '((depth . 45)))) + (add-function :filter-args (local 'erc--server-send-function) + #'erc-v3--message-tags-server-send '((depth . 50))) + (add-function :override (local 'erc--partition-prefixed-names-function) + #'erc-v3--partition-prefixed-names '((depth . 50))) (erc--add-response-function 005 :after #'erc-v3--server-005) (erc--add-response-function 353 :around #'erc-v3--server-353) (erc--add-response-function 366 :before #'erc-v3--server-366) @@ -651,6 +657,12 @@ v3 (unless 'inhibited (setf (alist-get erc--sui-key-away erc--sui-keys) (delq 'v3 (alist-get erc--sui-key-away erc--sui-keys))) + (remove-function (local 'erc--server-send-function) + #'erc-v3--message-tags-server-send) + (remove-function (local 'erc--parse-message-tags-function) + #'erc-v3--parse-message-tags) + (remove-function (local 'erc--partition-prefixed-names-function) + #'erc-v3--partition-prefixed-names) (remove-function (local 'erc--register-connection-function) #'erc-v3--register-connection) (erc--remove-response-function 005 #'erc-v3--server-005) @@ -1050,7 +1062,7 @@ erc-v3--ensure-disabled (dolist (o (nreverse todo)) (when-let* ((variable (get (erc-v3--extension-canon o) 'erc-v3--extension-class)) - ((symbol-value variable)) + (_ (symbol-value variable)) (mode (get (erc-v3--extension-canon o) 'erc-v3--extension-minor-mode))) (set variable nil) @@ -1310,7 +1322,7 @@ erc-v3--message-tags-add-message-id-text-prop (found (erc--tags-get 'msgid tags))) (puthash 'erc--msgid found erc--msg-props))) -(cl-defmethod erc--parse-message-tags (raw &context (erc-v3-mode (eql t))) +(defun erc-v3--parse-message-tags (raw) "Parse RAW string into an alist of symbol keys and string values. Assume client code interacting with the returned alist will have interned the keys they care about if only by virtue of their inclusion @@ -1362,12 +1374,13 @@ erc-v3--merge-client-tags (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)) +(defun erc-v3--message-tags-server-send (args) + "Return ARGS, maybe prepending formatted client tags to the first." + (cons (if erc-v3--unescaped-client-tags + (concat (erc-v3--merge-client-tags erc-v3--unescaped-client-tags) + (car args)) + (car args)) + (cdr args))) ;;;; Extension: server-time @@ -1385,9 +1398,14 @@ server-time (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-function) - #'erc-v3--current-time-pair '((depth . 40)))) + #'erc-v3--current-time-pair '((depth . 40))) + ;; Depth 60 to favor being deeper/closer to innermost/default + (add-function :around (local 'erc--insert-line-function) + #'erc-v3--server-time-insert-line '((depth . 60)))) (remove-function (local 'erc--current-time-pair-function) #'erc-v3--current-time-pair) + (remove-function (local 'erc--insert-line-function) + #'erc-v3--server-time-insert-line) (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))) @@ -1409,15 +1427,14 @@ 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)) +(defun erc-v3--server-time-insert-line (orig message) + "Call ORIG, arranging to insert a late-arriving MESSAGE 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)) + (_ (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) @@ -1430,11 +1447,11 @@ erc--insert-line erc-v3--server-time-pulse) erc-insert-post-hook))) (erc--with-spliced-insertion pt - (cl-call-next-method))) + (funcall orig message))) (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))) + (funcall orig message))) (defun erc-v3--current-time-pair () "Return a Lisp time from tag if `erc--parsed-response' is non-nil." @@ -1453,7 +1470,7 @@ erc-v3--server-time-on-phantom-users-mode (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)))) + (_ (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)) @@ -1471,12 +1488,16 @@ erc-v3--server-time-update-phantom-cmem (erc-v3--define-capability echo-message (if erc-v3--echo-message (progn + (add-function :override (local 'erc--send-message-external-function) + #'erc-v3--echo-message-send-external '((depth . 50))) (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-message) (add-hook 'erc--input-review-functions #'erc-v3--echo-message-on-pre-send 75 t)) + (remove-function (local 'erc--send-message-external-function) + #'erc-v3--echo-message-send-external) (remove-function (local 'erc--send-action-function) #'erc--send-action-perform-ctcp) (remove-function (local 'erc--send-message-nested-function) @@ -1489,8 +1510,8 @@ erc-v3--echo-message-on-pre-send (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)) +(defun erc-v3--echo-message-send-external (line force) + "Send LINE as \"PRIVMSG\" to `erc-target' sans insertion, possibly FORCE'd." (erc-message "PRIVMSG" (concat (erc-target) " " line) force) t) @@ -2105,13 +2126,12 @@ erc-v3--standard-replies-handle (cl-defmethod erc-v3--standard-replies-handle (type command code rest parsed) "Emit a `standard-replies' catch-all message to server buffer. Determine how to display message from TYPE, COMMAND, CODE, REST, PARSED." - (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 " ")))) + (erc-display-message parsed (pcase type + ('NOTE 'notice) + ('WARN '(notice error)) + ('FAIL '(t notice error))) + (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." @@ -2148,7 +2168,7 @@ erc-cmd-SETNAME "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))) + (_ (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) @@ -2195,11 +2215,11 @@ erc-v3--channel-new-member-names "Temporary hash table containing a subset of `erc-channel-members'. Count is at most `erc-v3-simulated-names-message-size'.") -(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. Only run when ERC-V3-MODE is t." +(defun erc-v3--partition-prefixed-names (name) + "Return a list of (STATUS NICK LOGIN HOST) from NAME. +Act like `erc--partition-prefixed-names' but handle multiple +status-prefix chars before NAME and return LOGIN and HOST as well." + (cl-assert erc-v3-mode) (pcase-let* ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) (`(,status ,_ ,nuh) (erc-v3--multi-prefix--partition name statuses)) @@ -2342,40 +2362,8 @@ erc-v3--format-prefix 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--sui-get user erc--sui-key-away))) - ;; 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))))) + (erc--format-channel-membership-prefix cusr lettersp 'multip))) + (provide 'erc-v3) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d3051206aa2..d8b013e1ab9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3445,7 +3445,7 @@ erc--with-spliced-insertion "In BODY, ensure `erc-insert-line' inserts messages at MARKER-OR-POS. If MARKER-OR-POS is a marker, let it advance normally (and permanently) with each insertion. Allow modules to influence insertion by binding -`erc--insert-line-function' to `erc--insert-line-splice-function' around +`erc--insert-msg-function' to `erc--insert-line-splice-function' around BODY. Note that as of ERC 5.6, this macro cannot handle multiple successive calls to `erc-insert-line' in BODY, such as when replaying a history backlog." @@ -3454,11 +3454,11 @@ erc--with-spliced-insertion `(progn (cl-assert (or (= ,marker-or-pos (point-min)) (= ?\n (char-before ,marker-or-pos)))) - (cl-assert (null erc--insert-line-function)) + (cl-assert (null erc--insert-msg-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) (erc--insert-marker (or ,marker ,marker-or-pos)) - (erc--insert-line-function erc--insert-line-splice-function)) + (erc--insert-msg-function erc--insert-line-splice-function)) (prog1 (progn ,@body) (when ,marker (set-marker ,marker nil))))))) @@ -3499,7 +3499,10 @@ erc--insert-invisible-as-intangible-p that this flag and the behavior it restores may disappear at any time, so if you need them, please let ERC know with \\[erc-bug].") -(defvar erc--insert-line-function nil +(defvar erc--insert-line-function #'erc--insert-line + "Function called with single line to insert into ERC buffer.") + +(defvar erc--insert-msg-function nil "When non-nil, an `insert'-like function for inserting messages. Modules, like `fill-wrap', that leave a marker at the beginning of an inserted message clearly want that marker to advance along with text @@ -3532,9 +3535,9 @@ erc-insert-line (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)))) + (funcall erc--insert-line-function string)))) -(cl-defmethod erc--insert-line (string) +(defun 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 @@ -3567,8 +3570,8 @@ erc--insert-line (save-restriction (widen) (goto-char insert-position) - (if erc--insert-line-function - (funcall erc--insert-line-function string) + (if erc--insert-msg-function + (funcall erc--insert-msg-function string) (insert string)) (erc--assert-input-bounds) ;; run insertion hook, with point at restored location @@ -5148,18 +5151,21 @@ erc--send-message-nested-function insertion and sending operations need a say in this processing as well.") +(defvar erc--send-message-external-function #'erc--send-message-external + "Function to send \"PRIVMSG\" to `erc-default-target', maybe sans queue.") + (defun erc-send-message (line &optional force) "Send LINE to the current channel or user and display it. See also `erc-message' and `erc-display-line'." (if (erc--input-split-p erc--current-line-input-split) (funcall erc--send-message-nested-function line force) - (erc--send-message-external line force))) + (funcall erc--send-message-external-function 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." +(defun erc--send-message-external (line force) + "Send a \"PRIVMSG\" to the default target with optional FORCE, and insert it. +Expect caller to bind `erc-default-recipients' to a temporary, +nonstandard status-prefixed target if necessary." ;; Almost like an echoed message, but without the `erc--cmd'. (let* ((erc-current-message-catalog erc--message-speaker-catalog) (target (erc-default-target)) @@ -6550,6 +6556,11 @@ erc-get-channel-membership-prefix For compatibility reasons, don't error when NICK-OR-CUSR is null, but return nil instead of the empty string. Otherwise, always return a possibly empty string." + (erc--format-channel-membership-prefix nick-or-cusr nil nil)) + +(defun erc--format-channel-membership-prefix (nick-or-cusr + &optional lettersp multip) + "Format multiple status prefixes or membership letters for NICK-OR-CUSR." (when nick-or-cusr (when (stringp nick-or-cusr) (setq nick-or-cusr (and erc-channel-members @@ -6561,29 +6572,31 @@ erc-get-channel-membership-prefix ;; For compatibility, first check whether a parsed prefix exists. ((and-let* ((pfx-obj (erc--parsed-prefix))) (catch 'done - (pcase-dolist (`(,letter . ,pfx) - (erc--parsed-prefix-alist pfx-obj)) - (when (erc--cusr-status-p nick-or-cusr letter) - (throw 'done - (pcase letter - (?q (propertize (string pfx) 'help-echo "owner")) - (?a (propertize (string pfx) 'help-echo "admin")) - (?o (propertize (string pfx) 'help-echo "operator")) - (?h (propertize (string pfx) 'help-echo "half-op")) - (?v (propertize (string pfx) 'help-echo "voice")) - (_ (string pfx)))))) - ""))) + (let ((out ())) + (pcase-dolist + (`(,letter . ,prefix) (erc--parsed-prefix-alist pfx-obj)) + (when (erc--cusr-status-p nick-or-cusr letter) + (let* ((c (if lettersp letter prefix)) + (s (pcase letter + (?q (propertize (string c) 'help-echo "owner")) + (?a (propertize (string c) 'help-echo "admin")) + (?o (propertize (string c) 'help-echo "operator")) + (?h (propertize (string c) 'help-echo "half-op")) + (?v (propertize (string c) 'help-echo "voice")) + (_ (string c))))) + (if multip (push s out) (throw 'done s))))) + (apply #'concat (nreverse out)))))) (t (cond ((erc-channel-user-owner nick-or-cusr) - (propertize "~" 'help-echo "owner")) + (propertize (if lettersp "q" "~") 'help-echo "owner")) ((erc-channel-user-admin nick-or-cusr) - (propertize "&" 'help-echo "admin")) + (propertize (if lettersp "a" "&") 'help-echo "admin")) ((erc-channel-user-op nick-or-cusr) - (propertize "@" 'help-echo "operator")) + (propertize (if lettersp "o" "@") 'help-echo "operator")) ((erc-channel-user-halfop nick-or-cusr) - (propertize "%" 'help-echo "half-op")) + (propertize (if lettersp "h" "%") 'help-echo "half-op")) ((erc-channel-user-voice nick-or-cusr) - (propertize "+" 'help-echo "voice")) + (propertize (if lettersp "v" "+") 'help-echo "voice")) (t "")))))) (defun erc-format-@nick (&optional user channel-data) @@ -7267,7 +7280,10 @@ erc-channel-members-changed-hook :group 'erc-hooks :type 'hook) -(cl-defmethod erc--partition-prefixed-names (name) +(defvar erc--partition-prefixed-names-function #'erc--partition-prefixed-names + "Function to split status-prefixed nick or NUH into parts.") + +(defun erc--partition-prefixed-names (name) "From NAME, return a list of (STATUS NICK LOGIN HOST). Expect NAME to be a prefixed name, like @bob." (unless (string-empty-p name) @@ -7285,7 +7301,7 @@ erc-channel-receive-names (let ((names (delete "" (split-string names-string))) (erc-channel-members-changed-hook nil)) (dolist (name names) - (when-let* ((args (erc--partition-prefixed-names name))) + (when-let* ((args (funcall erc--partition-prefixed-names-function name))) (pcase-let* ((`(,status ,nick ,login ,host) args) (cmem (erc-get-channel-user nick))) (progn @@ -8474,7 +8490,7 @@ erc--run-send-hooks (user-error "Multiline command detected" )) lines-obj) -(cl-defmethod erc--send-input-lines (lines-obj) +(defun 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)) @@ -9215,45 +9231,65 @@ erc-kill-query-buffers (erc-with-all-buffers-of-server process (lambda () erc--target) (kill-buffer (current-buffer))))) -(defun erc-nick-at-point () - "Give information about the nickname at `point'. - -If called interactively, give a human readable message in the -minibuffer. If called programmatically, return the corresponding -entry of `channel-members'." - (interactive) - (require 'thingatpt) - (let* ((word (word-at-point)) - (channel-data (erc-get-channel-user word)) - (cuser (cdr channel-data)) - (user (if channel-data - (car channel-data) - (erc-get-server-user word))) - host login full-name nick voice halfop op admin owner) - (when user - (setq nick (erc-server-user-nickname user) - host (erc-server-user-host user) - login (erc-server-user-login user) - full-name (erc-server-user-full-name user)) - (if cuser - (setq voice (erc-channel-user-voice cuser) - halfop (erc-channel-user-halfop cuser) - op (erc-channel-user-op cuser) - admin (erc-channel-user-admin cuser) - owner (erc-channel-user-owner cuser)))) - (if (called-interactively-p 'interactive) - (message "%s is %s@%s%s%s" - nick login host - (if full-name (format " (%s)" full-name) "") - (if (or voice halfop op admin owner) - (format " and is +%s%s%s%s%s on %s" - (if voice "v" "") - (if halfop "h" "") - (if op "o" "") - (if admin "a" "") - (if owner "q" "") - (erc-default-target)) - "")) +(defvar erc--format-user-parts-multip nil) + +(defun erc--format-user-parts (user cusr faces) + "Return list of informative labels re USER, incorporating CUSR if given. +Include (ACCOUNT STATUS USERHOST FULL-NAME AWAY), preferring null to empty. +Omit intervening spaces, leaving caller to format further as needed." + (mapcar + (lambda (entry) + (let* ((face (pop faces)) + (string (pop entry))) + (cond ((null string) nil) + ((string-empty-p string) nil) + ((null face) (funcall entry string)) + (t (funcall entry (propertize string 'face face)))))) + ;; If CAR is non-nil, apply function CDR to it after adding face. + `((,(erc-server-user-account user) . ,(lambda (s) (concat "a:" s))) + (,(and cusr (erc--format-channel-membership-prefix + cusr 'lettersp erc--format-user-parts-multip)) + . ,(lambda (s) (concat "+" s))) + ;; Some NUHs don't have a userhost or just have one or the other. + ;; For now, ignore those. + (,(and-let* ((login (erc-server-user-login user)) + (host (erc-server-user-host user))) + (concat login "@@AT@@" host)) + . ,(lambda (s) (replace-regexp-in-string "@@AT@@" "@" s))) + (,(erc-server-user-full-name user) . ,(lambda (s) (format "\"%s\"" s))) + (,(erc--sui-get user erc--sui-key-away) + . ,(lambda (s) (format "G:\"%s\"" s)))))) + +(defun erc-nick-at-point (&optional arg) + "Provide information about the nick at `point'. +If called interactively, show an informative message in the echo area. +If called non-interactively and with a non-numeric ARG, return that same +message but don't display it. And, if ARG is itself a string, use it +instead of the word at point to look up the user. Otherwise, if called +non-interactively without an ARG, return the `erc-server-user' if found." + (interactive "p") + (let* ((nick (if (stringp arg) + arg + (or (and (require 'thingatpt) (word-at-point)) + (user-error "No nick at point")))) + (cmem (and nick (erc-channel-p (current-buffer)) + (erc-get-channel-member nick))) + (cusr (cdr cmem)) + (user (if cmem (car cmem) (and nick (erc-get-server-user nick))))) + (if arg + (pcase-let* ((`(,_ ,status ,uh ,full-name ,_) + (erc--format-user-parts user cusr nil)) + (rest (concat + uh + (and uh full-name " ") + (and full-name (format "(%s)" full-name)) + (and (or uh full-name) status " and is ") + (and status + (format "%s on %s" status (erc-target))))) + (out (concat (erc-server-user-nickname user) + (and (not (string-empty-p rest)) " is ") + rest))) + (if (numberp arg) (message "%s" out) out)) user))) (defun erc-away-time () diff --git a/test/lisp/erc/erc-scenarios-join-display-context.el b/test/lisp/erc/erc-scenarios-join-display-context.el index 3e57cd16986..1056d7ed819 100644 --- a/test/lisp/erc/erc-scenarios-join-display-context.el +++ b/test/lisp/erc/erc-scenarios-join-display-context.el @@ -28,6 +28,13 @@ (require 'erc-join) +;; This module uses the list `erc-join--requested-channels' to detect +;; whether a JOIN response was likely triggered by an outgoing JOIN +;; emitted on behalf of `erc-autojoin-channels-alist'. When a related +;; error response, such as a 471, arrives in lieu of a JOIN, the module +;; removes the affected channel's name from the list so that any calls +;; to `display-buffer' in `erc-setup-buffer' on subsequent JOINs aren't +;; misled into thinking the JOIN was module-initiated. (ert-deftest erc-scenarios-join-display-context--errors () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup @@ -35,11 +42,14 @@ erc-scenarios-join-display-context--errors (erc-server-flood-penalty 0.1) (dumb-server (erc-d-run "localhost" t 'mode-context)) (port (process-contact dumb-server :service)) - (erc-buffer-display (lambda (buf action) - (when (equal - (alist-get 'erc-autojoin-mode action) - "#chan") - (pop-to-buffer buf)))) + (calls ()) + (erc-buffer-display + (lambda (buf action) + (when (equal (alist-get 'erc-buffer-display action) 'JOIN) + (when (equal (buffer-name buf) "#chan") + (should (equal (alist-get 'erc-autojoin-mode action) "#chan"))) + (push (cons buf action) calls) + (pop-to-buffer buf)))) (erc-autojoin-channels-alist '((foonet "#chan" "#spam" "#foo"))) (expect (erc-d-t-make-expecter))) @@ -49,20 +59,27 @@ erc-scenarios-join-display-context--errors :nick "tester" :full-name "tester") (should (string= (buffer-name) (format "127.0.0.1:%d" port))) - ;; FIXME test for effect rather than inspecting interval variables. - (erc-d-t-wait-for 10 (equal erc-join--requested-channels - '("#foo" "#spam" "#chan"))) (funcall expect 10 "Max occupancy for channel #spam exceeded") (funcall expect 10 "Channel #foo is invitation only"))) (ert-info ("New #chan buffer displayed in new window") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (eq (window-buffer) (current-buffer))) + (should (equal calls `((,(current-buffer) nil + (erc-buffer-display . JOIN) + (erc-autojoin-mode . "#chan"))))) + (setq calls nil) + (funcall expect 10 "invites you to channel #foo") (funcall expect 10 "#chan was created on"))) - ;; FIXME find a less dishonest way to do this than inspecting - ;; interval variables. - (ert-info ("Ensure channels no longer tracked") - (should-not erc-join--requested-channels)))) + (with-current-buffer "foonet" + ;; Don't simulate an interactive /join because that overrides the + ;; display context. + (erc-cmd-JOIN "#foo")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + ;; `erc-autojoin-mode' is absent from the action alist. + (should (equal calls `((,(current-buffer) nil + (erc-buffer-display . JOIN)))))))) ;;; erc-scenarios-join-display-context.el ends here diff --git a/test/lisp/erc/erc-scenarios-v3-account-notify.el b/test/lisp/erc/erc-scenarios-v3-account-notify.el index 29f53e49266..f41901e0108 100644 --- a/test/lisp/erc/erc-scenarios-v3-account-notify.el +++ b/test/lisp/erc/erc-scenarios-v3-account-notify.el @@ -62,7 +62,7 @@ erc-scenarios-v3-account-notify--account-tag-no-extended-join ;; 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 "*** " + "a:dummy [email protected]")) ; +4 from "*** " (funcall expect 10 "welcome"))))) @@ -108,25 +108,25 @@ erc-scenarios-v3-account-notify--no-account-tag/chghost ;; 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 "*** " + "[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 "*** " + "[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\"")) + "a: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\"")) + "a:fool [email protected] \"fool\"")) (funcall expect 5 "<alice> bob: Why do they run away ?")))) diff --git a/test/lisp/erc/erc-scenarios-v3.el b/test/lisp/erc/erc-scenarios-v3.el index 1d5adef934b..793e259a492 100644 --- a/test/lisp/erc/erc-scenarios-v3.el +++ b/test/lisp/erc/erc-scenarios-v3.el @@ -372,7 +372,7 @@ erc-scenarios-v3-extended-join (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\"")) + "a:aph [email protected] \"Alyssa P. Hacker\"")) (erc-scenarios-common-say "checkpoint 0") ;; Historical intel not available when a user leaves (without @@ -386,7 +386,7 @@ erc-scenarios-v3-extended-join (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\"")) + "a:aph [email protected] \"Alyssa P. Hacker\"")) (erc-scenarios-common-say "checkpoint 2") (funcall expect 5 "alice ([email protected]) has quit") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4060b94a7ea..440c15f0dc3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1441,49 +1441,49 @@ erc--target-from-string #s(erc--target-channel-local "&Bitlbee" &bitlbee nil))))) (ert-deftest erc--modify-local-map () - (when (and (bound-and-true-p erc-irccontrols-mode) - (fboundp 'erc-irccontrols-mode)) - (erc-irccontrols-mode -1)) - (when (and (bound-and-true-p erc-match-mode) - (fboundp 'erc-match-mode)) - (erc-match-mode -1)) - (let* (calls - (inhibit-message noninteractive) - (cmd-foo (lambda () (interactive) (push 'foo calls))) - (cmd-bar (lambda () (interactive) (push 'bar calls)))) - - (ert-info ("Add non-existing") - (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k")) - (should (equal calls '(bar foo)))) - (setq calls nil) - - (ert-info ("Add existing") ; Attempt to swap definitions fails - (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k")) - (should (equal calls '(bar foo)))) - (setq calls nil) - - (ert-info ("Remove existing") - (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (cl-letf (((symbol-function 'undefined) - (lambda () - (push (key-description (this-single-command-keys)) - calls)))) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k"))) - (should (equal calls '("C-c C-k" "C-c C-c")))))) + (erc-tests-common-with-shadowed-options + (let* ((calls ()) + (inhibit-message noninteractive) + (cmd-foo (lambda () (interactive) (push 'foo calls))) + (cmd-bar (lambda () (interactive) (push 'bar calls)))) + + (when (bound-and-true-p erc-irccontrols-mode) + (erc-irccontrols-mode -1)) + (when (bound-and-true-p erc-match-mode) + (erc-match-mode -1)) + + (ert-info ("Add non-existing") + (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Add existing") ; Attempt to swap definitions fails + (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Remove existing") + (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (cl-letf (((symbol-function 'undefined) + (lambda () + (push (key-description (this-single-command-keys)) + calls)))) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k"))) + (should (equal calls '("C-c C-k" "C-c C-c"))))))) (ert-deftest erc-ring-previous-command-base-case () (ert-info ("Create ring when nonexistent and do nothing") @@ -2132,7 +2132,7 @@ erc--insert-before-markers-transplanting-hidden (should (equal '(a b) (get-text-property (1- (point)) 'invisible))) ;; Splice in a new message. - (let ((erc--insert-line-function + (let ((erc--insert-msg-function #'erc--insert-before-markers-transplanting-hidden) (erc--insert-marker (copy-marker (point)))) (goto-char (point-max)) @@ -2821,6 +2821,119 @@ erc-get-channel-membership-prefix (kill-buffer)))) +(ert-deftest erc--format-channel-membership-prefix () + (erc-tests-common-make-server-buf) + (push '("PREFIX" . "(YovV)!@+-") erc-server-parameters) + (should (erc--parsed-prefix)) + + (erc-tests-common-with-shadowed-buffer (erc--open-target "#chan") + + ;; Baseline. + (should-not (erc--format-channel-membership-prefix nil)) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user)))) + + ;; Defaults. + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :owner t)))) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :admin t)))) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :halfop t)))) + + (erc-update-current-channel-member "Bob" nil t nil nil 'on) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob") + #("@" 0 1 (help-echo "operator")))) + + ;; Giving bob voice does not change output sans `multip' flag. + (erc-update-current-channel-member "Bob" nil t 'on) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob") + #("@" 0 1 (help-echo "operator")))) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" nil 'multip) + #("@+" 0 1 (help-echo "operator") 1 2 (help-echo "voice")))) + + ;; With letters. + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp) + #("o" 0 1 (help-echo "operator")))) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("ov" 0 1 (help-echo "operator") 1 2 (help-echo "voice")))) + + ;; With nonstandard chars. + (erc--cusr-change-status "Bob" ?Y 'enablep) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp) + "Y")) ; no traditional label associated + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("Yov" 1 2 (help-echo "operator") 2 3 (help-echo "voice")))) + (erc--cusr-change-status "Bob" ?V 'enablep) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("YovV" 1 2 (help-echo "operator") 2 3 (help-echo "voice"))))) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-nick-at-point () + (erc-tests-common-make-server-buf) + (push '("PREFIX" . "(ov)@+") erc-server-parameters) + + ;; Baseline. + (should (equal (should-error (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point)))) + '(user-error "No nick at point"))) + + ;; In a channel without userhost-in-names. + (let (erc-active-buffer) ; stay in buffer "foonet" + (with-current-buffer (erc--open-target "#chan") + ;; Add a user with no userhost or full-name but +o status. + (erc-tests-common-simulate-line + ":irc.foonet.org 353 tester = #chan :@Bob tester") + (erc-tests-common-simulate-line + ":irc.foonet.org 366 tester #chan :End of NAMES list") + + ;; No valid nick at point required when string supplied. + (should (equal (erc-nick-at-point "Bob") "Bob is +o on #chan")) + + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + ;; Called from Lisp without an arg just returns the user object. + (should (equal (erc-nick-at-point) (erc-get-server-user "Bob"))) + ;; Return string but don't print when arg is or string. + (should (equal (erc-nick-at-point t) "Bob is +o on #chan")) + ;; Interactive call yields same result. + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + "Bob is +o on #chan")))) + + ;; In a server buffer, no userhost or full-name yields a plain nick. + (should (equal (erc-nick-at-point "Bob") "Bob")) + + ;; Add userhost and full-name. + (erc-tests-common-simulate-line + ":irc.foonet.org 311 tester Bob bob 0::1 * :I Am Bob") + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + (goto-char (match-beginning 0)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + ;; The @ here is U@H, not a status prefix. + "Bob is bob@0::1 (\"I Am Bob\")")) + + ;; Other fields incoroporated when present in channel. + (with-current-buffer "#chan" + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + "Bob is bob@0::1 (\"I Am Bob\") and is +o on #chan"))) + + (erc-tests-common-kill-buffers)) + ;; This is an adapter that uses formatting templates from the ;; `-speaker' catalog to mimic `erc-format-privmessage', for testing ;; purposes. @@ -3614,8 +3727,7 @@ erc-handle-irc-url (should-not calls)) (ert-info ("Known network, existing chan with key") - (save-excursion - (with-current-buffer "foonet" (erc--open-target "#chan"))) + (with-current-buffer "foonet" (erc--open-target "#chan")) (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") (should (equal '("#chan" "sec") (pop calls))) (should-not calls)) diff --git a/test/lisp/erc/erc-v3-tests.el b/test/lisp/erc/erc-v3-tests.el index 4f58fa29025..511e4a7cf0f 100644 --- a/test/lisp/erc/erc-v3-tests.el +++ b/test/lisp/erc/erc-v3-tests.el @@ -652,19 +652,21 @@ erc-parse-server-response ;; These cases are already covered by the preceding test. They're ;; presented here in a more minimal form for easier intuiting. -(ert-deftest erc--parse-message-tags () - (let ((erc-v3-mode t) - (erc-tags-format nil)) - (should (equal nil (erc--parse-message-tags ""))) - (should (equal '((a)) (erc--parse-message-tags "a"))) - - (should (equal '((a . "1") (b) (c)) (erc--parse-message-tags "a=1;b;c"))) - (should (equal '((a) (b . "1") (c)) (erc--parse-message-tags "a;b=1;c"))) - (should (equal '((a) (b) (c . "1")) (erc--parse-message-tags "a;b;c=1"))) - - (should (equal '((a . "1")) (erc--parse-message-tags "a;a=1"))) - (should (equal '((a . "2")) (erc--parse-message-tags "a=1;a=2"))) - (should (equal '((a)) (erc--parse-message-tags "a=1;a"))))) +(ert-deftest erc-v3--parse-message-tags () + (let ((erc-tags-format nil)) + (should (equal nil (erc-v3--parse-message-tags ""))) + (should (equal '((a)) (erc-v3--parse-message-tags "a"))) + + (should (equal '((a . "1") (b) (c)) + (erc-v3--parse-message-tags "a=1;b;c"))) + (should (equal '((a) (b . "1") (c)) + (erc-v3--parse-message-tags "a;b=1;c"))) + (should (equal '((a) (b) (c . "1")) + (erc-v3--parse-message-tags "a;b;c=1"))) + + (should (equal '((a . "1")) (erc-v3--parse-message-tags "a;a=1"))) + (should (equal '((a . "2")) (erc-v3--parse-message-tags "a=1;a=2"))) + (should (equal '((a)) (erc-v3--parse-message-tags "a=1;a"))))) (cl-defun erc-v3-tests--build-message (&key tags source verb params) "Build an outgoing message string from parts." diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index bd17a3611a9..3d3356c4695 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -790,27 +790,15 @@ erc-scenarios-common--join-network-id ;;;; 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." + "Echo \"a:<account> <login>@<host> <quoted-full-name>\" for nick at POINT." (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)))) + (cmem (erc-get-channel-member nick))) + (message "%s" + (string-join (delete nil (erc--format-user-parts (car cmem) + (cdr cmem) nil)) + " ")))) (provide 'erc-scenarios-common) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 7b1bdb86580..7d5823debe1 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -53,6 +53,29 @@ erc-tests-common-equal-with-props 'equal-including-properties) a b)) +(defmacro erc-tests-common-with-shadowed-options (&rest body) + "Run BODY with options modified by module setup code shadowed by copies." + `(let ((erc-modules (copy-sequence erc-modules)) + (erc-mode-map (copy-sequence erc-mode-map)) + (erc-mode-hook (copy-sequence erc-mode-hook)) + (erc-insert-pre-hook (copy-sequence erc-insert-pre-hook)) + (erc-insert-modify-hook (copy-sequence erc-insert-modify-hook)) + (erc-insert-post-hook (copy-sequence erc-insert-post-hook)) + (erc-insert-done-hook (copy-sequence erc-insert-done-hook)) + (erc-pre-send-functions (copy-sequence erc-pre-send-functions)) + (erc-send-modify-hook (copy-sequence erc-send-modify-hook)) + (erc-send-post-hook (copy-sequence erc-send-post-hook)) + (erc-send-completed-hook (copy-sequence erc-send-completed-hook))) + ,@body)) + +(defmacro erc-tests-common-with-shadowed-buffer (buffer &rest body) + "Run BODY in BUFFER, shadowing module-setup options." + (declare (indent 1)) + ;; Protect default values from BUFFER form, like `erc--open-target'. + `(erc-tests-common-with-shadowed-options + (with-current-buffer ,buffer + ,@body))) + ;; Caller should probably shadow `erc-insert-modify-hook' or populate ;; user tables for erc-button. ;; FIXME explain this comment ^ in more detail or delete. diff --git a/test/lisp/erc/resources/join/buffer-display/mode-context.eld b/test/lisp/erc/resources/join/buffer-display/mode-context.eld index 6ebbdc7e824..9c5e335c7b8 100644 --- a/test/lisp/erc/resources/join/buffer-display/mode-context.eld +++ b/test/lisp/erc/resources/join/buffer-display/mode-context.eld @@ -23,7 +23,9 @@ (0.02 ":irc.foonet.org 221 tester +i")) ((join-chan 10 "JOIN #chan") - (0.03 ":[email protected] JOIN #chan")) + (0.03 ":[email protected] JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester") + (0.03 ":irc.foonet.org 366 tester #chan :End of NAMES list")) ((~mode-chan 10 "MODE #chan") (0.01 ":irc.foonet.org 353 tester = #chan :@tester") @@ -31,8 +33,18 @@ (0.01 ":irc.foonet.org 324 tester #chan +nt") (0.03 ":irc.foonet.org 329 tester #chan 1653370308")) -((~join-spam 10 "JOIN #spam") +((join-spam 10 "JOIN #spam") (0.03 ":irc.foonet.org 471 tester #spam :Cannot join channel (+l)")) -((~join-foo 10 "JOIN #foo") - (0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)")) +((join-foo 10 "JOIN #foo") + (0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)") + (0.01 ":[email protected] INVITE tester #foo")) + +((join-chan 10 "JOIN #foo") + (0.03 ":[email protected] JOIN #foo")) + +((mode-foo 10 "MODE #foo") + (0.01 ":irc.foonet.org 353 tester = #foo :@tester") + (0.00 ":irc.foonet.org 366 tester #foo :End of NAMES list") + (0.01 ":irc.foonet.org 324 tester #foo +nt") + (0.03 ":irc.foonet.org 329 tester #foo 1653370308")) -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6.2-Tweak-autojoin-display-context-test-for-ERC.patch From bb9ccca9ef9c29919f9bff0601cb4938f88ac0ed Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 8 Nov 2025 16:19:19 -0800 Subject: [PATCH 01/18] [5.6.2] ; Tweak autojoin display-context test for ERC * test/lisp/erc/erc-scenarios-join-display-context.el (erc-scenarios-join-display-context--errors): Instead of asserting the membership of `erc-join--requested-channels', have the client attempt to manually join an autojoined channel previously denied by an error response. But this time assert that the display context for the now successfully joined channel doesn't indicate it originated from the autojoin module. * test/lisp/erc/resources/join/buffer-display/mode-context.eld: Update accordingly. --- .../erc/erc-scenarios-join-display-context.el | 41 +++++++++++++------ .../join/buffer-display/mode-context.eld | 20 +++++++-- 2 files changed, 45 insertions(+), 16 deletions(-) diff --git a/test/lisp/erc/erc-scenarios-join-display-context.el b/test/lisp/erc/erc-scenarios-join-display-context.el index 0e1bb2b081d..d35c32c8ada 100644 --- a/test/lisp/erc/erc-scenarios-join-display-context.el +++ b/test/lisp/erc/erc-scenarios-join-display-context.el @@ -26,6 +26,13 @@ (let ((load-path (cons (ert-resource-directory) load-path))) (require 'erc-scenarios-common))) +;; This module uses the list `erc-join--requested-channels' to detect +;; whether a JOIN response was likely triggered by an outgoing JOIN +;; emitted on behalf of `erc-autojoin-channels-alist'. When a related +;; error response, such as a 471, arrives in lieu of a JOIN, the module +;; removes the affected channel's name from the list so that any calls +;; to `display-buffer' in `erc-setup-buffer' on subsequent JOINs aren't +;; misled into thinking the JOIN was module-initiated. (ert-deftest erc-scenarios-join-display-context--errors () :tags '(:expensive-test) (erc-scenarios-common-with-cleanup @@ -33,11 +40,14 @@ erc-scenarios-join-display-context--errors (erc-server-flood-penalty 0.1) (dumb-server (erc-d-run "localhost" t 'mode-context)) (port (process-contact dumb-server :service)) - (erc-buffer-display (lambda (buf action) - (when (equal - (alist-get 'erc-autojoin-mode action) - "#chan") - (pop-to-buffer buf)))) + (calls ()) + (erc-buffer-display + (lambda (buf action) + (when (equal (alist-get 'erc-buffer-display action) 'JOIN) + (when (equal (buffer-name buf) "#chan") + (should (equal (alist-get 'erc-autojoin-mode action) "#chan"))) + (push (cons buf action) calls) + (pop-to-buffer buf)))) (erc-autojoin-channels-alist '((foonet "#chan" "#spam" "#foo"))) (expect (erc-d-t-make-expecter))) @@ -47,20 +57,27 @@ erc-scenarios-join-display-context--errors :nick "tester" :full-name "tester") (should (string= (buffer-name) (format "127.0.0.1:%d" port))) - ;; FIXME test for effect rather than inspecting interval variables. - (erc-d-t-wait-for 10 (equal erc-join--requested-channels - '("#foo" "#spam" "#chan"))) (funcall expect 10 "Max occupancy for channel #spam exceeded") (funcall expect 10 "Channel #foo is invitation only"))) (ert-info ("New #chan buffer displayed in new window") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (should (eq (window-buffer) (current-buffer))) + (should (equal calls `((,(current-buffer) nil + (erc-buffer-display . JOIN) + (erc-autojoin-mode . "#chan"))))) + (setq calls nil) + (funcall expect 10 "invites you to channel #foo") (funcall expect 10 "#chan was created on"))) - ;; FIXME find a less dishonest way to do this than inspecting - ;; interval variables. - (ert-info ("Ensure channels no longer tracked") - (should-not erc-join--requested-channels)))) + (with-current-buffer "foonet" + ;; Don't simulate an interactive /join because that overrides the + ;; display context. + (erc-cmd-JOIN "#foo")) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#foo")) + ;; `erc-autojoin-mode' is absent from the action alist. + (should (equal calls `((,(current-buffer) nil + (erc-buffer-display . JOIN)))))))) ;;; erc-scenarios-join-display-context.el ends here diff --git a/test/lisp/erc/resources/join/buffer-display/mode-context.eld b/test/lisp/erc/resources/join/buffer-display/mode-context.eld index 6ebbdc7e824..9c5e335c7b8 100644 --- a/test/lisp/erc/resources/join/buffer-display/mode-context.eld +++ b/test/lisp/erc/resources/join/buffer-display/mode-context.eld @@ -23,7 +23,9 @@ (0.02 ":irc.foonet.org 221 tester +i")) ((join-chan 10 "JOIN #chan") - (0.03 ":[email protected] JOIN #chan")) + (0.03 ":[email protected] JOIN #chan") + (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester") + (0.03 ":irc.foonet.org 366 tester #chan :End of NAMES list")) ((~mode-chan 10 "MODE #chan") (0.01 ":irc.foonet.org 353 tester = #chan :@tester") @@ -31,8 +33,18 @@ (0.01 ":irc.foonet.org 324 tester #chan +nt") (0.03 ":irc.foonet.org 329 tester #chan 1653370308")) -((~join-spam 10 "JOIN #spam") +((join-spam 10 "JOIN #spam") (0.03 ":irc.foonet.org 471 tester #spam :Cannot join channel (+l)")) -((~join-foo 10 "JOIN #foo") - (0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)")) +((join-foo 10 "JOIN #foo") + (0.03 ":irc.foonet.org 473 tester #foo :Cannot join channel (+i)") + (0.01 ":[email protected] INVITE tester #foo")) + +((join-chan 10 "JOIN #foo") + (0.03 ":[email protected] JOIN #foo")) + +((mode-foo 10 "MODE #foo") + (0.01 ":irc.foonet.org 353 tester = #foo :@tester") + (0.00 ":irc.foonet.org 366 tester #foo :End of NAMES list") + (0.01 ":irc.foonet.org 324 tester #foo +nt") + (0.03 ":irc.foonet.org 329 tester #foo 1653370308")) -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-5.7-Remove-some-forward-declarations-from-ERC-tests.patch From 9eddf6e46ba3096b4faf2559c8bee1e862511703 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 16 Sep 2025 18:43:58 -0700 Subject: [PATCH 02/18] [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 271c5d5fcf8..25d3ac59af1 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3741,7 +3741,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 d35c32c8ada..1056d7ed819 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) + ;; This module uses the list `erc-join--requested-channels' to detect ;; whether a JOIN response was likely triggered by an outgoing JOIN ;; emitted on behalf of `erc-autojoin-channels-alist'. When a related 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 6cb132b192e..9ad7e14b9d0 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 7ad2d268fa3..06189f01a61 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3697,12 +3697,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.7-Prevent-some-ERC-tests-from-mutating-options.patch From a497a1feb36adf7a7f2ccdd0e447dc4ee6544c91 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 16 Sep 2025 18:43:58 -0700 Subject: [PATCH 03/18] [5.7] Prevent some ERC tests from mutating options ;; * test/lisp/erc/erc-tests.el (erc--modify-local-map): Guard default ;; value of module-setup code. ;; (erc-handle-irc-url): Remove redundant `save-excursion'. * test/lisp/erc/resources/erc-tests-common.el (erc-tests-common-with-shadowed-options) (erc-tests-common-with-shadowed-buffer): New macros to protect options from module-setup code that modifies insertion hooks and `erc-modules'. --- test/lisp/erc/erc-tests.el | 89 ++++++++++----------- test/lisp/erc/resources/erc-tests-common.el | 23 ++++++ 2 files changed, 67 insertions(+), 45 deletions(-) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 06189f01a61..388b8e58aef 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1441,49 +1441,49 @@ erc--target-from-string #s(erc--target-channel-local "&Bitlbee" &bitlbee nil))))) (ert-deftest erc--modify-local-map () - (when (and (bound-and-true-p erc-irccontrols-mode) - (fboundp 'erc-irccontrols-mode)) - (erc-irccontrols-mode -1)) - (when (and (bound-and-true-p erc-match-mode) - (fboundp 'erc-match-mode)) - (erc-match-mode -1)) - (let* (calls - (inhibit-message noninteractive) - (cmd-foo (lambda () (interactive) (push 'foo calls))) - (cmd-bar (lambda () (interactive) (push 'bar calls)))) - - (ert-info ("Add non-existing") - (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k")) - (should (equal calls '(bar foo)))) - (setq calls nil) - - (ert-info ("Add existing") ; Attempt to swap definitions fails - (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k")) - (should (equal calls '(bar foo)))) - (setq calls nil) - - (ert-info ("Remove existing") - (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) - (with-temp-buffer - (set-window-buffer (selected-window) (current-buffer)) - (use-local-map erc-mode-map) - (cl-letf (((symbol-function 'undefined) - (lambda () - (push (key-description (this-single-command-keys)) - calls)))) - (execute-kbd-macro "\C-c\C-c") - (execute-kbd-macro "\C-c\C-k"))) - (should (equal calls '("C-c C-k" "C-c C-c")))))) + (erc-tests-common-with-shadowed-options + (let* ((calls ()) + (inhibit-message noninteractive) + (cmd-foo (lambda () (interactive) (push 'foo calls))) + (cmd-bar (lambda () (interactive) (push 'bar calls)))) + + (when (bound-and-true-p erc-irccontrols-mode) + (erc-irccontrols-mode -1)) + (when (bound-and-true-p erc-match-mode) + (erc-match-mode -1)) + + (ert-info ("Add non-existing") + (erc--modify-local-map t "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Add existing") ; Attempt to swap definitions fails + (erc--modify-local-map t "C-c C-c" cmd-bar "C-c C-k" cmd-foo) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k")) + (should (equal calls '(bar foo)))) + (setq calls nil) + + (ert-info ("Remove existing") + (erc--modify-local-map nil "C-c C-c" cmd-foo "C-c C-k" cmd-bar) + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (use-local-map erc-mode-map) + (cl-letf (((symbol-function 'undefined) + (lambda () + (push (key-description (this-single-command-keys)) + calls)))) + (execute-kbd-macro "\C-c\C-c") + (execute-kbd-macro "\C-c\C-k"))) + (should (equal calls '("C-c C-k" "C-c C-c"))))))) (ert-deftest erc-ring-previous-command-base-case () (ert-info ("Create ring when nonexistent and do nothing") @@ -3614,8 +3614,7 @@ erc-handle-irc-url (should-not calls)) (ert-info ("Known network, existing chan with key") - (save-excursion - (with-current-buffer "foonet" (erc--open-target "#chan"))) + (with-current-buffer "foonet" (erc--open-target "#chan")) (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") (should (equal '("#chan" "sec") (pop calls))) (should-not calls)) diff --git a/test/lisp/erc/resources/erc-tests-common.el b/test/lisp/erc/resources/erc-tests-common.el index 7b1bdb86580..7d5823debe1 100644 --- a/test/lisp/erc/resources/erc-tests-common.el +++ b/test/lisp/erc/resources/erc-tests-common.el @@ -53,6 +53,29 @@ erc-tests-common-equal-with-props 'equal-including-properties) a b)) +(defmacro erc-tests-common-with-shadowed-options (&rest body) + "Run BODY with options modified by module setup code shadowed by copies." + `(let ((erc-modules (copy-sequence erc-modules)) + (erc-mode-map (copy-sequence erc-mode-map)) + (erc-mode-hook (copy-sequence erc-mode-hook)) + (erc-insert-pre-hook (copy-sequence erc-insert-pre-hook)) + (erc-insert-modify-hook (copy-sequence erc-insert-modify-hook)) + (erc-insert-post-hook (copy-sequence erc-insert-post-hook)) + (erc-insert-done-hook (copy-sequence erc-insert-done-hook)) + (erc-pre-send-functions (copy-sequence erc-pre-send-functions)) + (erc-send-modify-hook (copy-sequence erc-send-modify-hook)) + (erc-send-post-hook (copy-sequence erc-send-post-hook)) + (erc-send-completed-hook (copy-sequence erc-send-completed-hook))) + ,@body)) + +(defmacro erc-tests-common-with-shadowed-buffer (buffer &rest body) + "Run BODY in BUFFER, shadowing module-setup options." + (declare (indent 1)) + ;; Protect default values from BUFFER form, like `erc--open-target'. + `(erc-tests-common-with-shadowed-options + (with-current-buffer ,buffer + ,@body))) + ;; Caller should probably shadow `erc-insert-modify-hook' or populate ;; user tables for erc-button. ;; FIXME explain this comment ^ in more detail or delete. -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-5.7-Preserve-order-of-local-ERC-modules-for-activati.patch From 7d37b6d3ece7e92cff46fa851b2f22234db69757 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 21 Sep 2025 15:52:16 -0700 Subject: [PATCH 04/18] [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 932b7a58aa7..29041017fd5 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.2 diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 25d3ac59af1..bc3ccac55f9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2443,7 +2443,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 388b8e58aef..9b98ed23df9 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3956,7 +3956,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-5.7-Set-major-mode-before-updating-modules-in-erc-op.patch From 57aed8a618891cab5f10e8a813504a003ff34be8 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 1 Feb 2025 16:59:51 -0800 Subject: [PATCH 05/18] [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 29041017fd5..d99bac15720 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.2 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 e383e92c7ff..da20090ea6a 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 bc3ccac55f9..971535a6455 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2470,6 +2470,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.") @@ -2620,6 +2625,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 @@ -2627,8 +2635,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-5.7-Run-mode-hooks-in-ERC-query-buffers-on-reconnect.patch From c3637058eea58b4b1caadf4733a28969e231c383 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 1 May 2024 03:25:51 -0700 Subject: [PATCH 06/18] [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 d99bac15720..fb741cf0b97 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 971535a6455..fab8df881ac 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6807,9 +6807,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0007-5.x-Add-predicate-to-detect-ERC-module-activation.patch From f7e7cdc045b9b54203f8a724938d4adcc09f52d1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 6 Jan 2024 12:57:27 -0800 Subject: [PATCH 07/18] [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 fab8df881ac..432b5da6ea6 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2441,6 +2441,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 9b98ed23df9..b65cf95c28f 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3804,6 +3804,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0008-WIP-Add-erc-echo-msg-property-for-self-messages.patch From 6af3b8c7ad92152ee574570094a469ef3cd80bb6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 20 Oct 2024 18:05:14 -0700 Subject: [PATCH 08/18] [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-function): New variable. (erc-send-message): Call `erc--send-message-external-function'. (erc--send-message-external): Clarify targets could be status-prefixed only temporarily as needed to influence the destination. (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 | 45 ++++++++++++++++++++++++----------------- 3 files changed, 34 insertions(+), 21 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 da20090ea6a..93c665e4fed 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 432b5da6ea6..e02c08ba35f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -192,6 +192,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 @@ -5120,18 +5123,21 @@ erc--send-message-nested-function insertion and sending operations need a say in this processing as well.") +(defvar erc--send-message-external-function #'erc--send-message-external + "Function to send \"PRIVMSG\" to `erc-default-target', maybe sans queue.") + (defun erc-send-message (line &optional force) "Send LINE to the current channel or user and display it. See also `erc-message' and `erc-display-line'." (if (erc--input-split-p erc--current-line-input-split) (funcall erc--send-message-nested-function line force) - (erc--send-message-external line force))) + (funcall erc--send-message-external-function line force))) (defun 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." + "Send a \"PRIVMSG\" to the default target with optional FORCE, and insert it. +Expect caller to bind `erc-default-recipients' to a temporary, +nonstandard status-prefixed target if necessary." ;; Almost like an echoed message, but without the `erc--cmd'. (let* ((erc-current-message-catalog erc--message-speaker-catalog) (target (erc-default-target)) @@ -6865,7 +6871,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) @@ -6884,20 +6892,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0009-WIP-Make-ERC-response-handling-more-flexible.patch From 63519f32f4d8a99c873083b617ecd6ece90aa95c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 17 Jun 2022 01:43:03 -0700 Subject: [PATCH 09/18] [WIP] Make ERC response handling more flexible ;; FIXME update stale change log before merging. The rationale for allowing handlers to be overridden internally 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 require a breaking change in which ERC adds its primary hook member, `erc-server-FOO', buffer-locally on major-mode init. This would render lots of user code unusable. (Bug#49860) * lisp/erc/erc-backend.el (erc--response-function): New variable. (erc--ensure-response-function, erc--tidy-response-function): New function. (erc--set-up-response-function, erc--add-response-function) (erc--remove-response-function): New macros. (define-erc-response-handler): Look for and call alternate handler if appropriate. * lisp/erc/erc-common.el (erc--cmd-to-str): New function --- lisp/erc/erc-backend.el | 73 ++++++++++++++++++++++++++++++++++++++--- lisp/erc/erc-common.el | 4 +++ 2 files changed, 72 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 18e05c2790c..ecb13a194c4 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1625,6 +1625,63 @@ erc-handle-unknown-server-response " ")))) (erc-display-message parsed 'notice proc line))) +(defvar erc--response-function nil + "Alternate response handler currently running, if any.") + +(defun erc--ensure-response-function (handler-symbol) + "Add internal variable to CMD's response handler symbol via symbol property." + (unless (get handler-symbol 'erc--response-function) + (set (put handler-symbol 'erc--response-function + (make-symbol (concat "erc--" ; prefer double-hyphenated prefix + (substring (symbol-name handler-symbol) 4) + "-function"))) + handler-symbol))) + +(defun erc--tidy-response-function (handler-symbol) + "Remove symbol property from HANDLER-SYMBOL if no advice remains." + (let ((sym (get handler-symbol 'erc--response-function))) + (unless (or (null sym) (catch 'found + (erc-buffer-filter + (lambda () + (unless (eq (symbol-value sym) handler-symbol) + (throw 'found t)))))) + (cl-callf (lambda (tail) + (let ((out ())) + (while-let ((key (pop tail)) + (val (pop tail))) + (unless (eq key 'erc--response-function) + (setq out `(,val ,key ,@out)))) + (nreverse out))) + (symbol-plist handler-symbol))))) + +(defmacro erc--set-up-response-function (cmd test how function &optional depth) + "If TEST evaluates non-nil at runtime, add advice to CMD's response handler. +If TEST evaluates to nil, remove it. However, if TEST is the literal +symbol nil, only do one or the other, removing it if HOW is also nil. +Use a depth of 50 for adding if DEPTH is unspecified." + (declare (indent 2)) + (let* ((handler-symbol (intern (concat "erc-server-" (erc--cmd-to-str cmd)))) + (place `(local (get ',handler-symbol + 'erc--response-function)))) + (macroexp-let2 nil function-symbol function + (let ((add-form `(progn + (erc--ensure-response-function #',handler-symbol) + (add-function ,how ,place ,function-symbol + '((depth . ,(or depth 50)))))) + (remove-form `((remove-function ,place ,function-symbol) + (erc--tidy-response-function #',handler-symbol)))) + `(unless erc--target + ,@(cond (test `((if ,test ,add-form ,@remove-form))) + (how (macroexp-unprogn add-form)) + (t remove-form))))))) + +(defmacro erc--add-response-function (cmd how function &optional depth) + "Call `erc--set-up-response-function' with CMD, HOW, FUNCTION, and DEPTH." + `(erc--set-up-response-function ,cmd nil ,how ,function ,depth)) + +(defmacro erc--remove-response-function (cmd function) + "Call `erc--set-up-response-function' with CMD and FUNCTION." + `(erc--set-up-response-function ,cmd nil nil ,function)) (cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc @@ -1770,11 +1827,17 @@ define-erc-response-handler ;; unconditionally (defvar ,hook-name nil ,(format hook-doc name)) (add-hook ',hook-name #',fn-name) - ;; Handler function - (defun ,fn-name (proc parsed) - ,fn-doc - (ignore proc parsed) - ,@fn-body) + + ;; Handler function + (defun ,fn-name (proc parsed) + ,fn-doc + ,@(let ((variable (make-symbol "variable"))) + `((let ((,variable (and (null erc--response-function) + (get ',fn-name 'erc--response-function)))) + (if ,variable + (let ((erc--response-function (symbol-value ,variable))) + (funcall erc--response-function proc parsed)) + ,@fn-body))))) ;; Make find-function and find-variable find them (put ',fn-name 'definition-name ',name) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 93c665e4fed..a41d13aee16 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -451,6 +451,10 @@ erc-with-initialized-session (push ,hook-var delayed-mode-hooks)) (erc-buffer-do ,fn))))) +(defmacro erc--cmd-to-str (cmd) + "Return server CMD as a string, ensuring leading zeros." + `(format (if (natnump ,cmd) "%03i" "%s") ,cmd)) + (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0010-WIP-Break-up-early-ERC-response-processing.patch From d02bbcbb05071d5cc2f38e507a1c842a63a0b390 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 15 Jul 2022 05:02:35 -0700 Subject: [PATCH 10/18] [WIP] Break up early ERC response processing ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc-tags-format): Change default from `overridable' nil, and rename const value `overridable' to `warn' for clarity. (erc--parse-message-tags-function): New variable. (erc-parse-tags): Call variable instead of `erc--parse-message-tags'. (erc-get-tag): New function. (erc--tags-get): New function. (erc--parse-message-tags): Convert from generic to normal function. (erc-parse-server-response): Convert to modular logic and delegate to helpers. (erc--create-response-from-parts): New generic function and method. (erc--partition-line): New function. (erc-parse-server-response): Move partitioning of tags portion to new function `erc--partition-line'. Move creation of message to new function `erc--create-response-from-parts'. (erc--parse-traditional-response): Perform actual parsing-related business formerly handled by `erc-parse-server-response) * lisp/erc/erc-compat.el (erc-compat--with-backtrace-buffer): New macro to wrap ERC's filter function in a `handler-bind' similar to how `ert' does it. This arranges to dump a plain, non-interactive backtrace in an *erc-process-errors* buffer for every error that occurs when `debug-on-error' is not in effect. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-i--parse-message/privmsg): Force legacy parsing behavior. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common-with-cleanup): Ensure no erc-error buffers are hanging around. --- lisp/erc/erc-backend.el | 131 ++++++++++++------ lisp/erc/erc-compat.el | 32 +++++ test/lisp/erc/resources/erc-d/erc-d-tests.el | 5 +- .../erc/resources/erc-scenarios-common.el | 3 + 4 files changed, 123 insertions(+), 48 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ecb13a194c4..ffa81692f31 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -995,7 +995,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. @@ -1424,35 +1427,27 @@ erc-send-ctcp-notice ;;;; Handling responses -(defcustom erc-tags-format 'overridable - "Shape of the `tags' alist in `erc-response' objects. -When set to `legacy', pre-5.5 parsing behavior takes effect for -the tags portion of every message. The resulting alist contains -conses of the form (STRING . LIST), in which LIST is comprised of -at most one, possibly empty string. When set to nil, ERC only -parses tags if an active module defines an implementation. It -otherwise ignores them. In such cases, each alist element is a -cons of a symbol and an optional, nonempty string. - -With the default value of `overridable', ERC behaves as it does -with `legacy' except that it emits a warning whenever first -encountering a message containing tags in a given Emacs session. -But it only does so when a module implementing overriding, -non-legacy behavior isn't already active in the current network -context. - -Note that future bundled modules providing IRCv3 functionality -will not be compatible with the legacy format. User code should -eventually transition to expecting this \"5.5+ variant\" and set -this option to nil." - :package-version '(ERC . "5.5") +(defcustom erc-tags-format nil + "Shape of the `tags' alist slot for `erc-response' objects. +When set to `legacy', the alist has members of the form (STRING . LIST), +where LIST contains at most one possibly empty string. When set to nil, +ERC only extracts tags if a connection needs them. It otherwise ignores +them and leaves the slot empty. When needed, each element is a cons +cell of (SYMBOL . STRING-OR-NULL). A value of `warn' tells ERC to +behave like it does with nil except fall back on `legacy' in the absence +of an overriding format for a given connection. It also displays +possibly redundant messages when a format change has occurred." + :package-version '(ERC . "5.7") ; FIXME sync on release (above too) :type '(choice (const nil) (const legacy) - (const overridable))) + (const warn))) + +(defvar erc--parse-message-tags-function #'erc--parse-message-tags + "Function to convert the tags portion of a message into an alist.") (defun erc-parse-tags (string) "Parse IRCv3 tags list in STRING to a (tag . value) alist." - (erc--parse-message-tags string)) + (funcall erc--parse-message-tags-function string)) (defun erc--parse-tags (string) (let ((tags) @@ -1464,12 +1459,35 @@ erc--parse-tags `(,pair)) tags))))) +(defun erc-get-tag (tag tags) + "Return a cons cell of TAG and maybe its associated value from TAGS." + (assoc tag tags #'string-equal)) + +(defun erc--tags-get (key tags) + "Return KEY's value in TAGS. Like `alist-get' but `erc-tags-format' aware." + (let ((tag (erc-get-tag key tags))) + (if (eq erc-tags-format 'legacy) (cadr tag) (cdr tag)))) + +(gv-define-expander erc--tags-get + (lambda (do tag tags) + (macroexp-let2 macroexp-copyable-p key tag + (gv-letplace (getter _setter) tags + (funcall do `(alist-get ,key ,getter nil nil #'string=) + (lambda (val) + (macroexp-let2 nil val val + `(progn + (setf (alist-get ,key ,getter nil nil #'string=) + (if (eq erc-tags-format 'legacy) + (list ,val) + ,val)) + ,val)))))))) + ;; A benefit of this function being internal is not having to define a ;; separate method just to ensure an `erc-tags-format' value of ;; `legacy' always wins. A downside is that module code must take ;; care to preserve that promise manually. -(cl-defgeneric erc--parse-message-tags (string) +(defun erc--parse-message-tags (string) "Parse STRING into an alist of (TAG . VALUE) conses. Expect TAG to be a symbol and VALUE nil or a nonempty string. Don't split composite raw-input values containing commas; @@ -1486,21 +1504,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 + (funcall erc--parse-message-tags-function + (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))) @@ -1534,11 +1570,14 @@ 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. (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..c9f4c653539 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -450,6 +450,38 @@ erc-compat--defer-format-spec-in-buffer spec))))) +;;;; Misc 30.1 + +(defvar erc-compat--with-backtrace-buffer-inhibit-p nil) + +(defmacro erc-compat--with-backtrace-buffer (bufname &rest body) + "When BODY fails, print a backtrace in BUFNAME and propagate." + (declare (indent 1)) + `(,@(if (fboundp 'handler-bind) + `(handler-bind + ((error + (lambda (err) + (unless erc-compat--with-backtrace-buffer-inhibit-p + (let ((standard-output (if noninteractive + standard-output + (get-buffer-create ,bufname))) + (info (list :err err + :buffer (current-buffer) + :time (format-time-string "%FT%T.%3NZ" + nil t)))) + (terpri) + (let ((print-escape-newlines t)) + (prin1 info)) + (terpri) + (backtrace) + (unless noninteractive + (signal (car err) + (cons (format "ERC: see buffer %s" ,bufname) + info))))))))) + '(progn)) + ,@body)) + + ;;;; Misc 31.1 (defun erc-compat--window-no-other-p (window) diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index 4964af23b52..b0f2842cb9d 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -264,8 +264,9 @@ erc-d-i--parse-message/privmsg command-args contents tags)) - (let ((ours (erc-d-i--parse-message raw)) - (orig (erc-d-tests--parse-message-upstream raw))) + (let* ((erc-tags-format 'legacy) + (ours (erc-d-i--parse-message raw)) + (orig (erc-d-tests--parse-message-upstream raw))) (ert-info ((format "slot: `%s', orig: %S, ours: %S" slot orig ours)) (if (eq slot 'tags) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index c2453e93616..bf529ac238f 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -137,6 +137,7 @@ erc-scenarios-common--print-trace (quit . ,(erc-quit/part-reason-default)) (erc-version . ,erc-version))) (erc-modules (copy-sequence erc-modules)) + (erc-compat--with-backtrace-buffer-inhibit-p t) (debug-on-error t) (inhibit-interaction noninteractive) (auth-source-do-cache nil) @@ -197,6 +198,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0011-WIP-Clearly-define-erc-server-user-info-field-as-an-.patch From 2d2e6c945ad3129ef7d8d0563a9e4de910222dca Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 26 Jul 2021 05:40:59 -0700 Subject: [PATCH 11/18] [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 | 16 ++++-- lisp/erc/erc-common.el | 44 +++++++++++++++-- lisp/erc/erc-speedbar.el | 35 ++++++++++++-- lisp/erc/erc.el | 90 ++++++++++++++++++++++++++++++++-- test/lisp/erc/erc-tests.el | 99 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 267 insertions(+), 17 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ffa81692f31..3218b82e812 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -2546,9 +2546,11 @@ 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))) + (let ((erc--sui-update-p t)) + (erc-update-user-nick nick nil nil nil nil `((away . ,msg)))) + (erc-display-message parsed 'notice 'active 's301 ?n nick ?r msg))) (define-erc-response-handler (303) "ISON reply" nil @@ -2617,8 +2619,12 @@ erc--with-isupport-data (setq time (when on-since (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))) + ;; For compatibility, silently clobber the analog of the traditional + ;; info slot, ostensibly for immediate alternate display purposes. + (let ((erc--sui-update-p t)) + (erc-update-user-nick nick nick nil nil nil + (and time `((,erc--sui-key-legacy + . ,(format "on since %s" 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 a41d13aee16..b6b9c1da2e7 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -79,10 +79,31 @@ 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 non-nil symbols paired with arbitrary values. Its + ;; only known items, when present, are + ;; + ;; - `away' string with possibly empty reason; see `erc-server-301' + ;; - `idle' time the user was last active; see `erc-server-317' + ;; - `legacy' storage; see `erc--update-server-user-info' + ;; + ;; To avoid bloat, ERC only allows items needed by modules, which + ;; make that known via the alist `erc--sui-keys'. + ( 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 @@ -170,6 +191,21 @@ erc--isupport-data (table (make-char-table 'erc--channel-mode-types) :type char-table) (shortargs (make-hash-table :test #'equal))) +(defvar erc--sui-key-legacy (make-symbol "legacy") + "Alist key for pre-5.7 `erc-server-user-info' data item.") + +(defvar erc--sui-key-away (make-symbol "away") + "Alist key for `erc-server-user-info' away reason item.") + +(defvar erc--sui-keys `((,erc--sui-key-legacy t)) + "Alist of keys and their dependent modules. +Some interactive modules may add a subscription when enabling but not +remove it when disabling.") + +(defvar erc--sui-update-p nil + "Whether `erc-update-user' interprets its INFO argument as an update. +See `erc--update-server-user-info'.") + ;; After dropping 28, we can use prefixed "erc-autoload" cookies. (defun erc--normalize-module-symbol (symbol) "Return preferred SYMBOL for `erc--module'." diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 720b5cd5d11..924fe2c48f1 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -299,6 +299,17 @@ 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 (erc--sui-get user erc--sui-key-away) + (if others + (cons 'erc-italic-face (ensure-list others)) ; cache this? + '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 +365,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 +399,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 +508,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 e02c08ba35f..1631a6efe1e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -553,6 +553,8 @@ erc-add-server-user Adds USER with nickname NICK to the `erc-server-users' hash table." (erc-with-server-buffer + (when-let* ((info (erc-server-user-info user))) + (erc--update-server-user-info user info erc--sui-update-p)) (puthash (erc-downcase nick) user erc-server-users))) (defvar erc--decouple-query-and-channel-membership-p nil @@ -7107,6 +7109,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" @@ -7114,6 +7117,12 @@ 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 + (erc--sui-get user erc--sui-key-away)))) + (erc--sui-update-p t)) + (erc-update-user user nil nil nil nil `((,erc--sui-key-away + . ,(and away-p ""))))) (cond (away-p (setq erc-away (current-time))) @@ -7281,6 +7290,78 @@ erc-update-user-nick (erc-update-user (erc-get-server-user nick) new-nick host login full-name info)) +(defun erc--sui-get (user &optional key) + "Retrieve value for KEY from `info' slot of `erc-server-user' USER. +If KEY is nil, return the designated pre-5.7 storage value." + (alist-get (or key erc--sui-key-legacy) (erc-server-user-info user))) + +(defun erc--update-server-user-info (user info &optional updatep) + "Update `erc-server-user' USER's `info' slot with INFO. +Return non-nil if the slot's new value no longer `equal's its old one. +With UPDATEP, assume USER's existing `info' slot has a valid alist, and +apply INFO as an alist of changes. For each (KEY . VAL) pair in INFO, +replace or create the appropriate item for symbol KEY unless KEY's entry +in `erc--sui-keys' is nonempty or VAL is nil, in which case, remove an +existing one. If INFO is a valid alist, replace the existing slot as a +whole with a copy of INFO. If INFO is any other type, update the +special storage item for legacy values, whose KEY is an internal symbol +named \"legacy\", and assign INFO as its new VAL. Expect user code +needing to update to this 5.7+ format to use the adapter +`erc-5.7-server-user-info'." + (cond + (updatep + (let ((changedp nil)) + (condition-case err + (pcase-dolist (`(,key . ,val) info) + (unless (alist-get key erc--sui-keys) + (setq val nil)) + (if changedp + (setf (alist-get key (erc-server-user-info user) nil t) val) + (let ((found (assq key (erc-server-user-info user)))) + (unless (and found (equal (cdr found) val)) + (setq changedp t) + (cond ((and (null found) val) + (push (cons key val) (erc-server-user-info user))) + (val (setf (cdr found) val)) + (t (setf (erc-server-user-info user) + (delq found + (erc-server-user-info user))))))))) + (error + (erc-button--display-error-notice-with-keys-and-warn + "Problem modifying `erc-server-usre-info' slot for user " + (prin1-to-string (erc-server-user-nickname user)) ": %S." + " Value may now be corrupted: %S. Attempting to replace with %S." + err (erc-server-user-info user) info) + (setq changedp (erc--update-server-user-info user info)))) + changedp)) + ((and (consp info) ; `seq-every-p' signals if INFO is improper. + (cl-every (lambda (e) (and (consp e) (atom (car e)))) info)) + (unless (equal (erc-server-user-info user) info) + (setf (erc-server-user-info user) (copy-alist info)))) + (t + (erc-button--display-error-notice-with-keys-and-warn + "Incompatible value assigned to the `erc-server-user-info' slot of user" + " object for " (prin1-to-string (erc-server-user-nickname user)) "." + " In ERC 5.7, this slot became an alist of metadata pairs." + " Storing as item %S instead. Use `erc-5.7-server-user-info' to access." + (cons erc--sui-key-legacy (or info (make-symbol "nil")))) + (let ((item (condition-case _ (assq erc--sui-key-legacy + (erc-server-user-info user)) + (error (setf (erc-server-user-info user) nil))))) + (prog1 (not (and item (equal (cdr item) info))) + (if item + (setcdr item info) + (push (cons erc--sui-key-legacy info) + (erc-server-user-info user)))))))) + +(defun erc-5.7-server-user-info (user) + "Mimic `erc-server-user-info' from ERC versions before 5.7." + (declare (gv-setter (lambda (v) + `(setf (alist-get erc--sui-key-legacy + (erc-server-user-info ,user)) + ,v)))) + (alist-get erc--sui-key-legacy (erc-server-user-info user))) + (defun erc-update-user (user &optional new-nick host login full-name info) "Update user info for USER. @@ -7289,6 +7370,9 @@ erc-update-user existing values for USER are used to replace the stored values in USER. +Expect INFO to be a full replacement alist possibly containing elements +of the existing one. + 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." @@ -7314,8 +7398,8 @@ erc-update-user (setf (erc-server-user-full-name user) full-name)) (when (and info (not (equal (erc-server-user-info user) info))) - (setq changed t) - (setf (erc-server-user-info user) info)) + (setq changed (erc--update-server-user-info user info + erc--sui-update-p))) (if changed (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) @@ -7349,7 +7433,7 @@ erc--create-current-channel-member :host host :full-name full-name :login login - :info nil + :info info :buffers (list (current-buffer)))))) (let ((cusr (erc-channel-user--make :status (or status 0) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b65cf95c28f..08e37d3fdf2 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4253,4 +4253,103 @@ erc-retrieve-catalog-entry ;; Terminates. (should-not (erc-retrieve-catalog-entry 'ghi (intern "test0"))))) +(ert-deftest erc--update-server-user-info () + (with-current-buffer (erc-tests-common-make-server-buf "foonet") + + ;; Ensure `search-forward' doesn't fail because of line filling. + (when (bound-and-true-p erc-fill-mode) + (let (erc-modules) + (erc-fill-mode -1))) + + (cl-letf* ((user (make-erc-server-user :nickname "tester" + :login "testeroni" + :info (list (cons 'a 1)))) + (erc--sui-keys '((legacy t) (a t) (b t))) + ;; Override internal symbol for the extent of this test. + (erc--sui-key-legacy 'legacy) + (assign (lambda (val) + (let ((erc--sui-update-p t)) + (erc--update-server-user-info user val 'updatep)))) + (calls ()) + ((symbol-function 'display-warning) + (lambda (_ msg &rest _) (push msg calls)))) + + (ert-info ("Clobbers fallback slot `nil'") + (should (erc--update-server-user-info user 'bar)) + (should (equal (erc-server-user-info user) '((legacy . bar) (a . 1)))) + (should (erc--update-server-user-info user nil)) + (should-not (erc--update-server-user-info user nil)) ; repeat + (should (equal (erc-server-user-info user) '((legacy . nil) (a . 1)))) + (should (equal (pop (erc-server-user-info user)) '(legacy))) + + (goto-char (point-min)) + (should (search-forward "storing as item (legacy . bar)" nil t)) + (should (search-forward "storing as item (legacy . nil)" nil t)) + (should (search-forward "storing as item (legacy . nil)" nil t)) + (should (string-search "(legacy . nil)" (pop calls))) + (should (string-search "(legacy . nil)" (pop calls))) + (should (string-search "(legacy . bar)" (pop calls)))) + + ;; Bad existing value stashed but munged with UPDATEP arg. + (should (equal (erc-server-user-info user) '((a . 1)))) + (setf (erc-server-user-info user) '(b . 2)) ; replace with non-alist + (should (funcall assign '((a . 1)))) + (should (search-forward "corrupted: (b . 2)" nil t)) + (should (string-search "corrupted: (b . 2)" (pop calls))) + (should (equal (erc-server-user-info user) '((a . 1)))) + + ;; Single update must be an alist and not just a single k/v cons cell. + (should (equal (erc-server-user-info user) '((a . 1)))) + (should (funcall assign '((b . 2)))) + (should (equal (erc-server-user-info user) '((b . 2) (a . 1)))) + (should-not (funcall assign '((b . 2)))) ; no change + (should (equal (erc-server-user-info user) '((b . 2) (a . 1)))) + (should-not (funcall assign '((a . 1)))) ; no change + (should (equal (erc-server-user-info user) '((b . 2) (a . 1)))) + + ;; An associated value of nil removes an item. + (should (funcall assign '((b . nil)))) + (should (equal (erc-server-user-info user) '((a . 1)))) + + ;; Creating, updating, and deleting the secret slot is allowed. + (should (funcall assign '((legacy . 42)))) + (should (equal (erc-server-user-info user) '((legacy . 42) (a . 1)))) + (should (funcall assign '((legacy . "42")))) + (should-not (funcall assign '((legacy . "42")))) + (should (equal (erc--sui-get user) "42")) + (should (funcall assign '((legacy . nil) (a . nil)))) + (should-not (erc-server-user-info user)) + + ;; No attempt to massage an existing value if it's a list. + (setf (erc-server-user-info user) (list "malformed")) + (should (funcall assign '((a . 1)))) + (should (equal (erc-server-user-info user) '((a . 1) "malformed"))) + + ;; Non-list is replaced. + (setf (erc-server-user-info user) 42) + (should (erc--update-server-user-info user '(a . 1))) + (should (equal (erc-server-user-info user) '((legacy . (a . 1))))) + (should (search-forward "storing as item (legacy a . 1)" nil t)) + (should (string-search "(legacy a . 1)" (pop calls))) + + ;; An alist with only atoms as keys is accepted. + (should (erc--update-server-user-info user '((a . 1) (legacy . nil)))) + (should-not (erc--update-server-user-info user ; repeat + '((a . 1) (legacy . nil)))) + (should-not calls) + + ;; 5.7 accessor analog does not massage input when setting. + (setf (erc-5.7-server-user-info user) 42) + (should (equal (erc-5.7-server-user-info user) 42)) + (should (equal (erc-server-user-info user) '((a . 1) (legacy . 42)))) + (setf (erc-5.7-server-user-info user) '((foo . bar))) + (should (equal (erc-5.7-server-user-info user) '((foo . bar)))) + (should (equal (erc-server-user-info user) + '((a . 1) (legacy . ((foo . bar)))))) + + (should-not calls) + (should-not (search-forward "Incompatible" nil t)))) + + (when noninteractive (erc-tests-common-kill-buffers))) + ;;; erc-tests.el ends here -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0012-WIP-Add-account-slot-to-erc-server-user.patch From e045d65e15b55a7d8dc1b03d9a6da827730e926d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 7 Aug 2022 04:12:41 -0700 Subject: [PATCH 12/18] [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 | 9 ++++- lisp/erc/erc-button.el | 24 ++++++++++--- lisp/erc/erc-common.el | 7 ++++ lisp/erc/erc.el | 77 ++++++++++++++++++++++++++--------------- 4 files changed, 85 insertions(+), 32 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 3218b82e812..5a9d0032ff5 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 @@ -2714,6 +2716,11 @@ erc-server-322-message (let ((nick (cadr (erc-response.command-args parsed))) (authaccount (nth 2 (erc-response.command-args parsed))) (authmsg (erc-response.contents parsed))) + ;; The 2025 modern docs say: "This does not necessarily mean the + ;; user owns their current nickname, which is covered by + ;; RPL_WHOISREGNICK." The `erc-server-user' slot carries no such + ;; ownership implications either. + (erc-update-user-nick nick nil nil nil nil nil authaccount) (erc-display-message parsed 'notice 'active 's330 ?n nick ?a authmsg ?i authaccount))) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index ac646ed507f..e088d5ebb1b 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))) + (erc--tags-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 b6b9c1da2e7..69b654b599e 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -101,6 +101,13 @@ erc-input ( info nil :type (list-of cons) :documentation "Alist of `eq'-testable keys with arbitrary values.") + ;; This slot could potentially be used for draft/account-id as well, + ;; which would either supersede a normal account name or coexist + ;; alongside one, via some encoding scheme. + ;; https://github.com/ircv3/ircv3-specifications/issues/402 + ( account nil + :type (or null string) + :documentation "Account logged into, which may not own nickname.") ( 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 1631a6efe1e..1f32691df3e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -550,8 +550,18 @@ erc--casemapping-rfc1459 (defun erc-add-server-user (nick user) "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-let* ((info (erc-server-user-info user))) (erc--update-server-user-info user info erc--sui-update-p)) @@ -7283,12 +7293,11 @@ 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)) +Do nothing if the user doesn't exist." + (when-let* ((user (erc-get-server-user nick))) + (erc-update-user user new-nick host login full-name info account))) (defun erc--sui-get (user &optional key) "Retrieve value for KEY from `info' slot of `erc-server-user' USER. @@ -7363,12 +7372,13 @@ erc-5.7-server-user-info (alist-get erc--sui-key-legacy (erc-server-user-info user))) (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 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. Expect INFO to be a full replacement alist possibly containing elements of the existing one. @@ -7386,20 +7396,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 (erc--update-server-user-info user info erc--sui-update-p))) + (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) @@ -7408,13 +7429,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))) @@ -7426,7 +7447,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) @@ -7434,6 +7455,7 @@ erc--create-current-channel-member :full-name full-name :login login :info info + :account account :buffers (list (current-buffer)))))) (let ((cusr (erc-channel-user--make :status (or status 0) @@ -7476,12 +7498,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, @@ -7510,23 +7532,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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0013-WIP-Make-updating-last-message-time-more-flexible-in.patch From 16194d277c2b377d8ca0ef2dd155ecbd9b7556b9 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 6 Sep 2023 19:52:20 -0700 Subject: [PATCH 13/18] [WIP] Make updating last-message-time more flexible in ERC ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc--time-pair-from-time-tag): New function. (erc-server-TOPIC): Attempt to display time from server-time tag. * lisp/erc/erc-common.el (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-backend.el | 8 ++- lisp/erc/erc-common.el | 25 +++++++-- lisp/erc/erc-compat.el | 96 +++++++++++++++++++++++++++++++++ lisp/erc/erc-stamp.el | 7 +-- lisp/erc/erc.el | 27 +++++++--- test/lisp/erc/erc-fill-tests.el | 11 ++-- test/lisp/erc/erc-tests.el | 15 ++++++ 7 files changed, 164 insertions(+), 25 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 5a9d0032ff5..25168485627 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1506,6 +1506,11 @@ erc--parse-message-tags " releases. See `erc-tags-format' for more info."))) (erc--parse-tags 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 (erc--tags-get 'time (erc-response.tags parsed))) + ((erc-compat--iso8601-to-time stamp t))))) + (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 @@ -2342,7 +2347,8 @@ erc--speaker-status-prefix-wanted-p "The channel topic has changed." nil (let* ((ch (car (erc-response.command-args 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--time-pair-from-time-tag 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) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 69b654b599e..33a246d7061 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -129,11 +129,11 @@ erc-input "Object containing channel-specific data for a single user." ;; voice halfop op admin owner (status 0 :type natnum) - ;; Last message time (in the form of the return value of - ;; (current-time) - ;; - ;; This is useful for ordered name completion. - (last-message-time nil)) + ;; lisp time or seconds since the epoch the user was last "active." + ;; What that means exactly is not well defined. If the member hasn't + ;; spoken, this may be the time they joined, irrespective of any + ;; intervening AWAY activity. Accurate to within a couple seconds. + (last-message-time nil :type (or list natnum))) (cl-defstruct erc--target (string "" :type string :documentation "Received name of target.") @@ -600,6 +600,21 @@ erc-log (when erc-log-p (erc-log-aux ,string)))) +(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 c9f4c653539..e93ffe635e5 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 1f32691df3e..47746778377 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4195,8 +4195,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)) @@ -7428,6 +7427,12 @@ erc-update-user (run-hooks 'erc-channel-members-changed-hook)))))) changed)) +(defvar erc--current-channel-member-last-message-time-p nil + "If non-nil, interpret a TIMEP argument as the new last-message-time. +Preferred by `erc--create-current-channel-member' and +`erc--update-current-channel-member' to `erc--current-time-pair' because +that would affect `erc-channel-members-changed-hook'.") + (defun erc--create-current-channel-member (nick status timep &optional new-nick host login full-name info account) "Add an `erc-channel-member' entry for NICK. @@ -7459,8 +7464,10 @@ erc--create-current-channel-member :buffers (list (current-buffer)))))) (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 (if erc--current-channel-member-last-message-time-p + 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 @@ -7483,8 +7490,10 @@ 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 (if erc--current-channel-member-last-message-time-p + timep + (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)) @@ -7580,6 +7589,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 08e37d3fdf2..3442829d571 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -4352,4 +4352,19 @@ erc--update-server-user-info (when noninteractive (erc-tests-common-kill-buffers))) +(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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0014-WIP-Make-some-core-ERC-functions-more-flexible.patch From 36f431b79c41c202e2d0ba413a77a8ed755f3baa Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sun, 18 Jul 2021 04:33:17 -0700 Subject: [PATCH 14/18] [WIP] Make some core ERC functions more flexible ;; FIXME update stale change log before merging. * lisp/erc/erc-backend.el (erc--register-connection-function): New variable. (erc--register-connection): Perform login indirectly, via `erc--register-connection-function'. (erc--server-send-function): New variable. (erc-server-send): Call `erc--server-send-function'. (erc--server-send): Convert to normal function. * lisp/erc/erc-goodies.el (erc-scrolltobottom-confirm): Also recenter when inserting above `erc--insert-marker'. * lisp/erc/erc.el (erc--with-spliced-insertion): Change `erc--insert-line-function' to `erc--insert-msg-function'. (erc--insert-line-function): Repurpose for variants of `erc-insert-line' rather than `insert'. (erc--insert-msg-function): New variable to be used in place of what was `erc--insert-line-function' (erc-insert-line): Make obsolete, move body to new internal function `erc--insert-line'. This function is increasingly more low-level and difficult to use on its own for inserting messages still compatible with the rest of ERC. (erc--insert-line): New function to replace `erc-insert-line'. (erc--route-insertion): Suppress obsolete warning when calling `erc-insert-line'. (erc--partition-prefixed-names-function): New variable. (erc-channel-receive-names): Call `erc--partition-prefixed-names-function' instead of `erc--partition-prefixed-names'. --- lisp/erc/erc-backend.el | 13 +++++++++---- lisp/erc/erc-goodies.el | 2 +- lisp/erc/erc.el | 33 ++++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 2 +- 4 files changed, 35 insertions(+), 15 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 25168485627..03dae1e4f45 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -714,10 +714,12 @@ erc-open-network-stream (let ((p (plist-put parameters :nowait t))) (apply #'open-network-stream name buffer host service p))) -(cl-defmethod erc--register-connection () +(defvar erc--register-connection-function #'erc-login) + +(defun erc--register-connection () "Perform opening IRC protocol exchange with server." (run-hooks 'erc--server-post-connect-hook) - (erc-login)) + (funcall erc--register-connection-function)) (defvar erc--server-post-dial-function #'erc--server-propagate-failed-connection @@ -1248,6 +1250,9 @@ erc-send-line (funcall display-fn)) (erc-split-line text))) +(defvar erc--server-send-function #'erc--server-send + "Function to send message, maybe sans queuing, encoded for a target.") + ;; From Circe, with modifications (defun erc-server-send (string &optional force target) "Send STRING to the current server. @@ -1262,9 +1267,9 @@ erc-server-send See `erc-server-flood-margin' for an explanation of the flood protection algorithm." - (erc--server-send string force target)) + (funcall erc--server-send-function string force target)) -(cl-defmethod erc--server-send (string force target) +(defun erc--server-send (string force target) "Encode and send STRING to `erc-server-process'. Expect STRING, FORCE, and TARGET to originate from `erc-server-send'." (erc-log (concat "erc-server-send: " string "(" (buffer-name) ")")) 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 47746778377..e8757ab919e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3444,7 +3444,7 @@ erc--with-spliced-insertion "In BODY, ensure `erc-insert-line' inserts messages at MARKER-OR-POS. If MARKER-OR-POS is a marker, let it advance normally (and permanently) with each insertion. Allow modules to influence insertion by binding -`erc--insert-line-function' to `erc--insert-line-splice-function' around +`erc--insert-msg-function' to `erc--insert-line-splice-function' around BODY. Note that as of ERC 5.6, this macro cannot handle multiple successive calls to `erc-insert-line' in BODY, such as when replaying a history backlog." @@ -3453,11 +3453,11 @@ erc--with-spliced-insertion `(progn (cl-assert (or (= ,marker-or-pos (point-min)) (= ?\n (char-before ,marker-or-pos)))) - (cl-assert (null erc--insert-line-function)) + (cl-assert (null erc--insert-msg-function)) (let* ((,marker (and (not (markerp ,marker-or-pos)) (copy-marker ,marker-or-pos))) (erc--insert-marker (or ,marker ,marker-or-pos)) - (erc--insert-line-function erc--insert-line-splice-function)) + (erc--insert-msg-function erc--insert-line-splice-function)) (prog1 (progn ,@body) (when ,marker (set-marker ,marker nil))))))) @@ -3498,7 +3498,10 @@ erc--insert-invisible-as-intangible-p that this flag and the behavior it restores may disappear at any time, so if you need them, please let ERC know with \\[erc-bug].") -(defvar erc--insert-line-function nil +(defvar erc--insert-line-function #'erc--insert-line + "Function called with single line to insert into ERC buffer.") + +(defvar erc--insert-msg-function nil "When non-nil, an `insert'-like function for inserting messages. Modules, like `fill-wrap', that leave a marker at the beginning of an inserted message clearly want that marker to advance along with text @@ -3528,8 +3531,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)) + (funcall erc--insert-line-function string)))) + +(defun 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. @@ -3543,7 +3554,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 @@ -3558,8 +3569,8 @@ erc-insert-line (save-restriction (widen) (goto-char insert-position) - (if erc--insert-line-function - (funcall erc--insert-line-function string) + (if erc--insert-msg-function + (funcall erc--insert-msg-function string) (insert string)) (erc--assert-input-bounds) ;; run insertion hook, with point at restored location @@ -3634,7 +3645,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)))) @@ -7256,6 +7268,9 @@ erc-channel-members-changed-hook :group 'erc-hooks :type 'hook) +(defvar erc--partition-prefixed-names-function #'erc--partition-prefixed-names + "Function to split status-prefixed nick or NUH into parts.") + (defun erc--partition-prefixed-names (name) "From NAME, return a list of (STATUS NICK LOGIN HOST). Expect NAME to be a prefixed name, like @bob." @@ -7274,7 +7289,7 @@ erc-channel-receive-names (let ((names (delete "" (split-string names-string))) (erc-channel-members-changed-hook nil)) (dolist (name names) - (when-let* ((args (erc--partition-prefixed-names name))) + (when-let* ((args (funcall erc--partition-prefixed-names-function name))) (pcase-let* ((`(,status ,nick ,login ,host) args) (cmem (erc-get-channel-user nick))) (progn diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3442829d571..950e4d09693 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2132,7 +2132,7 @@ erc--insert-before-markers-transplanting-hidden (should (equal '(a b) (get-text-property (1- (point)) 'invisible))) ;; Splice in a new message. - (let ((erc--insert-line-function + (let ((erc--insert-msg-function #'erc--insert-before-markers-transplanting-hidden) (erc--insert-marker (copy-marker (point)))) (goto-char (point-max)) -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0015-WIP-Adapt-some-ERC-functions-for-multiple-prefixes.patch From cdbb762af83aaa802d4a12bfbd91b53f75095edb Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Wed, 12 Nov 2025 05:58:07 -0800 Subject: [PATCH 15/18] [WIP] Adapt some ERC functions for multiple prefixes * lisp/erc/erc.el (erc-get-channel-membership-prefix) (erc--format-channel-membership-prefix): Move body of former to latter, a new function. (erc-nick-at-point): Rework to use helper. (erc--format-user-parts-multip): New variable. (erc--format-user-parts): New function. * test/lisp/erc/erc-tests.el (erc--format-channel-membership-prefix) (erc-nick-at-point): New tests. --- lisp/erc/erc.el | 139 ++++++++++++++++++++++--------------- test/lisp/erc/erc-tests.el | 113 ++++++++++++++++++++++++++++++ 2 files changed, 196 insertions(+), 56 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index e8757ab919e..69667897b88 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6551,6 +6551,11 @@ erc-get-channel-membership-prefix For compatibility reasons, don't error when NICK-OR-CUSR is null, but return nil instead of the empty string. Otherwise, always return a possibly empty string." + (erc--format-channel-membership-prefix nick-or-cusr nil nil)) + +(defun erc--format-channel-membership-prefix (nick-or-cusr + &optional lettersp multip) + "Format multiple status prefixes or membership letters for NICK-OR-CUSR." (when nick-or-cusr (when (stringp nick-or-cusr) (setq nick-or-cusr (and erc-channel-members @@ -6562,29 +6567,31 @@ erc-get-channel-membership-prefix ;; For compatibility, first check whether a parsed prefix exists. ((and-let* ((pfx-obj (erc--parsed-prefix))) (catch 'done - (pcase-dolist (`(,letter . ,pfx) - (erc--parsed-prefix-alist pfx-obj)) - (when (erc--cusr-status-p nick-or-cusr letter) - (throw 'done - (pcase letter - (?q (propertize (string pfx) 'help-echo "owner")) - (?a (propertize (string pfx) 'help-echo "admin")) - (?o (propertize (string pfx) 'help-echo "operator")) - (?h (propertize (string pfx) 'help-echo "half-op")) - (?v (propertize (string pfx) 'help-echo "voice")) - (_ (string pfx)))))) - ""))) + (let ((out ())) + (pcase-dolist + (`(,letter . ,prefix) (erc--parsed-prefix-alist pfx-obj)) + (when (erc--cusr-status-p nick-or-cusr letter) + (let* ((c (if lettersp letter prefix)) + (s (pcase letter + (?q (propertize (string c) 'help-echo "owner")) + (?a (propertize (string c) 'help-echo "admin")) + (?o (propertize (string c) 'help-echo "operator")) + (?h (propertize (string c) 'help-echo "half-op")) + (?v (propertize (string c) 'help-echo "voice")) + (_ (string c))))) + (if multip (push s out) (throw 'done s))))) + (apply #'concat (nreverse out)))))) (t (cond ((erc-channel-user-owner nick-or-cusr) - (propertize "~" 'help-echo "owner")) + (propertize (if lettersp "q" "~") 'help-echo "owner")) ((erc-channel-user-admin nick-or-cusr) - (propertize "&" 'help-echo "admin")) + (propertize (if lettersp "a" "&") 'help-echo "admin")) ((erc-channel-user-op nick-or-cusr) - (propertize "@" 'help-echo "operator")) + (propertize (if lettersp "o" "@") 'help-echo "operator")) ((erc-channel-user-halfop nick-or-cusr) - (propertize "%" 'help-echo "half-op")) + (propertize (if lettersp "h" "%") 'help-echo "half-op")) ((erc-channel-user-voice nick-or-cusr) - (propertize "+" 'help-echo "voice")) + (propertize (if lettersp "v" "+") 'help-echo "voice")) (t "")))))) (defun erc-format-@nick (&optional user channel-data) @@ -9219,45 +9226,65 @@ erc-kill-query-buffers (erc-with-all-buffers-of-server process (lambda () erc--target) (kill-buffer (current-buffer))))) -(defun erc-nick-at-point () - "Give information about the nickname at `point'. - -If called interactively, give a human readable message in the -minibuffer. If called programmatically, return the corresponding -entry of `channel-members'." - (interactive) - (require 'thingatpt) - (let* ((word (word-at-point)) - (channel-data (erc-get-channel-user word)) - (cuser (cdr channel-data)) - (user (if channel-data - (car channel-data) - (erc-get-server-user word))) - host login full-name nick voice halfop op admin owner) - (when user - (setq nick (erc-server-user-nickname user) - host (erc-server-user-host user) - login (erc-server-user-login user) - full-name (erc-server-user-full-name user)) - (if cuser - (setq voice (erc-channel-user-voice cuser) - halfop (erc-channel-user-halfop cuser) - op (erc-channel-user-op cuser) - admin (erc-channel-user-admin cuser) - owner (erc-channel-user-owner cuser)))) - (if (called-interactively-p 'interactive) - (message "%s is %s@%s%s%s" - nick login host - (if full-name (format " (%s)" full-name) "") - (if (or voice halfop op admin owner) - (format " and is +%s%s%s%s%s on %s" - (if voice "v" "") - (if halfop "h" "") - (if op "o" "") - (if admin "a" "") - (if owner "q" "") - (erc-default-target)) - "")) +(defvar erc--format-user-parts-multip nil) + +(defun erc--format-user-parts (user cusr faces) + "Return list of informative labels re USER, incorporating CUSR if given. +Include (ACCOUNT STATUS USERHOST FULL-NAME AWAY), preferring null to empty. +Omit intervening spaces, leaving caller to format further as needed." + (mapcar + (lambda (entry) + (let* ((face (pop faces)) + (string (pop entry))) + (cond ((null string) nil) + ((string-empty-p string) nil) + ((null face) (funcall entry string)) + (t (funcall entry (propertize string 'face face)))))) + ;; If CAR is non-nil, apply function CDR to it after adding face. + `((,(erc-server-user-account user) . ,(lambda (s) (concat "a:" s))) + (,(and cusr (erc--format-channel-membership-prefix + cusr 'lettersp erc--format-user-parts-multip)) + . ,(lambda (s) (concat "+" s))) + ;; Some NUHs don't have a userhost or just have one or the other. + ;; For now, ignore those. + (,(and-let* ((login (erc-server-user-login user)) + (host (erc-server-user-host user))) + (concat login "@@AT@@" host)) + . ,(lambda (s) (replace-regexp-in-string "@@AT@@" "@" s))) + (,(erc-server-user-full-name user) . ,(lambda (s) (format "\"%s\"" s))) + (,(erc--sui-get user erc--sui-key-away) + . ,(lambda (s) (format "G:\"%s\"" s)))))) + +(defun erc-nick-at-point (&optional arg) + "Provide information about the nick at `point'. +If called interactively, show an informative message in the echo area. +If called non-interactively and with a non-numeric ARG, return that same +message but don't display it. And, if ARG is itself a string, use it +instead of the word at point to look up the user. Otherwise, if called +non-interactively without an ARG, return the `erc-server-user' if found." + (interactive "p") + (let* ((nick (if (stringp arg) + arg + (or (and (require 'thingatpt) (word-at-point)) + (user-error "No nick at point")))) + (cmem (and nick (erc-channel-p (current-buffer)) + (erc-get-channel-member nick))) + (cusr (cdr cmem)) + (user (if cmem (car cmem) (and nick (erc-get-server-user nick))))) + (if arg + (pcase-let* ((`(,_ ,status ,uh ,full-name ,_) + (erc--format-user-parts user cusr nil)) + (rest (concat + uh + (and uh full-name " ") + (and full-name (format "(%s)" full-name)) + (and (or uh full-name) status " and is ") + (and status + (format "%s on %s" status (erc-target))))) + (out (concat (erc-server-user-nickname user) + (and (not (string-empty-p rest)) " is ") + rest))) + (if (numberp arg) (message "%s" out) out)) user))) (defun erc-away-time () diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 950e4d09693..6e3908d5423 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2821,6 +2821,119 @@ erc-get-channel-membership-prefix (kill-buffer)))) +(ert-deftest erc--format-channel-membership-prefix () + (erc-tests-common-make-server-buf) + (push '("PREFIX" . "(YovV)!@+-") erc-server-parameters) + (should (erc--parsed-prefix)) + + (erc-tests-common-with-shadowed-buffer (erc--open-target "#chan") + + ;; Baseline. + (should-not (erc--format-channel-membership-prefix nil)) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user)))) + + ;; Defaults. + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :owner t)))) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :admin t)))) + (should (string-empty-p (erc--format-channel-membership-prefix + (make-erc-channel-user :halfop t)))) + + (erc-update-current-channel-member "Bob" nil t nil nil 'on) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob") + #("@" 0 1 (help-echo "operator")))) + + ;; Giving bob voice does not change output sans `multip' flag. + (erc-update-current-channel-member "Bob" nil t 'on) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob") + #("@" 0 1 (help-echo "operator")))) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" nil 'multip) + #("@+" 0 1 (help-echo "operator") 1 2 (help-echo "voice")))) + + ;; With letters. + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp) + #("o" 0 1 (help-echo "operator")))) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("ov" 0 1 (help-echo "operator") 1 2 (help-echo "voice")))) + + ;; With nonstandard chars. + (erc--cusr-change-status "Bob" ?Y 'enablep) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp) + "Y")) ; no traditional label associated + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("Yov" 1 2 (help-echo "operator") 2 3 (help-echo "voice")))) + (erc--cusr-change-status "Bob" ?V 'enablep) + (should (erc-tests-common-equal-with-props + (erc--format-channel-membership-prefix "Bob" 'lettersp 'multip) + #("YovV" 1 2 (help-echo "operator") 2 3 (help-echo "voice"))))) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-nick-at-point () + (erc-tests-common-make-server-buf) + (push '("PREFIX" . "(ov)@+") erc-server-parameters) + + ;; Baseline. + (should (equal (should-error (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point)))) + '(user-error "No nick at point"))) + + ;; In a channel without userhost-in-names. + (let (erc-active-buffer) ; stay in buffer "foonet" + (with-current-buffer (erc--open-target "#chan") + ;; Add a user with no userhost or full-name but +o status. + (erc-tests-common-simulate-line + ":irc.foonet.org 353 tester = #chan :@Bob tester") + (erc-tests-common-simulate-line + ":irc.foonet.org 366 tester #chan :End of NAMES list") + + ;; No valid nick at point required when string supplied. + (should (equal (erc-nick-at-point "Bob") "Bob is +o on #chan")) + + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + ;; Called from Lisp without an arg just returns the user object. + (should (equal (erc-nick-at-point) (erc-get-server-user "Bob"))) + ;; Return string but don't print when arg is or string. + (should (equal (erc-nick-at-point t) "Bob is +o on #chan")) + ;; Interactive call yields same result. + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + "Bob is +o on #chan")))) + + ;; In a server buffer, no userhost or full-name yields a plain nick. + (should (equal (erc-nick-at-point "Bob") "Bob")) + + ;; Add userhost and full-name. + (erc-tests-common-simulate-line + ":irc.foonet.org 311 tester Bob bob 0::1 * :I Am Bob") + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + (goto-char (match-beginning 0)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + ;; The @ here is U@H, not a status prefix. + "Bob is bob@0::1 (\"I Am Bob\")")) + + ;; Other fields incoroporated when present in channel. + (with-current-buffer "#chan" + (goto-char (point-min)) + (should (search-forward "Bob" nil t)) + (should (equal (let ((inhibit-message noninteractive)) + (ert-simulate-command '(erc-nick-at-point 1))) + "Bob is bob@0::1 (\"I Am Bob\") and is +o on #chan"))) + + (erc-tests-common-kill-buffers)) + ;; This is an adapter that uses formatting templates from the ;; `-speaker' catalog to mimic `erc-format-privmessage', for testing ;; purposes. -- 2.51.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0016-WIP-Fix-some-message-display-bugs-in-erc-backend.patch From 71beefaabbdf90f1cb0ce63041cc35b74c29ac02 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/18] [WIP] Fix some message display bugs in erc-backend * lisp/erc/erc-backend.el (erc-server-JOIN, erc-server-NICK): Return nil. (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 | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 03dae1e4f45..2abfe373b26 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1975,7 +1975,8 @@ erc--server-determine-join-display-context (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)))))) + (apply #'erc-display-message parsed 'notice buffer args))))) + nil) (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil @@ -2104,12 +2105,14 @@ erc--wrangle-query-buffers-on-nick-change (erc--ensure-query-member nn)) (erc-handle-user-status-change 'nick (list nick login host) (list nn)) (erc-display-message parsed 'notice bufs 'NICK ?n nick - ?u login ?h host ?N nn)))))) + ?u login ?h host ?N nn))))) + nil) (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)))) @@ -2360,7 +2363,8 @@ erc--speaker-status-prefix-wanted-p (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) 'TOPIC ?n nick ?u login ?h host - ?c ch ?T topic)))) + ?c ch ?T topic))) + nil) (define-erc-response-handler (WALLOPS) "Display a WALLOPS message." nil @@ -2796,11 +2800,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.1 --=-=-= 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 872f1bcdfe684c31dfb045568909fb07ae2cfd8c 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/18] [WIP] Add IRCv3 building blocks to ERC ;; FIXME update stale change log before merging. ;; There are SASL-related changes missing. * 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-sasl.el | 173 +- lisp/erc/erc-v3.el | 2374 +++++++++++++++++ lisp/erc/erc.el | 1 + .../erc/erc-scenarios-v3-account-notify.el | 133 + test/lisp/erc/erc-scenarios-v3-sasl.el | 200 ++ test/lisp/erc/erc-scenarios-v3.el | 588 ++++ test/lisp/erc/erc-tests.el | 1 + test/lisp/erc/erc-v3-tests.el | 1463 ++++++++++ .../erc/resources/erc-scenarios-common.el | 13 + .../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 | 67 + .../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 | 59 + test/lisp/erc/resources/v3/whox/basic.eld | 85 + .../erc/resources/v3/whox/rate-limited.eld | 136 + 25 files changed, 5883 insertions(+), 4 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-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-sasl.el b/lisp/erc/erc-sasl.el index 5228fc5e5aa..5f0d6062663 100644 --- a/lisp/erc/erc-sasl.el +++ b/lisp/erc/erc-sasl.el @@ -36,7 +36,7 @@ ;; mechanism for you. Requires CAP 3.2 (see bug#49860). =20 ;;; Code: -(require 'erc) +(require 'erc-v3) (require 'rx) (require 'sasl) (require 'sasl-scram-rfc) @@ -312,6 +312,7 @@ sasl doesn't currently solicit or validate supported mechanisms." ((if erc--target (erc-sasl-mode -1) + (erc-sasl--set-up-register-connection-function t) (setq erc-sasl--state (make-erc-sasl--state)) ;; If the previous attempt failed during registration, this may be ;; non-nil and contain erroneous values, but how can we detect that? @@ -330,9 +331,17 @@ sasl (error "Unknown or unsupported SASL mechanism: `%s'" mech)) (setf (erc-sasl--state-client erc-sasl--state) client)))) ((kill-local-variable 'erc-sasl--state) - (kill-local-variable 'erc-sasl--options)) + (kill-local-variable 'erc-sasl--options) + (erc-sasl--set-up-register-connection-function nil)) localp) =20 +(defun erc-sasl--set-up-register-connection-function (wantp) + (if wantp + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--register-connection '((depth . 60))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--register-connection))) + (define-erc-response-handler (AUTHENTICATE) "Begin or resume an SASL session." nil (if-let* ((response (car (erc-response.command-args parsed))) @@ -410,7 +419,7 @@ erc-sasl--send-cap-ls into a user option, please let ERC know via \\[erc-bug]. Otherwise, expect it to disappear in subsequent versions.") =20 -(cl-defmethod erc--register-connection (&context (erc-sasl-mode (eql t))) +(defun erc-sasl--register-connection (inner) "Send speculative CAP and pipelined AUTHENTICATE and hope for the best." (if-let* ((c (erc-sasl--state-client erc-sasl--state)) (m (sasl-mechanism-name (sasl-client-mechanism c)))) @@ -426,12 +435,168 @@ erc--register-connection (if (eq :user (alist-get 'user erc-sasl--options)) (erc-current-nick) erc-session-username))) - (cl-call-next-method)) + (funcall inner)) (when erc-sasl--send-cap-ls (erc-server-send "CAP REQ :sasl")) (erc-server-send (format "AUTHENTICATE %s" m))) (erc-sasl--destroy erc-server-process))) =20 + +;;;; Extension: sasl + +;; The following is glue to adapt the `sasl' module to the IRCv3 +;; capability negotiation process. There's no need to add `sasl' to +;; `erc-modules' so long as `sasl' appears in `erc-v3-extensions'. + +;; When this module loads, `cl-struct-define' associates this struct's +;; type with that of its parent, `erc-v3--extension'. The `v3' module +;; then leverages this association as a discovery mechanism to run the +;; `initp' slot of every constructor. This slot's code in particular +;; adds `sasl' to the session's copy of `erc-v3-extensions', which tells +;; ERC to mark it as wanted during capability negotiation. +(erc-v3--define-capability sasl + :initp (erc-sasl--v3-on-wantedp-init) + :slots ((done-cmd nil :type (or null string))) ; e.g., "903" + (unless erc-v3--sasl + (remove-hook 'erc-sasl-mode-hook #'erc-sasl--v3-on-minor-mode t) + (erc-sasl-mode -1))) + +(defun erc-sasl--v3-on-minor-mode () + "Inhibit CL methods specializing on `erc-sasl-mode' `eql'ing t." + (unless erc--target + (if erc-sasl-mode + (progn + (erc-sasl--set-up-register-connection-function nil) + (add-function :around (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS '((depth . 40))) + (add-function :around (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK '((depth . 40)))) + (remove-function (local 'erc--register-connection-function) + #'erc-sasl--v3-register-connection) + (remove-function (local 'erc-v3--subcmd-LS-function) + #'erc-sasl--v3-subcmd-LS) + (remove-function (local 'erc-v3--subcmd-ACK-function) + #'erc-sasl--v3-subcmd-ACK))) + (erc--set-up-response-function 903 erc-sasl-mode ; success + :override #'erc-sasl--v3-server-903) + (erc--set-up-response-function 902 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 904 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed) + (erc--set-up-response-function 908 erc-sasl-mode ; err + :before #'erc-sasl--v3-finalize-failed)) + +(defun erc-sasl--v3-on-wantedp-init () + "Manage module `sasl'." + (when (erc--module-active-p 'sasl) + ;; Tell ERC to request this extension when advertised. + (cl-pushnew 'sasl erc-v3-extensions)) + (when (memq 'sasl erc-v3-extensions) + (cl-assert (erc--server-buffer-p)) + ;; This function is called on `erc-v3-mode' in the server buffer. + ;; It 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-sasl--v3-on-minor-mode nil t) + (cond (erc-sasl-mode (erc-sasl--v3-on-minor-mode)) ; already up, do se= tup + ((memq 'sasl erc-modules)) ; will run soon, hook will mark + (t (erc-sasl-mode +1))) ; fully managed by this module + t)) + +(defun erc-sasl--v3-subcmd-LS (inner cap) + "Validate mechanism for `erc-v3--sasl' object CAP. +Call INNER if everything checks out. Otherwise, display an error and +destroy the session." + (if (not (erc-v3--sasl-p cap)) + (funcall inner cap) + (cl-assert (null erc--target)) + (when (eq erc-v3--phase-CHECK (erc-v3--extension-phase cap)) + (unless erc-sasl-mode + (error "erc-v3--subcmd-LS: %s" cap)) + (let ((val (erc-v3--capability-val cap))) + (if (or (null val) (erc-sasl--mechanism-offered-p val)) + (funcall inner cap) + (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. +(defun erc-sasl--v3-subcmd-ACK (inner cap) + "Suspend negotiation for `erc-v3--capability' CAP and initiate sub-proto= col. +Call INNER if CAP is not `erc-v3--sasl' or authentication is already done." + (if (or (not (erc-v3--sasl-p cap)) (erc-v3--sasl-done-cmd cap)) + (funcall inner 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) + ;; 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)))))) + +(defun erc-sasl--v3-register-connection (inner) + "Call INNER with `erc-session-password' and `erc-session-username' bound= ." + ;; 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))) + (funcall inner))) + +;; 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. +(defun erc-sasl--v3-server-903 (&rest _) + "Run \"CAP\" finalizer to conclude capability negotiation. +When `erc-sasl-mode' is the symbol `v3', call DEFAULT 903 handler with +PROC and PARSED." + (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))) + (setf (erc-v3--sasl-done-cmd cap) "903") + (erc-v3--consider-answered) + (erc-v3--finish-negotiating))) + nil) + +(defun erc-sasl--v3-finalize-failed (_ parsed) + "Record activation as failed and disable mode if enabled." + (let ((cap (erc-v3--find-capability-by-key 'sasl))) + (cl-assert cap) + (setf (erc-v3--sasl-done-cmd cap) (erc-response.command parsed)) + (erc-v3--ensure-disabled (list cap)) + (erc-v3--transition cap erc-v3--event-wERR))) + + (provide 'erc-sasl) ;;; erc-sasl.el ends here ;; diff --git a/lisp/erc/erc-v3.el b/lisp/erc/erc-v3.el new file mode 100644 index 00000000000..3153e67cf67 --- /dev/null +++ b/lisp/erc/erc-v3.el @@ -0,0 +1,2374 @@ +;;; 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) + +(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 (SUBCMD-SYM . CAP) for current round of ACK/NA= Ks." + :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 + +;; This module revolves around the `erc-v3--extension' "object," which +;; serves as the value of an extension's active minor-mode variable in +;; all buffers of a session. Even though ERC only enables a minor mode +;; after the server confirms support, the extension's object's begins +;; life long before that, on initial `erc-v3-mode' activation in the +;; server buffer. ERC looks to each object's `initp' slot to decide +;; whether to attempt to enable it, which, for a capability, means +;; requesting it. +(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) 'ACK) + ((eq e erc-v3--event-sNAK) '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 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)) + +(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 \"initform\" for the +resulting class's `aliases' slot. And in doing so, ensure each alias +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 extensions, like +`draft/my-cap' and `my-cap'. Finally, in a similar manner, add any +other keyword pairs in OPTS matching existing slots to the superclass' +`:include' form as well. + +Other than the struct type, 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 +have it activate 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. Beyond that, 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 `erc--restore-initialize-priors' +ineffective -- though it can also run later if triggered by a \"CAP +NEW\". Expect contributors to know that since modules depended on by an +extension are reactivated upon reconnect, their hooks can serve as a +convenient place to wrangle persistent data. + +\(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)) + +;; As mentioned, each extension is a minor mode whose mode variable is +;; the session's instance of the `erc-v3--extension'-derived struct of +;; the same name, such as `erc-v3--cap-notify'. During target-buffer +;; setup, this module copies over each extension's minor mode variable +;; from the server buffer. The values themselves are shared (`eq'). +(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'. For each +member, attempt to load an associated \"erc-\" prefixed library. Next, +call the constructor of every non-parent type appearing in the list +`cl-struct-erc-v3--extension-tags'. If the `initp' slot of the +resulting instance is non-nil, mark the extension as \"wanted\", meaning +ERC will request it if advertised by the server. Finally, save these +instances in the `objects' slot of the `erc-v3--caps' for this session." + (cl-assert (null erc--target)) + ;; Bind `erc-v3-extensions' for constructors to modify in special + ;; cases via their `initp' slot. See SASL for an example. + (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." + ((unless erc--target + (pcase erc-tags-format + ('legacy + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 will be incompatible with an `erc-tags-format' value = of" + " `legacy' in a future release. Please update your code.")) + ((or 'warn 'overridable) + (erc--warn-once-before-connect 'erc-v3-mode + "Module v3 has changed the format of the `erc-response' slot" + " for this session to an alist of (SYMBOL . STRING-OR-NIL)."))) + (add-function :override (local 'erc--parse-message-tags-function) + #'erc-v3--parse-message-tags '((depth . 50))) + (add-function :before (local 'erc--register-connection-function) + #'erc-v3--register-connection '((depth . 45)))) + (add-function :filter-args (local 'erc--server-send-function) + #'erc-v3--message-tags-server-send '((depth . 50))) + (add-function :override (local 'erc--partition-prefixed-names-function) + #'erc-v3--partition-prefixed-names '((depth . 50))) + (erc--add-response-function 005 :after #'erc-v3--server-005) + (erc--add-response-function 353 :around #'erc-v3--server-353) + (erc--add-response-function 366 :before #'erc-v3--server-366) + (erc--add-response-function 900 :override #'erc-v3--server-900) + (erc--add-response-function CAP :override #'erc-v3--server-CAP) + ;; Retain away reason or empty string in `erc-server-user-info'. + (cl-pushnew 'v3 (alist-get erc--sui-key-away erc--sui-keys)) + (if erc--target + (erc-v3--activate-module-for-target) + (erc-v3--activate-module))) + ;; XXX tearing this down properly is likely not worth doing because it + ;; requires syncing with the server. It's much easier to destroy the + ;; session and reconnect. To make this work, you'd have to REQ -foo + ;; all extensions and wait until they're all ACK'd before finishing. + ((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."))) + ;; Since this is a local module, set the mode var back to t. + (setq erc-v3-mode t) + ;; Things that would be torn down were that supported. + (unless 'inhibited + (setf (alist-get erc--sui-key-away erc--sui-keys) + (delq 'v3 (alist-get erc--sui-key-away erc--sui-keys))) + (remove-function (local 'erc--server-send-function) + #'erc-v3--message-tags-server-send) + (remove-function (local 'erc--parse-message-tags-function) + #'erc-v3--parse-message-tags) + (remove-function (local 'erc--partition-prefixed-names-function) + #'erc-v3--partition-prefixed-names) + (remove-function (local 'erc--register-connection-function) + #'erc-v3--register-connection) + (erc--remove-response-function 005 #'erc-v3--server-005) + (erc--remove-response-function 353 #'erc-v3--server-353) + (erc--remove-response-function 366 #'erc-v3--server-366) + (erc--remove-response-function 900 #'erc-v3--server-900) + (erc--remove-response-function CAP #'erc-v3--server-CAP))) + localp) + +;; To profile the negotiation sequence, put a `profiler-start' here and +;; a `profiler-stop' in `erc-v3--finish-negotiating'. +(defun erc-v3--register-connection () + "Start capability negotiation with server when ERC-V3-MODE is non-nil." + (erc-server-send "CAP LS 302")) + +(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 ((cap (pop (erc-v3--caps-queue-out erc-v3--caps)))) + (cl-assert (eq erc-v3--phase-QOUT (erc-v3--extension-phase cap))) + (when (eq erc-v3--phase-SEND (erc-v3--transition cap erc-v3--event-p= OUT)) + (push (concat (and (erc-v3--pending-negated-p cap) "-") + (symbol-name (erc-v3--capability-key cap))) + todo))) + (while todo + (erc-server-send (format "CAP REQ :%s" (string-join (take 10 todo) "= "))) + (setq todo (nthcdr 10 todo)))) + (erc-v3--run-timer erc-v3--event-pERR erc-v3--request-timeout-seconds)) + +(defun erc-v3--run-subcmd (key subcmd) + "Run \"CAP\" SUBCMD handler for capability's 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 (erc-v3--subcmd2handler subcmd) 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 subcmd))) + +(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. +(defun erc-v3--server-CAP (_proc parsed) + "Handle a subcommand for \"CAP\" response PARSED and return nil. +Always send queued requests or, if all have been answered, a \"CAP +END\", but only during connection registration." + (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 subcmd)))) + (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 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. +(defvar erc-v3--subcmd-LS-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP LS\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NEW-function #'erc-v3--ensure-deps + "Function to visit a single \"CAP NEW\" arg as an`erc-v3--capability'.") + +(defvar erc-v3--subcmd-DEL-function #'erc-v3--subcmd-DEL + "Function to visit a single \"CAP DEL\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-ACK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP ACK\" arg as an `erc-v3--capability'.") + +(defvar erc-v3--subcmd-NAK-function #'erc-v3--trigger-event-pIN + "Function to visit a single \"CAP NAK\" arg as an `erc-v3--capability'.") + +(defun erc-v3--subcmd-DEL (capability) + "Handle a \"CAP DEL\" response for `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-sDEL)) + +(defun erc-v3--trigger-event-pIN (capability) + "Apply `erc-v3--event-pIN' event to `erc-v3--capability' CAPABILITY." + (erc-v3--transition capability erc-v3--event-pIN)) + + +;;;; Subcommand helpers + +(defun erc-v3--subcmd2handler (subcmd) + "Return handler function associated with \"CAP\" SUBCMD symbol." + (pcase-exhaustive subcmd + ('LS erc-v3--subcmd-LS-function) + ('NEW erc-v3--subcmd-NEW-function) + ('DEL erc-v3--subcmd-DEL-function) + ('ACK erc-v3--subcmd-ACK-function) + ('NAK erc-v3--subcmd-NAK-function))) + +(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'.") + +;; TODO also print enabled non-caps, like WHOX and MONITOR. +(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, 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 (erc-v3--subcmd2handler (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)))= ))) + + +;;;; ISUPPORT-based extensions + +;; This is only for simple, old-school extensions associated with a +;; single parameter whose presence advertises support. Likely useless +;; for capabilities, like `chathistory', that use ISUPPORT parameters +;; for other purposes. + +(defvar erc-v3--isupport-params + `((WHOX whox ,#'erc-v3--on-isupport-param) + (MONITOR monitor ,#'erc-v3--monitor-on-isupport-param))) + +(defun 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--event-s005)) + (unless (eq erc-v3--phase-LOG (erc-v3--ensure-deps extension)) + (erc-v3--ensure-enabled (list extension))))) + +(defun erc-v3--server-005 (&rest _) + "Run code for params in `erc-v3--isupport-params' in server buffer." + (pcase-dolist (`(,param ,canon ,handler) erc-v3--isupport-params) + (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 handler cap (car item) (cdr item)))) + nil) + + +;;;; 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 + (erc--set-up-response-function 352 erc-v3--multi-prefix + :override #'erc-v3--server-352)) + +(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 + (seq-doseq (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--update-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 + :info info + :account account)))) + +;; This applies to basic /WHO #chan, etc. Automated WHOs sent by this +;; module are of the WHOX variety. +(defun erc-v3--server-352 (_ parsed) + "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 (erc--tags-get 'msgid tags))) + (puthash 'erc--msgid found erc--msg-props))) + +(defun erc-v3--parse-message-tags (raw) + "Parse RAW string into an alist of symbol keys and string values. +Assume client code interacting with the returned alist will have +interned the keys they care about if only by virtue of their inclusion +as literals in the program text. Only dedupe tags with known keys. Use +uninterned symbols for keys not already interned." + (if (eq erc-tags-format 'legacy) + (cl-call-next-method) + (let (tags) + (dolist (part (split-string raw ";") (nreverse tags)) + (let* ((pos (string-search "=3D" part)) + (name (if pos (substring part 0 pos) part)) + (key (and (not (string-empty-p name)) + (or (intern-soft name) (make-symbol name))))) + ;; Clobber existing items for known tags. + (when key + (setf (alist-get key tags) ; could use string=3D for unknown + (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) + ;; Account for differing tag formats. + (let* ((raw-value (or (car-safe (cdr tag)) (cdr tag))) + (val (and raw-value (not (string-empty-p raw-value)) + (encode-coding-string + (erc-v3--message-tags-escape-tag-value raw-value) + 'utf-8)))) + (push (concat (if (symbolp (car tag)) + (symbol-name (car tag)) + (car tag)) + (and val "=3D") val) + parts))) + (let ((data (string-join (nreverse parts) ";"))) + (when (> (string-bytes data) 4094) + (error "Max allowed tags size exceeded: %d" (string-bytes data))) + (concat "@" data " ")))) + +(defvar erc-v3--unescaped-client-tags nil + "Client tags for current outgoing request.") + +(defun erc-v3--message-tags-server-send (args) + "Return ARGS, maybe prepending formatted client tags to the first." + (cons (if erc-v3--unescaped-client-tags + (concat (erc-v3--merge-client-tags erc-v3--unescaped-client-ta= gs) + (car args)) + (car args)) + (cdr args))) + + +;;;; 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))) + ;; Depth 60 to favor being deeper/closer to innermost/default + (add-function :around (local 'erc--insert-line-function) + #'erc-v3--server-time-insert-line '((depth . 60)))) + (remove-function (local 'erc--current-time-pair-function) + #'erc-v3--current-time-pair) + (remove-function (local 'erc--insert-line-function) + #'erc-v3--server-time-insert-line) + (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))) + +(defun erc-v3--server-time-insert-line (orig message) + "Call ORIG, arranging to insert a late-arriving MESSAGE earlier in buffe= r." + (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 + (funcall orig message))) + (unless (or erc-v3--server-time-display-nested-p + (erc--check-msg-prop 'erc--msg 'datestamp)) + (setq erc-v3--server-time-display-latest current)) + (funcall orig message))) + +(defun erc-v3--current-time-pair () + "Return a Lisp time from tag if `erc--parsed-response' is non-nil." + (and 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-message-external-functio= n) + #'erc-v3--echo-message-send-external '((depth . 50))) + (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-message-external-function) + #'erc-v3--echo-message-send-external) + (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)) + +(defun erc-v3--echo-message-send-external (line force) + "Send LINE as \"PRIVMSG\" to `erc-target' sans insertion, possibly FORCE= 'd." + (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 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 + (ensure-list erc-pre-send-function= s)))) + (apply orig args)))) + + +;;;; Extension: WHOX + +;; This extension could probably be moved to `erc-v3-extensions' to make +;; it optional, but it seems pretty necessary for full account support. +;; It stood apart for decades before becoming an official extension [1]. +;; The older specs appear to be more extensive [2], and some servers +;; apparently still adhere to these variants. 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.")) + (erc--set-up-response-function 263 erc-v3--whox + :override #'erc-v3--server-263) + ;; It's believed that when `erc-server-flood-queue' is empty, + ;; requesting WHOX info on `erc-join-hook' may create user records on + ;; 354 instead of 353, which could interfere with this module's + ;; simulated 353 behavior and `erc-channel-members-changed-hook'. + (erc--set-up-response-function 366 erc-v3--whox + :after #'erc-v3--whox-enqueue-from-target-arg) + (erc--set-up-response-function 315 erc-v3--whox + :before #'erc-v3--whox-handle-315)) + +(cl-defstruct erc-v3--whox-request + "WHOX request object." + (token (cl-callf (lambda (v) (% (1+ v) 1024)) ; why not most-positive-fi= xnum? + (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, ensuring initial \"t\" field." + (pcase-exhaustive request + ((cl-struct erc-v3--whox-request token target fields) + (erc-server-send + (concat "WHO " target " %" (and (/=3D ?t (aref fields 0)) "t") + fields "," (number-to-string token)) + 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 + "Called on 354 with channel-user downcased nick and record just updated.= ") + +(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." + (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)) + ;; Include empty values for removal if applicable. + (away-cell (list erc--sui-key-away)) + (info (list away-cell))) + ;; 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) + (let ((erc--sui-update-p t) + (erc--current-channel-member-last-message-time-p t) + (time (and idle (time-subtract (time-convert nil 'integer) + (string-to-number idle)))) + (cmem (erc-get-channel-user nick))) + (if cmem + (progn + (when (eq away ?G) + (unless (erc--sui-get (car cmem) erc--sui-key-away) + (setcdr away-cell ""))) + (erc--update-current-channel-member + cmem status time nick host login full-name info account)) + (erc--create-current-channel-member + nick status time nick host login full-name info account) + (setq cmem (erc-get-channel-member nick))) + (run-hook-with-args 'erc-v3--whox-on-354-functions nick cmem))))) + +(defvar erc-v3--whox-on-join-function #'erc-v3--whox-cuhnflar) + +(defun erc-v3--whox-enqueue-from-target-arg (_ parsed) + "Schedule request in channel named by second arg of PARSED response." + (erc-with-buffer ((cadr (erc-response.command-args parsed))) + (unless (cl-find (erc-target) (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-target) + (funcall erc-v3--whox-on-join-function))) + nil) + +(defun erc-v3--whox-cuhnflar () + "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 + (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))))))) + +(defvar erc-v3--whox-target-done-functions nil) + +;; An internal method could be used instead, but it would need to take +;; care to avoid running 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))) + (if (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)) + ;; Seems `target' may be an asterisk if a 263 has just arrived. + (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))))) + (erc-with-buffer (target) + (run-hook-with-args 'erc-v3--whox-target-done-functions parsed)))) + 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'.") + +;; Without labeled-response, there's no way to tell which request was +;; the offending one. Hopefully, restricting their issuance to serial +;; round trips reduces the likelihood of mistaken identity. +(defun erc-v3--server-263 (_proc parsed) + "Handle a PARSED 263 response for a query made by `erc-v3--whox'. +Schedule another attempt `erc-v3--whox-penalty' seconds in the future. +Then double `erc-v3--whox-penalty'." + (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 + +;; TODO add tests for this extension! + +(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) + +(defun erc-v3--monitor-on-isupport-param (ext key value) + "Remember KEY and VALUE for \"MONITOR\" EXT and enable." + (cl-assert (eq key 'MONITOR)) + (cl-assert (erc-v3--monitor-p ext)) + (setf (erc-v3--monitor-max ext) + (or (and value (string-to-number (car value))) most-positive-fixnu= m)) + (erc-v3--on-isupport-param ext key value)) + +(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'.") + +(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 (&rest _) + (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) + (funcall erc-v3--whox-on-join-function)) + (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 + (erc--set-up-response-function JOIN erc-v3--extended-join + :override #'erc-v3--server-JOIN) + (if erc-v3--extended-join + (if 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 unless known." + (unless erc--channel-modes + (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.") + +(defun erc-v3--join-with-display-context (channel) + "Join CHANNEL with relevant display context." + (let ((erc--display-context (erc--server-determine-join-display-context + channel erc--display-context))) + (save-excursion (erc--open-target channel)))) + +(defun erc-v3--server-JOIN (_ parsed) + "Handle a PARSED \"JOIN\" response containing extended syntax. +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-parse-user (erc-response.sender parsed)= )) + (account (and (not (string=3D account "*")) account)) + (nickp (erc-current-nick-p nick)) ; we are the ones joining + (buffer (if nickp + (erc-v3--join-with-display-context chnl) + (erc-get-buffer chnl erc-server-process)))) + (when (and (null buffer) + erc-v3--create-unknown-channel-buffer-when-others-join-p + (erc-channel-p chnl)) + (setq buffer (erc-v3--join-with-display-context 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 +;; currently lose their association to that user because account +;; info is not included in the displayed-message metadata. + +(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))) + +(defvar erc-v3--account-tag-fallback-handler-hooks + '( erc-server-PRIVMSG-functions erc-server-NOTICE-functions + erc-server-JOIN-functions erc-server-MODE-functions + erc-server-PART-functions erc-server-QUIT-functions + erc-server-NICK-functions erc-server-TOPIC-functions + erc-server-KICK-functions erc-server-TAGMSG-functions) + "Handler functions to update account info through if necessary. +Only used if `extended-join' and `account-notify' are missing.") + +(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 hook members 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))) + (dolist (fn erc-v3--account-tag-fallback-handler-hooks) + ;; Place *before* main handler so commands, like NICK, that + ;; refile the existing record under another name still work. + ;; Stick with the less reliable traditional response hooks + ;; here rather than the `erc--response-function' interface + ;; because this fallback scenario is likely rare. + (add-hook fn #'erc-v3--ensure-account -20 t))) + (dolist (fn erc-v3--account-tag-fallback-handler-hooks) + (remove-hook fn #'erc-v3--ensure-account t))))) + +(defun erc-v3--ensure-account (_ parsed) + "Update account info if PARSED response is typically sent by a user." + (when-let* ((tags (erc-response.tags parsed)) + (account (erc--tags-get 'account tags))) + (pcase-let + ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parse= d)))) + (erc-v3--update-account account nick login host))) + nil) + + +;;;; 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)) + (let ((erc--sui-update-p t)) + (erc-update-user-nick nick nil nil nil nil + `((,erc--sui-key-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. +Determine how to display message from TYPE, COMMAND, CODE, REST, PARSED." + (erc-display-message parsed (pcase type + ('NOTE 'notice) + ('WARN '(notice error)) + ('FAIL '(t notice error))) + (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) + + +;;;; 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. + +;; FIXME relocate this at the top of the file. +(defcustom erc-v3-simulated-names-message-size 200 + "Number of nicks displayed per simulated \"NAMES\" reply (353) message. +When the userhost-in-names extension is active, displaying a 353 line as +originally received tends to be distracting because many nick!user@host +tokens are wide enough that only a couple end up occupying each line, +depending on the window's dimensions. In large rooms, this can feel +like multiple pages of names scrolling by on end. + +This option attempts to replicate the feel of how ERC has traditionally +displayed 353 messages without the extension, that is, by only printing +the nick portion of each token and waiting until more than a few arrive +before displaying them, so more fit on a single line and in a single +formatted message. However, if the value is nil, ERC won't perform any +of this and will instead faithfully print the contents of each message +as received." + :package-version '(ERC . "5.7") + :type '(choice (const nil) + natnum)) + +(defvar erc-message-english-s353-v3 "Users on %c (%d): %u" + "English `erc-format-message' template for key `s353-v3'.") + +(defvar-local erc-v3--channel-new-member-names nil + "Temporary hash table containing a subset of `erc-channel-members'. +Count is at most `erc-v3-simulated-names-message-size'.") + +(defun erc-v3--partition-prefixed-names (name) + "Return a list of (STATUS NICK LOGIN HOST) from NAME. +Act like `erc--partition-prefixed-names' but handle multiple +status-prefix chars before NAME and return LOGIN and HOST as well." + (cl-assert erc-v3-mode) + (pcase-let* + ((statuses (erc--parsed-prefix-statuses (erc--parsed-prefix))) + (`(,status ,_ ,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)))) + `(,status ,nick ,login ,host)))) + +(declare-function erc-button--deemphasize-plebs "erc-button" (nick-object)) + +(defun erc-v3--print-names (parsed) + "Insert aggregated PARSED implicit \"NAMES\" response into current CHANN= EL. +Expect NAMES to be a list of statusted nicks." + (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")) + (let* ((sorted (sort (hash-table-values erc-v3--channel-new-member-names) + (lambda (a b) + (let ((status-a (erc-channel-user-status (cdr a))) + (status-b (erc-channel-user-status (cdr b))= )) + (if (=3D status-a status-b) + (string< (erc-downcase + (erc-server-user-nickname (car a)= )) + (erc-downcase + (erc-server-user-nickname (car b)= ))) + (> status-a status-b)))))) ; bigger status fi= rst + (names (mapcar (pcase-lambda (`(,user . ,cusr)) + (concat + (and (not (zerop (erc-channel-user-status cusr)= )) + (erc-v3--format-prefix cusr)) + (erc-server-user-nickname user))) + sorted))) + (erc-display-message parsed 'notice (current-buffer) + 's353-v3 + ?c (erc-target) + ?d (hash-table-count erc-channel-users) + ?u (string-join names " "))) + (remove-function (local 'erc-button--modify-nick-function) + #'erc-button--deemphasize-plebs)) + +;; 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--process-new-member-names (parsed forcep) + "Call `erc-channel-receive-names' with a temporary new-members table. +Afterwards, update the actual table from the temporary one. Initialize +`erc-v3--channel-new-member-names' if needed, and add new members here +as well. With FORCEP or if `erc-v3--channel-new-member-names' is larger +than `erc-v3-simulated-names-message-size', call `erc-v3--print-names' +with PARSED." + (unless erc-v3--channel-new-member-names + (setq erc-v3--channel-new-member-names (make-hash-table :test #'equal)= )) + (let ((actual (or erc-channel-new-member-names + (erc-channel-begin-receiving-names))) + (erc-channel-new-member-names (make-hash-table :test #'equal))) + (unless forcep ; 366 + (erc-channel-receive-names (erc-response.contents parsed))) + (maphash (lambda (key value) + (cl-assert (eq value t)) + (puthash key value actual) + (puthash key (gethash key erc-channel-members) + erc-v3--channel-new-member-names)) + erc-channel-new-member-names)) + (when (or forcep (> (hash-table-count erc-v3--channel-new-member-names) + erc-v3-simulated-names-message-size)) + (erc-v3--print-names parsed) + (clrhash erc-v3--channel-new-member-names))) + +;; The reason names aren't merely collected here and only later printed +;; in the 366 handler is because giant rooms with many thousands of +;; names (typically encountered when dealing with a bridge to a non-IRC +;; protocol) would otherwise sit for minutes without any feedback. +(defun erc-v3--server-353 (default proc parsed) + "Maybe override DEFAULT \"RPL_NAMREPLY\" handler. +If `erc-v3-simulated-names-message-size' is non-nil, display a simulated +message containing truncated names. Otherwise, call DEFAULT with PROC +and PARSED." + (if (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((nth 2 (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed nil) + nil) + (funcall default proc parsed))) + +(defun erc-v3--server-366 (proc parsed) + "Maybe run `erc-v3--process-new-member-names'. +If necessary, display a simulated 353 message in PROC's target buffer +for the PARSED 366 response." + ;; :test.libera.chat 366 someNick #emacs :End of /NAMES list + (when (and erc-v3-simulated-names-message-size + (or erc-v3--userhost-in-names erc-v3--multi-prefix)) + (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc) + (erc-v3--process-new-member-names parsed 'forcep)))) + +;; These last two handlers are account aware. + +(defun erc-v3--server-900 (_proc parsed) + "Given `erc-response' PARSED, mark this session's user as being logged i= n." + (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))) + (erc--format-channel-membership-prefix cusr lettersp 'multip))) + + +(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 69667897b88..2c30658a9a5 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2406,6 +2406,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..f41901e0108 --- /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)= )) + "a: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))) + "a: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))) + "a: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..de388590571 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3-sasl.el @@ -0,0 +1,200 @@ +;;; 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)) + (defvar erc-v3--sasl) + (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..793e259a492 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-v3.el @@ -0,0 +1,588 @@ +;;; 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")) + (funcall expect 10 "*** Users on #spam (215): ~@Q @D") + (funcall expect 10 "*** Users on #spam (436): abErGAVeNny") + ;; Mike appears before joe because @ is more important than +. + (funcall expect 10 "*** Users on #spam (461): @mike") + (should (equal (get-text-property (- (match-end 0) (length "mike")) + '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)) + "a: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)) + "a: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 + '((foonet "#chan" "#foo" "#bar" "#baz" "#spam"))) + (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")) + + (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"))) + + (with-current-buffer "foonet" + (funcall expect 5 "Rate limit exceeded retrieving user data")) + + ;; 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-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"))) + (erc--sui-keys `((,erc--sui-key-away t))) + (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--sui-get user-fool erc--sui-key-away)) + (erc-d-t-wait-for 5 "Fool sets AWAY msg" + (equal (erc--sui-get user-fool erc--sui-key-away) "afk")) + (erc-d-t-wait-for 5 "Fool clears AWAY msg" + (not (erc--sui-get user-fool erc--sui-key-away))))) + + (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 6e3908d5423..440c15f0dc3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -3847,6 +3847,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..511e4a7cf0f --- /dev/null +++ b/test/lisp/erc/erc-v3-tests.el @@ -0,0 +1,1463 @@ +;;; 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))))) + + +(define-erc-response-handler (ERCTEST) + "ERCTEST" nil (erc-display-error-notice parsed + (erc-response.contents parsed))) + +;; FIXME move this and the tag stuff to erc-tests.el or a new +;; erc-backend-tests.el. +(ert-deftest erc--response-function () + (erc-tests-common-make-server-buf) + + (let* ((calls ()) + ;; Putting this lambda inline in the setup-fn instead of as its + ;; own binding breaks removal functionality on Emacs <29! + (fn (lambda (_ parsed) + (push (erc-response.command parsed) calls))) + (setup-fn (lambda (enablep) + (erc--set-up-response-function ERCTEST enablep + :override fn)))) + + ;; Simulate a minor-mode being enabled (the most obvious intended + ;; use case). Its body overrides the default handler locally. + (funcall setup-fn t) + + ;; Simulate another connection. + (with-current-buffer (erc-tests-common-make-server-buf "barnet") + + ;; This other server buffer is unaffected, so the default handler + ;; runs and displays its message. + (erc-tests-common-simulate-line ":irc.barnet.org ERCTEST dummy :Foun= d") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (should-not calls) + + ;; No-op because other connection still using modified handler. + (should-not (erc--tidy-response-function 'erc-server-ERCTEST))) + + ;; Back in the overridden buffer, the default handler is suppressed. + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found= ") + (should (equal calls '("ERCTEST"))) + (goto-char (point-min)) + (should-not (search-forward "Found" nil t)) + (setq calls nil) + + ;; Disabling the minor mode, restores the default handler and removes + ;; the symbol property if necessary. + (funcall setup-fn nil) + (should-not (get 'erc-server-ERCTEST 'erc--response-function)) + (erc-tests-common-simulate-line ":irc.foonet.org ERCTEST tester :Found= ") + (goto-char (point-min)) + (should (search-forward "Found" nil t)) + (setq calls nil)) + + (erc-tests-common-kill-buffers)) + +(ert-deftest erc-get-tag () + ;; Legacy format. + (let ((ab1c-legacy '(("c") ("b" "1") ("a"))) + (ab?c-legacy '(("c") ("b" "") ("a")))) + (should (equal (erc-get-tag "a" ab1c-legacy) '("a"))) + (should (equal (erc-get-tag "b" ab1c-legacy) '("b" "1"))) + (should (equal (erc-get-tag "b" ab?c-legacy) '("b" ""))) + (should (equal (erc-get-tag "c" ab1c-legacy) '("c")))) + + ;; Native format + (let ((ab1c '((a) (b . "1") (c)))) + (should (equal (erc-get-tag 'a ab1c) '(a))) + (should (equal (erc-get-tag 'b ab1c) '(b . "1"))) + (should (equal (erc-get-tag 'c ab1c) '(c))))) + +(ert-deftest erc--tags-get () + (let ((tags (list (list "c") (list "b" "1") (list "a"))) + (erc-tags-format 'legacy)) + (should (equal (setf (erc--tags-get "c" tags) "2") "2")) + (should (equal tags '(("c" "2") ("b" "1") ("a"))))) + + (let ((erc-tags-format nil) + (r (make-erc-response :tags (list (list 'a) (cons 'b "1") (list 'c= ))))) + (should (equal (setf (erc--tags-get 'c (erc-response.tags r)) "2") "2"= )) + (should (equal (erc-response.tags r) '((a) (b . "1") (c . "2")))) + (should (equal (setf (erc--tags-get 'd (erc-response.tags r)) "3") "3"= )) + (should (equal (erc-response.tags r) + '((d . "3") (a) (b . "1") (c . "2")))))) + +(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-tags-format nil) + (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 ((format "Description: %S" + (list :input input :atoms atoms :m m))) + + (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)))))))) + +;; These cases are already covered by the preceding test. They're +;; presented here in a more minimal form for easier intuiting. +(ert-deftest erc-v3--parse-message-tags () + (let ((erc-tags-format nil)) + (should (equal nil (erc-v3--parse-message-tags ""))) + (should (equal '((a)) (erc-v3--parse-message-tags "a"))) + + (should (equal '((a . "1") (b) (c)) + (erc-v3--parse-message-tags "a=3D1;b;c"))) + (should (equal '((a) (b . "1") (c)) + (erc-v3--parse-message-tags "a;b=3D1;c"))) + (should (equal '((a) (b) (c . "1")) + (erc-v3--parse-message-tags "a;b;c=3D1"))) + + (should (equal '((a . "1")) (erc-v3--parse-message-tags "a;a=3D1"))) + (should (equal '((a . "2")) (erc-v3--parse-message-tags "a=3D1;a=3D2")= )) + (should (equal '((a)) (erc-v3--parse-message-tags "a=3D1;a"))))) + +(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 () + (should (equal "@a=3D1;b " (erc-v3--merge-client-tags '((a . "1") (b))))) + (should (equal "@a=3D1;b " (erc-v3--merge-client-tags '(("a" "1") ("b"))= ))) + + (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)) + +;; 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* ((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 calls)))) + + (erc-v3-mode +1) + + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (push (intern (format "bef-%s" + (erc-v3--extension-canon o))) + calls)) + '((name . ls-before) (depth . 10))) + + ;; Methods can inhibit a request by altering the `initp' slot. + (add-function :before (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (pcase o + ((cl-struct erc-v3--test/a) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (push 'a calls)) + ;; Ignore test/b + ((cl-struct erc-v3--test/c) + (should (eq erc-v3--phase-CHECK + (erc-v3--extension-phase o))) + (erc-v3--transition o erc-v3--event-wOFF) + (push 'c calls)))) + '((name . ls-ac) (depth . 20))) + + (ert-info ("Handlers deferred on continuation line") + (erc-tests-common-simulate-line + ":irc.example.org CAP * LS * :test/a test/c") + (should-not 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 calls '(("CAP REQ :test/a") + bef-test/b c bef-test/c a bef-test/a))))) + + (erc-tests-common-kill-buffers)) + +;; 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))) + (subcmd-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) + + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (or (erc-v3--test/a-p o) (erc-v3--test/c-p o)) + (should (eq erc-v3--phase-UP + (erc-v3--extension-phase o))) + (should (erc-v3--wanted-p o)) + (push (erc-v3--extension-canon o) subcmd-calls)))) + + (add-function :after (local 'erc-v3--subcmd-NAK-function) + (lambda (o) + (when (erc-v3--test/b-p 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) subcmd-calls)))) + + (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 subcmd-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 subcmd-calls) + (should-not calls) + (should-not erc-v3--test/c) ; still missing reply for test/b + (should-not subcmd-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 subcmd-calls '(test/c test/a test/b))))) + + (erc-tests-common-kill-buffers)) + +;; 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)) + (subcmd-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) + + (add-function :after (local 'erc-v3--subcmd-ACK-function) + (lambda (o) + (when (erc-v3--test/a-p o) + (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) subcmd-calls)))) + + + (add-function :after (local 'erc-v3--subcmd-LS-function) + (lambda (o) + (when (erc-v3--test/b-p o) + (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) subcmd-calls)))) + + (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 subcmd-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 subcmd-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 subcmd-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)) + ;; 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* ((cmem (gethash "hugle" erc-channel-users)) + (time (erc-channel-user-last-message-time (cdr cmem)))) + (should (time-less-p time (time-subtract (current-time) 90))) + (should-not (time-less-p time (time-subtract (current-time) 91))) + (should (equal cmem (cons `[erc-server-user + "hugle" "fsf/person/hugle" "~hugle" + "F. S. Hugle" nil "fshugle" + ,(list (current-buffer))] + `[erc-channel-user 5 ,time])))))))) + +;;; 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 bf529ac238f..3d3356c4695 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -787,6 +787,19 @@ 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. +(defun erc-scenarios-common--nick-at-point (point) + "Echo \"a:<account> <login>@<host> <quoted-full-name>\" for nick at POIN= T." + (interactive (list (point))) + (when-let* ((nick (car (get-text-property point 'erc-data))) + (cmem (erc-get-channel-member nick))) + (message "%s" + (string-join (delete nil (erc--format-user-parts (car cmem) + (cdr cmem) n= il)) + " ")))) + (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..447cb8d6311 --- /dev/null +++ b/test/lisp/erc/resources/v3/cap-notify/basic.eld @@ -0,0 +1,67 @@ +;; -*- 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") + ;; Note that this was captured from an older ZNC. + ;; Version 1.10.1 sends each NEW on a separate line. + (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..9f7b97d9cdc --- /dev/null +++ b/test/lisp/erc/resources/v3/userhost-in-names/basic.eld @@ -0,0 +1,59 @@ +;;; -*- 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 :NCmRkf0fr Fureol UnbF tnpxf = Pvrpubz EbuvgF5612 Gboov s0erfg qrcrpur @Pehvpxl +SnypbaFcl CbjnOnatn @Fbep= rere ~@Q qvfp @F @T svmv Xunvqn GungYhexre bf|julm Tnabax Natrym qraavf| Fv= pnevhf sernxll85 XreilA538 +Ibebabv sbnzl pngryvln- @Fnghea +zrro @iyvrqry = [Q-Pbl]Nqnz tnmol MG +Uvqqra Qravn Fhpul ^_^ Qravn- fzbxr___ nagbvar Cvg Av= XnA fBqNtvEY_ PurrfrFbqnChapu Fgej Ybeq255 @XvyynU YnqlCrneynpr QnfOenva Fh= agbc Lbevpx_ Avxlevn JneCvtf PbzchgreGrpu") + (0.0 ":irc.example.org 353 tester =3D #spam :znm nrovna zntznhf3 ubsszna-= @D @fuebhq +fyht Sryrabi rivgn Cnenobyvn pp ZvYYvLrgPUv Qvqqy _pp Oynpx6Pe= bj xvenan Gvzbgrhf ryrzragny_ fglyr pbbyqhqr Lbevpx Xbentt _XnfmcvE_ fnoh f= gribb [OmF]5cUvAkK +Qrzc Cbeeb mollitia repellendus iusto Nihil asperiores = aliquid dolorum blanditiis excepturi magni praesentium quibusdam officiis v= eritatis facilis eaque temporibus numquam Sequi ipsum quidem pariatur liber= o architecto perferendis occaecati minus") + (0.0 ":irc.example.org 353 tester =3D #spam :harum deserunt corporis aspe= rnatur deleniti Delectus maiores omnis alias voluptate laudantium magnam do= lorem itaque dolor veniam Voluptas Neque consequatur accusantium tempora ve= lit Natus laborum ipsam necessitatibus nostrum recusandae molestiae suscipi= t dignissimos Quisquam incidunt quis dolores laboriosam Corrupti voluptatem= molestias fugit voluptatibus tempore Consequuntur aNgELO FItZWALTER keEPer= ANtENor FaNg bIOndeLlO HERmIa dUMAinE") + (0.0 ":irc.example.org 353 tester =3D #spam :FauLCONBRIDGe aPOtHeCary COB= web bOURBon BAsSiAnUs CONsTabLE hUBERT aUdREy DarDAnIuS aNtIpHOLus ESCANes = ARtHUr sLEnDER CLAUdio GuIlDeNStERn dOnalbAIN cAssAndra GaLLus GArDiNEr anG= elica BaSseT ePILOgue EroS CoRnWaLL DaVy HumpHrEy corNeliuS BrItain CapHIS = ISABeLLA BOTTOM heCatE GriFFith flOrEnCE aRChIdAmUS derceTuS GuArD ArtEmIDO= RuS BoaTswAIn AemIlius heNRY joHn CiCero demetriUS FAstOLFE CHArMIan HosTeS= s AntIGOnUS foRtInbraS GrEY bUllEN") + (0.0 ":irc.example.org 353 tester =3D #spam :HeRalD boy BAssanIO cAmilLo = brAbaNTio GUArdsmaN gARdENeR DROMIO aEdiles CaPUTiUs hoRaTIo HOrneR Iden cL= Own ARAGON dOGBeRRy BaNQUo gaOLEr huntInGDon JuNO CORin cLaUdius CuRIo Cost= ARD CoLEvILlE gErAlD bUTcHEr HERMioNe PoLYDOre dOLabellA JAILer hoRtensiuS = bErTrAm CasSiO piers GOvErNOr graNDpRE caPtAIN EdWard GLEndOwEr CHAThaM eph= eSus FatheR AGUEchEeK hUGh hYmEN JUliUs GoWER AlbANY doCtOr aNNE AufiDiUs g= onZaLO hErBert bARnarDINE ARcHbiSHop") + (0.0 ":irc.example.org 353 tester =3D #spam :BIGOt CAdE gaDshIll armADo F= LEanCe BlANchE JulieT DiOMedeS cOnstancE caRDiNal cLeRK bORAchio DUchEsS cu= RAN SiMOn FLUTE CATEsby agamEMnON HElEnA HarCoURT JOAN JAne QUEeN dIANa caT= liNg AmieNs ChAtIllIon abErGAVeNny JamES gremiO crAb CAItHneSS bUTTs bRaNDo= N GENtLEmaN dAUGHTer dEnny adaM FLAMIniUS CaMbRIDGe cUrTiS FreDERicK BErKel= EY jULia JoSePh BRaCkeNBURY fRancIscA CoUrTeSAn CarlisLE FEnTOn AUVErgne we= StMInsTer GaRgraVe Minola hEro OwEN") + (0.0 ":irc.example.org 353 tester =3D #spam :mEtELLUS aNGuS caSca HARrY k= AtHeRIne glouCEsteR ADRiAN dionYZA coUNt BouLT AutOlyCUS cASsiUs grAvEdiGge= R BUSHy arRaGon ARVIRagus cLEoMIneS FALSTAfF GobBO emMaNUel iRAS CITIZeN cA= Dwal ClituS bOUrCHIER alARbUs ChaNcELloR cAlPHuRniA eLbow franciS CAmpEIUS = derBY Jamy aLICe DOrcaS FeEBLe DOugLAs BeneDIck SICIniuS GRuMIO aMbASSAdor = EDMUND adRiAno aPeMAnTus AUMerLe grEgoRY chriSTopHER HeleNus ciMBer berOwne= ANdrew GlANSDAlE fABian ANThoNy") + (0.0 ":irc.example.org 353 tester =3D #spam :cLeon FErDinaND jaqUES FLOrI= zeL FrOTh eleanOr FlaViUs hume DOn clarEncE bagot haRRy HolOfERNes mAtthEw = GENTlEwoMAN Iago adRIaNa ChIRoN egEON BUrguNdY BaPtIsTA jEssiCA CERES ChOru= s TEArSheEt AleXAs cOrIOLanUS enobaRBUs HOSt Boyet dUKe nIck ANdRoMacHE dau= PhIn fluELLeN BolinGbrOkE eScaLUs dECiUS DEBoys girl eARL FRanCIs DORSet Ve= lUTuS stANLey bLUNT cANtERbURy EDGar DiCk CelIA AnTiOchus CoRdeliA anDronIc= US gArTer HAstinGS EGLAMOur DenniS") + (0.0 ":irc.example.org 353 tester =3D #spam :ELY DUkE hELEN GUIlDFOrd fRI= aR IRiS gURNEY cHArLes GOUgh BeLcH fRaNce AaRON erPInGHaM eXTon CAPUleT hel= icAnuS aeMeLiA EXeteR") + ;; These have logins and hostnames + (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..5d09e71c539 --- /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")) + +((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.")) + +((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-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.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0018-WIP-Add-erc-names-module.patch From 7f3eb954c94dcbe3952dedb9120042bc3caa6774 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 21 Aug 2021 07:54:03 -0700 Subject: [PATCH 18/18] [WIP] Add erc-names module ;; This module exists mostly for demonstration purposes, with the aim of ;; showing how incremental user-state updates can enhance the user ;; experience. * lisp/erc/erc-names.el: New file. * lisp/erc/erc.el (erc--cmd-NAMES-function): New variable. (erc--cmd-NAMES): New function containing the body of what was `erc-cmd-NAMES'. (erc-cmd-NAMES): Move body to `erc--cmd-NAMES' and defer to `erc--cmd-NAMES-function'. * test/lisp/erc/erc-scenarios-names.el: New file. * test/lisp/erc/resources/v3/no-implicit-names/reconnect-a.eld: New file. * test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.eld: New file. --- lisp/erc/erc-names.el | 353 ++++++++++++++++++ lisp/erc/erc.el | 12 +- test/lisp/erc/erc-scenarios-names.el | 125 +++++++ .../v3/no-implicit-names/reconnect-a.eld | 57 +++ .../v3/no-implicit-names/reconnect-b.eld | 45 +++ 5 files changed, 588 insertions(+), 4 deletions(-) create mode 100644 lisp/erc/erc-names.el create mode 100644 test/lisp/erc/erc-scenarios-names.el create mode 100644 test/lisp/erc/resources/v3/no-implicit-names/reconnect-a.eld create mode 100644 test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.eld diff --git a/lisp/erc/erc-names.el b/lisp/erc/erc-names.el new file mode 100644 index 00000000000..41ec1d23ffe --- /dev/null +++ b/lisp/erc/erc-names.el @@ -0,0 +1,353 @@ +;;; erc-names.el --- Tabular /NAMES 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 module replaces the /NAMES command for refreshing and displaying +;; a channel's membership rolls. Rather than contact the server, this +;; displays the rolling local state in a separate `tabulated-list' +;; buffer. To use it, add both `v3' and `names' to `erc-modules'. +;; Then, in a channel buffer, type /NAMES as you normally would. + +;;; Code: +(require 'erc-v3) +(require 'erc-button) +(require 'tabulated-list) + +(defgroup erc-names nil + "A \"passive\" IRCv3-based alternative to the /NAMES command." + :group 'erc) + +(defcustom erc-names-columns '( :nickname 15 :account 15 :userhost 25 + :full-name 20 :status 5 :last-active 15 + :away 20 :buffers 12) + "Column order and widths for tabulated list of channel members. +Cycle the module's mode or reconnect to see changes." + :group 'erc-names + :type '(plist :key-type symbol :value-type natnum)) + +(defcustom erc-names-display-action t + "How to display a buffer. +Value can be anything recognized by `display-buffer' for its ACTION +parameter." + :group 'erc-names + :package-version '(ERC . "5.7") + :type '(choice (const :tag "Always use/create other window" t) + (const :tag "Let `display-buffer' decide" nil) + (const :tag "Same window" (display-buffer-same-window + (inhibit-same-window . nil))) + (cons :tag "Action" + (choice function (repeat function)) + (alist :tag "Action arguments" + :key-type symbol + :value-type (sexp :tag "Value"))))) + +(defvar-local erc-names--channel-buffer nil + "The channel buffer associated with the tabulated list buffer.") + +(defvar-local erc-names--buffer nil + "The /NAMES buffer for the current channel, if any.") + +(defvar-local erc-names--table nil + "Cached indices and widths for tabulated-list \"descriptor\".") + +(defvar-local erc-names--mode-name-count nil + "String containing total number of people in chat room.") + +(defvar erc-names--mode-line-misc-info + '(erc-names--mode-name-count + ("<" (:propertize erc-names--mode-name-count face mode-line-emphasis) ">")) + "Head of `mode-line-misc-info' in `erc-names--major-mode' buffers.") + +(define-erc-module names nil + "Module providing \"passive\" /NAMES command for ERC." + ((if (erc--module-active-p 'v3) + (add-function :override (local 'erc--cmd-NAMES-function) + #'erc-names--cmd '((depth . 50))) + (unless erc--target + (erc-button--display-error-notice-with-keys + (current-buffer) + "Module `names' depends on module `v3'." + " Please add `v3' to `erc-modules' and reconnect.")) + (erc-names-mode -1))) + ((remove-function (local 'erc--cmd-NAMES-function) #'erc-names--cmd) + (kill-local-variable 'erc-names--buffer)) + localp) + +(defun erc-names--ensure-table () + "Create `erc-names--table' prototype for descriptor schema." + (unless erc-names--table + (setq erc-names--table (make-hash-table)) + (let ((counter -1) + (plist erc-names-columns)) + (while-let ((key (pop plist)) + (val (pop plist))) + (puthash key (cons (cl-incf counter) val) erc-names--table))))) + +(defun erc-names--make-table (&rest plist) + "Create unnamed struct instance from plist." + (let ((object (make-vector (hash-table-count erc-names--table) nil))) + (while-let ((key (pop plist)) + (val (pop plist))) + (aset object (car (gethash key erc-names--table)) val)) + object)) + +(defun erc-names--table-status (desc) + (aref desc (car (gethash :status erc-names--table)))) + +(defun erc-names--table-last-active (desc) + (aref desc (car (gethash :last-active erc-names--table)))) + +(defun erc-names--table-nickname (desc) + (aref desc (car (gethash :nickname erc-names--table)))) + +(defun erc-names--get-width (column) + (cdr (gethash column erc-names--table))) + +(defun erc-names--status-get (desc) + (let ((status (erc-names--table-status desc))) + (if (equal status "") 5 (seq-position "qaohv" (aref (car status) 0))))) + +(defun erc-names--status-less-p (a b) + "Return non-nil if A has a lower status than B." + (< (erc-names--status-get (cadr a)) (erc-names--status-get (cadr b)))) + +(defun erc-names--last-active-get (desc) + (plist-get (cdr-safe (erc-names--table-last-active desc)) 'erc-names--ts)) + +(defun erc-names--last-active-less-p (a b) + "Return non-nil if A has an older time stamp than B." + (let ((a (erc-names--last-active-get (cadr a))) + (b (erc-names--last-active-get (cadr b)))) + (if (and a b) (time-less-p a b) b))) ; null means older + +(defun erc-names--action-perform (&rest _) + "Apply `erc-nick-popup' to current' row's nickname." + (when-let* ((entry (tabulated-list-get-entry)) + (name (erc-names--table-nickname entry))) + (setq name (or (car-safe name) name)) + (with-current-buffer erc-names--channel-buffer + (unless (erc-nick-equal-p name (erc-current-nick)) + (erc-nick-popup name))))) + +(defun erc-names--action-pop-to (buffer) + "Call `pop-to-buffer' on BUFFER with `erc-names-display-action'." + (when (buffer-live-p buffer) + (pop-to-buffer buffer erc-names-display-action))) + +(define-derived-mode erc-names--major-mode + tabulated-list-mode "ERC Channel Names" + "Major mode for listing channel members." + :interactive nil + (erc-names--ensure-table) + (setq tabulated-list-format + (erc-names--make-table + :nickname (list "Nick" (erc-names--get-width :nickname) t) + :account (list "Account" (erc-names--get-width :account) t) + :userhost (list "Userhost" (erc-names--get-width :userhost) t) + :full-name (list "Full Name" (erc-names--get-width :full-name) t) + :status (list "Status" (erc-names--get-width :status) + #'erc-names--status-less-p) + :away (list "Away" (erc-names--get-width :away) t) + :last-active (list "Last Active" (erc-names--get-width :last-active) + #'erc-names--last-active-less-p) + :buffers (list "Buffers" (erc-names--get-width :buffers) t))) + (setq tabulated-list-padding 2 + tabulated-list-use-header-line nil + tabulated-list-sort-key (cons "Last Active" 'flip) + mode-name "ERC/N" + revert-buffer-function #'erc-names-list-refresh) + (setq-local mode-line-misc-info (cons erc-names--mode-line-misc-info + mode-line-misc-info)) + (tabulated-list-init-header)) + +(declare-function erc-nicks--highlight "erc-nicks" (nickname &optional face)) + +(defun erc-names--create-desc (cmem) + "Assemble a row object from `erc-channel-members' value CMEM." + (let* ((user (car cmem)) + (cusr (cdr cmem)) + (face (and (bound-and-true-p erc-nicks-mode) + (erc-nicks--highlight (erc-server-user-nickname user)))) + (hl (lambda (s &rest props) + (cond ((null s) "") + ((string-empty-p s) "") + (face `(,s face ,face action ,#'erc-names--action-perform + ,@props)) + (t s))))) + ;; These return "" when empty but a cons of ("nonempty" . PLIST) + ;; otherwise, which is quite inconvenient for sorters and actions. + (erc-names--make-table + :nickname + (funcall hl (erc-server-user-nickname user)) + :account + (funcall hl (or (erc-server-user-account user) "*")) + :userhost + (funcall hl (and-let* ((login (erc-server-user-login user)) + (host (erc-server-user-host user))) + (concat login "@" host))) + :full-name + (funcall hl (erc-server-user-full-name user)) + :status + (funcall hl (erc-v3--format-prefix cusr t)) + :away + (funcall hl (and-let* ((s (erc--sui-get user erc--sui-key-away))) + (if (string-empty-p (string-trim s)) "*" s))) + :last-active + (let ((time (erc-channel-user-last-message-time cusr))) + (funcall hl (and time + (replace-regexp-in-string + " days?" "d" + (replace-regexp-in-string + " hours?" "h" + (replace-regexp-in-string + " minutes?" "m" + (replace-regexp-in-string + " seconds?" "s" + (erc-seconds-to-string + (time-convert (time-subtract (current-time) time) + 'integer))))))) + 'erc-names--ts time)) + :buffers + (if-let* ((bufs (erc-server-user-buffers user)) + (dbufs (remq (current-buffer) bufs))) ; don't use `delq'! + (string-join + (sort (mapcar (lambda (b) + (make-text-button (buffer-name b) nil + 'action #'erc-names--action-pop-to + 'button-data b)) + dbufs) + #'string<) + ", ") + "")))) + +(defun erc-names--create-entries () + "Create `tabulated-list-entries' value." + (let ((entries ()) + (table erc-names--table)) + (setq erc-names--mode-name-count + (with-current-buffer erc-names--channel-buffer + (let ((erc-names--table table)) + (maphash (lambda (dnick cmem) + (push (list dnick (erc-names--create-desc cmem)) + entries)) + erc-channel-members)) + (number-to-string (hash-table-count erc-channel-members)))) + entries)) + +(defun erc-names-list-refresh (&rest _) + "Refresh an ERC /NAMES mode buffer." + (tabulated-list-print t)) + +(defvar erc-names--buffer-function #'erc-names--get-buffer) + +(defun erc-names--get-buffer () + (get-buffer-create (format "*%s/NAMES*" (buffer-name)))) + +(defun erc-names--cmd (channel) + "Show a table of CHANNEL's users in a separate buffer." + (erc-with-buffer (channel) + (let ((channel-buffer (current-buffer))) + (with-current-buffer + (if (buffer-live-p erc-names--buffer) + erc-names--buffer + (setq erc-names--buffer (funcall erc-names--buffer-function))) + (erc-names--major-mode) + (setq erc-names--channel-buffer channel-buffer + tabulated-list-entries #'erc-names--create-entries) + (tabulated-list-print) + (pop-to-buffer (current-buffer) erc-names-display-action))))) + + +;;;; Extension: no-implicit-names + +;; This opts out of NAMES-related responses on reconnect and instead +;; defers updating `erc-channel-members' until WHOX responses arrive, +;; which may be minutes later. + +;; FIXME find a way to make this formally depend on WHOX. And on 315, +;; remove any records absent from the accumulated 354s in the same +;; manner `erc-channel-end-receiving-names' does. + +(defvar erc-names--no-implicit-max-seconds 180 + "Max seconds after disconnecting to forgo a roster refresh.") + +;;;###autoload(put 'draft/no-implicit-names 'erc--feature 'erc-names) +;;;###autoload(put 'no-implicit-names 'erc--feature 'erc-names) +(erc-v3--define-capability no-implicit-names + "Preserve `erc-channel-users' from prior session when reconnecting only." + :initp + (and (erc-v3--init-p) + erc--server-reconnecting + (and-let* ((last-time (alist-get 'erc-server-last-received-time + erc--server-reconnecting))) + (time-less-p (current-time) + (time-add last-time erc-names--no-implicit-max-seconds))) + (prog1 t + (erc--restore-initialize-priors erc-v3-mode + erc-server-users erc-server-users) + (maphash (lambda (dnick user) + (dolist (buffer (erc-server-user-buffers user)) + (erc-with-buffer (buffer) + (puthash dnick (cons user (make-erc-channel-user)) + erc-channel-members)))) + erc-server-users))) + :aliases '(draft/no-implicit-names) + (when (and erc-v3--no-implicit-names erc--target) + (unless (or (erc--module-active-p 'nicks) erc-button--phantom-users-mode) + (erc-button--phantom-users-mode +1)) + (erc--restore-initialize-priors erc-v3-mode + erc-channel-members erc-channel-members) + ;; Display number of records when WHOX is done updating. + (letrec + ((join-fn + (lambda () + (unless (cl-find (erc-target) + (erc-v3--whox-requests erc-v3--whox) + :key #'erc-v3--whox-request-target) + (funcall erc-v3--whox-on-join-function)))) + ;; Mimic what `erc-channel-receive-names' does. + (each-fn + (lambda (dnick _) + (let ((table (or erc-channel-new-member-names + (erc-channel-begin-receiving-names)))) + (puthash dnick t table)))) + (done-fn + (lambda (parsed) + (remove-hook 'erc-v3--whox-target-done-functions done-fn t) + (remove-hook 'erc-join-hook join-fn t) + (erc-channel-end-receiving-names) ; synchronize + (erc-display-message parsed 'notice (current-buffer) + 'names-summary ?c (erc-target) + ?d (hash-table-count erc-channel-members)) + nil))) + (add-hook 'erc-join-hook join-fn 60 t) + (add-hook 'erc-v3--whox-on-354-functions each-fn 30 t) + (add-hook 'erc-v3--whox-target-done-functions done-fn 30 t)))) + +(defvar erc-message-english-names-summary "Users on %c (%d)" + "English `erc-format-message' template for key `names-summary'.") + +(provide 'erc-names) + +;;; erc-names.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 2c30658a9a5..d8b013e1ab9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4903,11 +4903,15 @@ erc-channel-new-member-names If non-nil, this variable is a hash-table that associates received nicks with t.") +(defvar erc--cmd-NAMES-function #'erc--cmd-NAMES + "Function facilitating /NAMES, called with possibly null channel name.") + (defun erc-cmd-NAMES (&optional channel) - "Display the users in CHANNEL. -If CHANNEL is not specified, display the users in the current channel. -This function clears the channel name list first, then sends the -command." + "Display the users in CHANNEL, or the current channel if null." + (funcall erc--cmd-NAMES-function (or channel (erc-target)))) + +(defun erc--cmd-NAMES (channel) + "Simulate having just joined CHANNEL by asking server to resend manifest." (let ((tgt (or (and (erc-channel-p channel) channel) (erc-default-target)))) (if (and tgt (erc-channel-p tgt)) diff --git a/test/lisp/erc/erc-scenarios-names.el b/test/lisp/erc/erc-scenarios-names.el new file mode 100644 index 00000000000..140c3522457 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-names.el @@ -0,0 +1,125 @@ +;;; erc-scenarios-names.el --- erc-names-mode -*- lexical-binding: t -*- + +;; Copyright (C) 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/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-names) + +(ert-deftest erc-scenarios-names-module () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/whox") + (erc-server-flood-penalty 0.1) + (erc-names-columns '( :nickname 15 + :status 5 + :away 20 + :last-active 15 + :userhost 25 + :full-name 20 + :account 15 + :buffers 12)) + (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 `(v3 nicks names ,@erc-modules)) + (erc-v3-extensions '(echo-message)) + (erc-autojoin-channels-alist '((foonet "#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 "tester:changeme" + :full-name "tester") + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 "#spam was created on") + (erc-scenarios-common-say "/names")) + + (with-current-buffer "*#spam/NAMES*" + (funcall expect 1 "mike") + (funcall expect 1 "fool") + + ;; Simulate pressing a key over some entry to PM them. + (let ((inhibit-interaction nil) + (inhibit-message noninteractive)) + (ert-simulate-keys "Query\r" + (erc-names--action-perform))) + (should (get-buffer "fool"))))) + +(ert-deftest erc-scenarios-names-no-implicit-names () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "v3/no-implicit-names") + (erc-server-flood-penalty 0.1) + (erc-d-tmpl-vars + `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t))))) + (dumb-server (erc-d-run "localhost" t 'reconnect-a 'reconnect-b)) + (port (process-contact dumb-server :service)) + (erc-modules `(v3 names + ,@(and (not noninteractive) '(nicks)) ,@erc-modules)) + (erc-v3-extensions '(draft/no-implicit-names + account-tag echo-message standard-replies)) + (erc-autojoin-channels-alist '((foonet "#chan"))) + (erc-server-auto-reconnect t) + (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= (buffer-name) (format "127.0.0.1:%d" port))))) + + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "dummy") ; 353 displayed on first connect + (funcall expect 10 "<bob> alice: Why, sir") + (erc-scenarios-common-say "/names")) + + ;; User dummy is present in channel. + (with-current-buffer "*#chan/NAMES*" + (funcall expect 10 "dummy")) + + (with-current-buffer "foonet" + (funcall expect 10 "Connection failed") + ;; User dummy parts before reconnect happens. + (funcall expect 10 "server is in debug mode")) + + (with-current-buffer "#chan" + ;; 353 absent on reconnect. + (funcall expect -0.1 "dummy") + ;; Summary printed on WHOX finished. + (funcall expect 10 "Users on #chan (4)")) + + ;; /NAMES buffer updates correctly. + (with-current-buffer "*#chan/NAMES*" + (let ((inhibit-message noninteractive)) + (execute-kbd-macro "g")) + (funcall expect -0.1 "dummy" (point-min))))) + +;;; erc-scenarios-names.el ends here diff --git a/test/lisp/erc/resources/v3/no-implicit-names/reconnect-a.eld b/test/lisp/erc/resources/v3/no-implicit-names/reconnect-a.eld new file mode 100644 index 00000000000..66042f44fd6 --- /dev/null +++ b/test/lisp/erc/resources/v3/no-implicit-names/reconnect-a.eld @@ -0,0 +1,57 @@ +;; -*- 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=before-connect draft/channel-rename draft/chathistory draft/event-playback draft/extended-isupport draft/languages=17,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=max-bytes=4096,max-lines=100 draft/no-implicit-names draft/persistence draft/pre-away draft/read-marker draft/relaymsg=/ echo-message ergo.chat/nope extended-join") + (0.00 ":irc.foonet.org CAP * LS :extended-monitor invite-notify labeled-response message-tags multi-prefix sasl=PLAIN,EXTERNAL server-time setname standard-replies userhost-in-names znc.in/playback znc.in/self-message")) +((cap 10 "CAP REQ :account-notify account-tag away-notify cap-notify chghost echo-message extended-join extended-monitor message-tags multi-prefix") + (0.04 ":irc.foonet.org CAP * ACK :account-notify account-tag away-notify cap-notify chghost echo-message extended-join extended-monitor message-tags multi-prefix")) +((cap 10 "CAP REQ :server-time setname standard-replies userhost-in-names") + (0.00 "@time=" now " :irc.foonet.org CAP * ACK :server-time setname standard-replies userhost-in-names")) +((cap 10 "CAP END") + (0.00 "@time=" now " :irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 "@time=" now " :irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.16.0") + (0.00 "@time=" now " :irc.foonet.org 003 tester :This server was created Fri, 07 Nov 2025 09:04:12 UTC") + (0.00 "@time=" now " :irc.foonet.org 004 tester irc.foonet.org ergo-v2.16.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 "@time=" now " :irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 "@time=" now " :irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 MSGREFTYPES=msgid,timestamp NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ SAFELIST SAFERATE STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 :are supported by this server") + (0.00 "@time=" now " :irc.foonet.org 005 tester TOPICLEN=390 UTF8ONLY WHOX draft/CHATHISTORY=25 :are supported by this server") + (0.01 "@time=" now " :irc.foonet.org 251 tester :There are 0 users and 5 invisible on 1 server(s)") + (0.00 "@time=" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 "@time=" now " :irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 "@time=" now " :irc.foonet.org 254 tester 2 :channels formed") + (0.00 "@time=" now " :irc.foonet.org 255 tester :I have 5 clients and 0 servers") + (0.00 "@time=" now " :irc.foonet.org 265 tester 5 5 :Current local users 5, max 5") + (0.01 "@time=" now " :irc.foonet.org 266 tester 5 5 :Current global users 5, max 5") + (0.00 "@time=" now " :irc.foonet.org 422 tester :MOTD File is missing") + (0.00 "@time=" now " :irc.foonet.org 221 tester +i") + (0.00 "@time=" now " :irc.foonet.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 readable by the server owner(s), please disconnect.")) + +((mode 10 "MODE tester +i") + (0.00 "@time=" now " :irc.foonet.org 221 tester +i")) + +((join 10 "JOIN #chan") + (0.00 "@time=" now ";msgid=fv9d2q9cnpqz2dpwccksyutcw6 :[email protected] JOIN #chan * tester") + (0.02 "@time=" now " :irc.foonet.org 353 tester = #chan :[email protected] [email protected] @[email protected] [email protected] [email protected]") + (0.00 "@time=" now " :irc.foonet.org 366 tester #chan :End of NAMES list") + (0.01 "@time=" now ";account=bob;msgid=28y3ty8hkur6nf47d2eatim6zs :[email protected] PRIVMSG #chan :tester, welcome!") + (0.01 "@time=" now ";account=alice;msgid=gvhrydvu2z6j5keksefjxc4cga :[email protected] PRIVMSG #chan :tester, welcome!")) + +((mode-chan 10 "MODE #chan") + (0.00 "@time=" now " :irc.foonet.org 324 tester #chan +Cnt") + (0.01 "@time=" now " :irc.foonet.org 329 tester #chan 1762506256") + (0.02 "@time=" now ";account=bob;msgid=sddt88ei7vepdaub5eci8w2ax2 :[email protected] PRIVMSG #chan :alice: Let me say no, my liege, an if you please.")) + +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u rptgffg45zkb6.irc dummy H 122 0 dummy") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u rptgffg45zkb6.irc tester H 20 0 tester") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc fsbot H@ 2749 0 fsbot") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc bob Hr 1 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc alice Hr 6 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.01 "@time=" now ";account=alice;msgid=2jqivsfwtki4ehsipjc3ny6phw :[email protected] PRIVMSG #chan :Nay, you need not to stop your nose, sir: I spake but by a metaphor.") + (0.07 "@time=" now ";account=bob;msgid=igjuaxt2gusbdbc3daf8ivyur2 :[email protected] PRIVMSG #chan :alice: Why, sir, is this such a piece of study ? Now, here's three studied, ere you'll thrice wink; and how easy it is to put 'years' to the word 'three,' and study three years in two words, the dancing horse will tell you.") + (0.04 "@time=" now ";account=alice;msgid=ebk3taigri2e5x3pm6pytvmfzs :[email protected] PRIVMSG #chan :bob: We'll make you some sport with the fox ere we case him. He was first smoked by the old Lord Lafeu: when his disguise and he is parted, tell me what a sprat you shall find him; which you shall see this very night.") + (0.05 "@time=" now ";account=bob;msgid=zbhaz9qcib4uvfbwef95fm5ag6 :[email protected] PRIVMSG #chan :alice: And calls herself Revenge, and thinks me mad.")) + +((DROP 0 DROP)) diff --git a/test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.eld b/test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.eld new file mode 100644 index 00000000000..3ef543c1504 --- /dev/null +++ b/test/lisp/erc/resources/v3/no-implicit-names/reconnect-b.eld @@ -0,0 +1,45 @@ +;; -*- 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=before-connect draft/channel-rename draft/chathistory draft/event-playback draft/extended-isupport draft/languages=17,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=max-bytes=4096,max-lines=100 draft/no-implicit-names draft/persistence draft/pre-away draft/read-marker draft/relaymsg=/ echo-message ergo.chat/nope extended-join") + (0.00 ":irc.foonet.org CAP * LS :extended-monitor invite-notify labeled-response message-tags multi-prefix sasl=PLAIN,EXTERNAL server-time setname standard-replies userhost-in-names znc.in/playback znc.in/self-message")) +((cap 10 "CAP REQ :account-notify account-tag away-notify cap-notify chghost draft/no-implicit-names echo-message extended-join extended-monitor message-tags") + (0.00 ":irc.foonet.org CAP * ACK :account-notify account-tag away-notify cap-notify chghost draft/no-implicit-names echo-message extended-join extended-monitor message-tags")) +((cap 10 "CAP REQ :multi-prefix server-time setname standard-replies userhost-in-names") + (0.00 "@time=" now " :irc.foonet.org CAP * ACK :multi-prefix server-time setname standard-replies userhost-in-names")) +((cap 10 "CAP END") + (0.00 "@time=" now " :irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 "@time=" now " :irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.16.0") + (0.00 "@time=" now " :irc.foonet.org 003 tester :This server was created Fri, 07 Nov 2025 09:04:12 UTC") + (0.00 "@time=" now " :irc.foonet.org 004 tester irc.foonet.org ergo-v2.16.0 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.01 "@time=" now " :irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=25 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 "@time=" now " :irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 MSGREFTYPES=msgid,timestamp NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ SAFELIST SAFERATE STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 :are supported by this server") + (0.00 "@time=" now " :irc.foonet.org 005 tester TOPICLEN=390 UTF8ONLY WHOX draft/CHATHISTORY=25 :are supported by this server") + (0.00 "@time=" now " :irc.foonet.org 251 tester :There are 0 users and 5 invisible on 1 server(s)") + (0.00 "@time=" now " :irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 "@time=" now " :irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 "@time=" now " :irc.foonet.org 254 tester 2 :channels formed") + (0.00 "@time=" now " :irc.foonet.org 255 tester :I have 5 clients and 0 servers") + (0.00 "@time=" now " :irc.foonet.org 265 tester 5 5 :Current local users 5, max 5") + (0.00 "@time=" now " :irc.foonet.org 266 tester 5 5 :Current global users 5, max 5") + (0.00 "@time=" now " :irc.foonet.org 422 tester :MOTD File is missing") + (0.01 "@time=" now " :irc.foonet.org 221 tester +i") + (0.00 "@time=" now " :irc.foonet.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 readable by the server owner(s), please disconnect.")) +((mode 10 "MODE tester +i") + (0.00 "@time=" now " :irc.foonet.org 221 tester +i")) +((join-chan 10 "JOIN #chan") + (0.00 "@msgid=4iea8kxqf8xv9uk6fe7db64ndi;time=" now " :[email protected] JOIN #chan * tester") + (0.01 "@account=alice;msgid=i4qgz53ybqzpctpzwheqk3ffta;time=" now " :[email protected] PRIVMSG #chan :tester, welcome!") + (0.00 "@time=" now ";account=bob;msgid=j2856xv6xfv7s5cwc3ctw443jw :[email protected] PRIVMSG #chan :tester, welcome!")) +((mode-chan 10 "MODE #chan") + (0.00 "@time=" now " :irc.foonet.org 324 tester #chan +Cnt") + (0.01 "@time=" now " :irc.foonet.org 329 tester #chan 1762506256")) +((who-chan 10 "WHO #chan %tcuhnflar,1") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc fsbot H@ 2848 0 fsbot") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc bob Hr 0 bob :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u fzqq3tbap59ma.irc alice Hr 4 alice :Irc bot based on irc3 http://irc3.readthedocs.io") + (0.00 "@time=" now " :irc.foonet.org 354 tester 1 #chan ~u rptgffg45zkb6.irc tester H 20 0 tester") + (0.01 "@time=" now " :irc.foonet.org 315 tester #chan :End of WHO list") + (0.01 "@time=" now ";account=alice;msgid=f2qegzmida2hz7hvj8b35deag2 :[email protected] PRIVMSG #chan :bob: But the plain single vow that is vow'd true.") + (0.03 "@time=" now ";account=bob;msgid=2xguwpn6576utxr4iufiq7sd7e :[email protected] PRIVMSG #chan :alice: But that he's well, and will be shortly here.")) -- 2.51.1 --=-=-=--