From c9f1ad2a87081fcc30d541554721806d89365af0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 13 Apr 2023 00:00:02 -0700 Subject: [PATCH 01/14] Revive option erc-query-on-unjoined-chan-privmsg * etc/ERC-NEWS: Mention reinstated and renamed legacy option `erc-query-on-unjoined-chan-privmsg' as well as a change in behavior for `erc-auto-query', when nil. Also fix erroneous ChangeLog reference in 5.5 section. * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Consider flag `erc-receive-query-display-defer' and revived option `erc-query-unjoined-chan-privmsg' when deciding whether to create a new query buffer. And only "open" a buffer for an unknown target when the latter option is non-nil. * lisp/erc/erc.el (erc-cmd-QUERY): Make error more informative. (erc-query): Revise deprecation message. (erc-auto-query, erc-receive-query-display): Swap alias and aliased and add option to `erc-buffers' group. Mention the nonstandard meaning of nil and update package-version to signify a behavioral change, even though the default value remains untouched. (erc-receive-query-display-defer): Add new variable, a compatibility switch to access legacy behavior for `erc-auto-query'. (erc-query-on-unjoined-chan-privmsg, erc-ensure-target-buffer-on-privmsg): Revise doc string and add alias. Change package-version to ERC 5.6 due to slightly refined meaning. * test/lisp/erc/erc-scenarios-base-attach.el: New file. * test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld: New file. (Bug#62833) --- etc/ERC-NEWS | 23 ++- lisp/erc/erc-backend.el | 19 +- lisp/erc/erc.el | 59 ++++-- test/lisp/erc/erc-scenarios-base-attach.el | 191 ++++++++++++++++++ .../base/channel-buffer-revival/reattach.eld | 56 +++++ 5 files changed, 322 insertions(+), 26 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-attach.el create mode 100644 test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 8f1b89f268b..6897993c628 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -45,9 +45,15 @@ security issue led to new ERC buffers being "buried" on creation. On further reflection, this was judged to have been an overcorrection in the case of interactive invocations, hence the new option 'erc-interactive-display', which is set to 'buffer' (i.e., "take me -there") by default. Accompanying this addition are "display"-suffixed -aliases for related options 'erc-join-buffer' and 'erc-auto-query', -which users have reported as being difficult to discover and remember. +there") by default. + +Accompanying this addition are "display"-suffixed aliases for related +options 'erc-join-buffer' and 'erc-auto-query', which users have +reported as being difficult to discover and remember. When the latter +option (now known as 'erc-receive-query-display') is nil, ERC uses +'erc-join-buffer' in its place, much like it does for +'erc-interactive-display'. The old nil behavior can still be gotten +via the new compatibility flag 'erc-receive-query-display-defer'. ** Setting a module's mode variable via Customize earns a warning. Trying and failing to activate a module via its minor mode's Custom @@ -108,6 +114,13 @@ other than the symbol 'erc-button-buttonize-nicks' appearing in the "FORM" field (third element) of this entry are considered deprecated and will incur a warning. +** Option 'erc-query-on-unjoined-chan-privmsg' restored and renamed. +This option was accidentally removed from the default client in ERC +5.5 and was thus prevented from influencing PRIVMSG routing. It's now +been restored with a slightly revised role contingent on a few +assumptions explained in its doc string. For clarity, it has been +renamed 'erc-ensure-target-buffer-on-privmsg'. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now @@ -332,8 +345,8 @@ In an effort to help further tame ERC's complexity, the variable 'erc-default-recipients' is now expected to hold but a single target. As a consequence, functions like 'erc-add-default-channel' that imagine an alternate, aspirational model of buffer-target relations -have been deprecated. See Emacs change-log entries from around July -of 2022 for specifics. +have been deprecated. Grep for their names in ChangeLog.4 for +details. A number of less consequential deprecations also debut in this release. For example, the function 'erc-auto-query' was deemed too diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bdf4e2ddca2..98a1c117cfa 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,11 +102,11 @@ (require 'erc-common) (defvar erc--target) -(defvar erc-auto-query) (defvar erc-channel-list) (defvar erc-channel-users) (defvar erc-default-nicks) (defvar erc-default-recipients) +(defvar erc-ensure-target-buffer-on-privmsg) (defvar erc-format-nick-function) (defvar erc-format-query-as-channel-p) (defvar erc-hide-prompt) @@ -123,6 +123,8 @@ (defvar erc-nick-change-attempt-count) (defvar erc-prompt-for-channel-key) (defvar erc-prompt-hidden) +(defvar erc-receive-query-display) +(defvar erc-receive-query-display-defer) (defvar erc-reuse-buffers) (defvar erc-verbose-server-ping) (defvar erc-whowas-on-nosuchnick) @@ -1831,11 +1833,16 @@ add things to `%s' instead." (unless (or buffer noticep (string-empty-p tgt) (eq ?$ (aref tgt 0)) (erc-is-message-ctcp-and-not-action-p msg)) (if privp - (when erc-auto-query - (let ((erc-join-buffer erc-auto-query)) - (setq buffer (erc--open-target nick)))) - ;; A channel buffer has been killed but is still joined - (setq buffer (erc--open-target tgt)))) + (when-let ((erc-join-buffer + (or (and (not erc-receive-query-display-defer) + erc-receive-query-display) + (and erc-ensure-target-buffer-on-privmsg + (or erc-receive-query-display + erc-join-buffer))))) + (setq buffer (erc--open-target nick))) + ;; A channel buffer has been killed but is still joined. + (when erc-ensure-target-buffer-on-privmsg + (setq buffer (erc--open-target tgt))))) (when buffer (with-current-buffer buffer (when privp (erc--unhide-prompt)) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 284990e2d43..22b92a0d31b 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3978,8 +3978,8 @@ on the value of `erc-query-display'." (unless user ;; currently broken, evil hack to display help anyway ;(erc-delete-query)))) - (signal 'wrong-number-of-arguments "")) - (let ((erc-join-buffer erc-query-display)) + (signal 'wrong-number-of-arguments '(erc-cmd-QUERY 0))) + (let ((erc-join-buffer erc-interactive-display)) (erc-with-server-buffer (erc--open-target user)))) @@ -4722,23 +4722,30 @@ See `erc-default-server-hook'." "Open a query buffer on TARGET using SERVER-BUFFER. To change how this query window is displayed, use `let' to bind `erc-join-buffer' before calling this." - (declare (obsolete "bind `erc-cmd-query' and call `erc-cmd-QUERY'" "29.1")) + (declare (obsolete "call `erc-open' in a live server buffer" "29.1")) (unless (buffer-live-p server-buffer) (error "Couldn't switch to server buffer")) (with-current-buffer server-buffer (erc--open-target target))) -(defvaralias 'erc-receive-query-display 'erc-auto-query) -(defcustom erc-auto-query 'window-noselect +(defvaralias 'erc-auto-query 'erc-receive-query-display) +(defcustom erc-receive-query-display 'window-noselect "If non-nil, create a query buffer each time you receive a private message. If the buffer doesn't already exist, it is created. This can be set to a symbol, to control how the new query window should appear. The default behavior is to display the buffer in -a new window, but not to select it. See the documentation for -`erc-join-buffer' for a description of the available choices." +a new window but not to select it. See the documentation for +`erc-buffer-display' for a description of available values. + +Note that the legacy behavior of forgoing buffer creation +entirely when this option is nil requires setting the +compatibility flag `erc-receive-query-display-defer' to nil. Use +`erc-ensure-target-buffer-on-privmsg' to achieve the same effect." + :package-version '(ERC . "5.6") + :group 'erc-buffers :group 'erc-query - :type '(choice (const :tag "Don't create query window" nil) + :type '(choice (const :tag "Defer to value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -4746,15 +4753,37 @@ a new window, but not to select it. See the documentation for (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) -;; FIXME either retire this or put it to use after determining how -;; it's meant to work. Clearly, the doc string does not describe -;; current behavior. It's currently only used by the obsolete -;; function `erc-auto-query'. -(defcustom erc-query-on-unjoined-chan-privmsg t - "If non-nil create query buffer on receiving any PRIVMSG at all. +(defvar erc-receive-query-display-defer t + "How to interpret a null `erc-receive-query-display'. +When this variable is non-nil, ERC defers to `erc-buffer-display' +upon seeing a nil value for `erc-receive-query-display', much +like it does with other buffer-display options, like +`erc-interactive-display'. Otherwise, when this option is nil, +ERC retains the legacy behavior of not creating a new query +buffer.") + +(defvaralias 'erc-query-on-unjoined-chan-privmsg + 'erc-ensure-target-buffer-on-privmsg) +(defcustom erc-ensure-target-buffer-on-privmsg t + "When non-nil, create a target buffer upon receiving a PRIVMSG. This includes PRIVMSGs directed to channels. If you are using an IRC bouncer, such as dircproxy, to keep a log of channels when you are -disconnected, you should set this option to t." +disconnected, you should set this option to t. + +For queries (direct messages), this option's non-nil meaning is +straightforward: if a buffer doesn't exist for the sender, create +one. For channels, the use case is more niche and usually +involves receiving playback (via commands like ZNC's +\"PLAYBUFFER\") for channels to which your bouncer is joined but +from which you've \"detached\". + +Note that this option was absent from ERC 5.5 because knowledge +of its intended role was \"unavailable\" during a major +refactoring involving buffer management. The option has since +been restored in ERC 5.6 but now also affects queries in the +manner implied above, which was lost sometime before ERC 5.4." + :package-version '(ERC . "5.6") ; revived + :group 'erc-buffers :group 'erc-query :type 'boolean) diff --git a/test/lisp/erc/erc-scenarios-base-attach.el b/test/lisp/erc/erc-scenarios-base-attach.el new file mode 100644 index 00000000000..ccf5d1f9582 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-attach.el @@ -0,0 +1,191 @@ +;;; erc-scenarios-base-attach.el --- Reattach scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; See also: `erc-scenarios-base-channel-buffer-revival'. +;; +;; ERC 5.5 silently dropped support for the ancient option +;; `erc-query-on-unjoined-chan-privmsg' because the tangled logic in +;; and around the function `erc-auto-query' made it difficult to +;; divine its purpose. +;; +;; Based on the name, it was thought this option likely involved +;; controlling the creation of query buffers for unsolicited messages +;; from users with whom you don't share a common channel. However, +;; additional spelunking has recently revealed that it was instead +;; meant to service a feature offered by most bouncers that sends +;; PRIVMSGs directed at a channel you're no longer in and that you +;; haven't received a(nother) JOIN message for. IOW, this is meant to +;; support the following sequence of events: +;; +;; 1. /detach #chan +;; 2. kill buffer #chan or reconnect in new Emacs session +;; 3. /playbuffer #chan +;; +;; Note that the above slash commands are bouncer-specific aliases. +;; +;; Interested users can find more info by looking at this change set +;; from the ancient CVS repo: +;; +;; Author: Mario Lang +;; AuthorDate: Mon Nov 26 18:33:19 2001 +0000 +;; +;; * new function erc-BBDB-NICK to handle nickname anotation ... +;; * Applied antifuchs/mhp patches, the latest on erc-help, unmodified +;; * New variable: erc-reuse-buffers default to t. +;; * Modified erc-generate-new-buffer-name to use it. it checks if +;; server and port are the same, then one can assume thats the same +;; channel/query target again. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--enabled () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/channel-buffer-revival") + (dumb-server (erc-d-run "localhost" t 'reattach)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester@vanilla/foonet: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 "foonet")) + (erc-cmd-MSG "*status playbuffer #chan")) + + (ert-info ("Playback appears in buffer #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "Was I a child") + (funcall expect 10 "Thou counterfeit'st most lively") + (funcall expect 10 "Playback Complete"))) + + (with-current-buffer "foonet" + (erc-cmd-MSG "*status attach #chan")) + + (ert-info ("Live output from #chan after more playback") + (with-current-buffer "#chan" + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "With what it loathes") + (funcall expect 10 "Not by his breath") + (funcall expect 10 "Playback Complete") + (funcall expect 10 "Ay, and the captain") + (erc-scenarios-common-say "bob: hi") + (funcall expect 10 "Pawn me to this"))))) + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/channel-buffer-revival") + (dumb-server (erc-d-run "localhost" t 'reattach)) + (port (process-contact dumb-server :service)) + (erc-server-flood-penalty 0.1) + (erc-ensure-target-buffer-on-privmsg nil) ; off + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "tester@vanilla/foonet: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 "foonet")) + (erc-cmd-MSG "*status playbuffer #chan") + (ert-info ("Playback appears in buffer server buffer") + (erc-d-t-ensure-for -1 (not (get-buffer "#chan"))) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "Was I a child") + (funcall expect 10 "Thou counterfeit'st most lively") + (funcall expect 10 "Playback Complete")) + (should-not (get-buffer "#chan")) + (erc-cmd-MSG "*status attach #chan")) + + (ert-info ("Buffer #chan joined") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "Buffer Playback...") + (funcall expect 10 "With what it loathes") + (funcall expect 10 "Not by his breath") + (funcall expect 10 "Playback Complete") + (funcall expect 10 "Ay, and the captain") + (erc-scenarios-common-say "bob: hi") + (funcall expect 10 "Pawn me to this"))))) + + +;; We omit the `enabled' case for queries because it's the default for +;; this option and already covered many times over by other tests in +;; this directory. + +(ert-deftest erc-scenarios-base-attach--ensure-target-buffer--disabled-query () + :tags '(:expensive-test) + (should erc-ensure-target-buffer-on-privmsg) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/assoc/queries") + (dumb-server (erc-d-run "localhost" t 'non-erc)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-ensure-target-buffer-on-privmsg nil) + (erc-server-flood-penalty 0.1)) + + (ert-info ("Connect to foonet") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :user "tester" + :full-name "tester") + (erc-scenarios-common-assert-initial-buf-name nil port) + (erc-d-t-wait-for 5 (eq erc-network 'foonet)) + (funcall expect 15 "debug mode"))) + + (ert-info ("User dummy's greeting appears in server buffer") + (erc-d-t-wait-for -1 (get-buffer "dummy")) + (with-current-buffer "foonet" + (funcall expect 5 "hi") + + (ert-info ("Option being nil doesn't queries we create") + (with-current-buffer (erc-cmd-QUERY "nitwit") + (should (equal (buffer-name) "nitwit")) + (erc-scenarios-common-say "hola") + (funcall expect 5 "ciao"))) + + (erc-scenarios-common-say "howdy") + (funcall expect 5 "no target") + (erc-cmd-MSG "dummy howdy") + (funcall expect 5 "bye") + (erc-cmd-QUIT ""))))) + +;;; erc-scenarios-base-attach.el ends here diff --git a/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld b/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld new file mode 100644 index 00000000000..c3791ac3d49 --- /dev/null +++ b/test/lisp/erc/resources/base/channel-buffer-revival/reattach.eld @@ -0,0 +1,56 @@ +;; -*- mode: lisp-data; -*- +((pass 10 "PASS :tester@vanilla/foonet:changeme")) +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.00 ":irc.foonet.org 003 tester :This server was created Thu, 13 Apr 2023 05:55:22 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.00 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.01 ":irc.foonet.org 221 tester +Zi")) + +((privmsg-play 10 "PRIVMSG *status :playbuffer #chan") + (0.05 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:24] alice: Was I a child, to fear I know not what.") + (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:29] bob: My lord, I do confess the ring was hers.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:08:40] alice: My sons would never so dishonour me.") + (0.01 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:54] bob: By the hand of a soldier, I will undertake it.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:09:57] alice: Thou counterfeit'st most lively.") + (0.01 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.")) + +((privmsg-attach 10 "PRIVMSG *status :attach #chan") + (0.01 ":tester!~u@78a58pgahbr24.irc JOIN #chan")) + +((mode-chan 10 "MODE #chan") + (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob tester") + (0.00 ":irc.foonet.org 366 tester #chan :End of /NAMES list.") + (0.00 ":***!znc@znc.in PRIVMSG #chan :Buffer Playback...") + (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:01] bob: With what it loathes for that which is away.") + (0.00 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:10:30] alice: Ties up my tongue, and will not let me speak.") + (0.00 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:26] bob: They say he is already in the forest of Arden, and a many merry men with him; and there they live like the old Robin Hood of England. They say many young gentlemen flock to him every day, and fleet the time carelessly, as they did in the golden world.") + (0.01 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :[06:11:29] alice: Not by his breath that is more miserable.") + (0.00 ":***!znc@znc.in PRIVMSG #chan :Playback Complete.") + (0.00 ":*status!znc@znc.in PRIVMSG tester :There was 1 channel matching [#chan]") + (0.03 ":*status!znc@znc.in PRIVMSG tester :Attached 1 channel") + (0.00 ":irc.foonet.org 324 tester #chan +Cnt") + (0.00 ":irc.foonet.org 329 tester #chan 1681365340") + (0.03 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Five or six thousand horse, I said,I will say true,or thereabouts, set down, for I'll speak truth.") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Riddling confession finds but riddling shrift.") + (0.04 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Ay, and the captain of his horse, Count Rousillon.")) + +((privmsg-bob 10 "PRIVMSG #chan :bob: hi") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: But thankful even for hate, that is meant love.") + (0.02 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :tester: Come, come, elder brother, you are too young in this.") + (0.02 ":alice!~u@q2weir96jk3r2.irc PRIVMSG #chan :bob: Sir, we have known together in Orleans.") + (0.05 ":bob!~u@q2weir96jk3r2.irc PRIVMSG #chan :alice: Pawn me to this your honour, she is his.")) From 8654cea5843aa2fa2074f317d338451eadae092f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 20 Apr 2023 19:23:54 -0700 Subject: [PATCH 02/14] Move ERC's buffer-display tests to separate file * test/lisp/erc/erc-scenarios-base-buffer-display.el: New file. * test/lisp/erc/erc-scenarios-base-reconnect.el (erc-scenarios-common--base-reconnect-options, erc-scenarios-base-reconnect-options--buffer, erc-scenarios-base-reconnect-options--default): Move to new file and rename. (Bug#62833) * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-run-linger): Lengthen timeout. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--m): Ensure buffer is live before inserting. --- .../erc/erc-scenarios-base-buffer-display.el | 121 ++++++++++++++++++ test/lisp/erc/erc-scenarios-base-reconnect.el | 89 ------------- test/lisp/erc/resources/erc-d/erc-d-tests.el | 2 +- test/lisp/erc/resources/erc-d/erc-d.el | 7 +- 4 files changed, 126 insertions(+), 93 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-buffer-display.el diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el new file mode 100644 index 00000000000..d511c8ff738 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -0,0 +1,121 @@ +;;; erc-scenarios-base-buffer-display.el --- Buffer display scenarios -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(eval-when-compile (require 'erc-join)) + +;; These first couple `erc-reconnect-display' tests used to live in +;; erc-scenarios-base-reconnect but have since been renamed. + +(defun erc-scenarios-base-buffer-display--reconnect-common (test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'options 'options-again)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-server-flood-penalty 0.1) + (erc-server-auto-reconnect t) + erc-autojoin-channels-alist + erc-server-buffer) + + (should (memq 'autojoin erc-modules)) + + (ert-info ("Connect to foonet") + (setq erc-server-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester")) + (with-current-buffer erc-server-buffer + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + (funcall expect 10 "debug mode"))) + + (ert-info ("Wait for some output in channels") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "welcome"))) + + (ert-info ("Server buffer shows connection failed") + (with-current-buffer erc-server-buffer + (funcall expect 10 "Connection failed! Re-establishing"))) + + (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) + + (funcall test) + + ;; A manual /JOIN command tells ERC we're done auto-reconnecting + (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) + + (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" + (not (eq (window-buffer) (get-buffer "#spam")))) + + (ert-info ("Wait for auto reconnect") + (with-current-buffer erc-server-buffer + (funcall expect 10 "still in debug mode"))) + + (ert-info ("Wait for activity to recommence in channels") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "forest of Arden")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (funcall expect 10 "her elves come here anon"))))) + +(ert-deftest erc-scenarios-base-reconnect-options--buffer () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should-not erc-reconnect-display) + + ;; FooNet (the server buffer) is not switched to because it's + ;; already current (but not shown) when `erc-open' is called. See + ;; related conditional guard towards the end of that function. + + (let ((erc-reconnect-display 'buffer)) + (erc-scenarios-base-buffer-display--reconnect-common + (lambda () + (pop-to-buffer-same-window "*Messages*") + + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) + + (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" + (eq (window-buffer) (get-buffer "#chan"))))))) + +(ert-deftest erc-scenarios-base-reconnect-options--default () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should-not erc-reconnect-display) + + (erc-scenarios-base-buffer-display--reconnect-common + + (lambda () + (pop-to-buffer-same-window "*Messages*") + + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) + + (erc-d-t-ensure-for 3 "Channel #chan not shown" + (not (eq (window-buffer) (get-buffer "#chan")))) + + (should (eq (window-buffer) (messages-buffer)))))) + +;;; erc-scenarios-base-buffer-display.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el b/test/lisp/erc/erc-scenarios-base-reconnect.el index 5b4dc549042..7bd16d1ed14 100644 --- a/test/lisp/erc/erc-scenarios-base-reconnect.el +++ b/test/lisp/erc/erc-scenarios-base-reconnect.el @@ -65,95 +65,6 @@ (should (equal (list (get-buffer (format "127.0.0.1:%d" port))) (erc-scenarios-common-buflist "127.0.0.1")))))) -(defun erc-scenarios-common--base-reconnect-options (test) - (erc-scenarios-common-with-cleanup - ((erc-scenarios-common-dialog "base/reconnect") - (dumb-server (erc-d-run "localhost" t 'options 'options-again)) - (port (process-contact dumb-server :service)) - (expect (erc-d-t-make-expecter)) - (erc-server-flood-penalty 0.1) - (erc-server-auto-reconnect t) - erc-autojoin-channels-alist - erc-server-buffer) - - (should (memq 'autojoin erc-modules)) - - (ert-info ("Connect to foonet") - (setq erc-server-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :password "changeme" - :full-name "tester")) - (with-current-buffer erc-server-buffer - (should (string= (buffer-name) (format "127.0.0.1:%d" port))) - (funcall expect 10 "debug mode"))) - - (ert-info ("Wait for some output in channels") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 10 "welcome"))) - - (ert-info ("Server buffer shows connection failed") - (with-current-buffer erc-server-buffer - (funcall expect 10 "Connection failed! Re-establishing"))) - - (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) - - (funcall test) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting - (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - - (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" - (not (eq (window-buffer) (get-buffer "#spam")))) - - (ert-info ("Wait for auto reconnect") - (with-current-buffer erc-server-buffer - (funcall expect 10 "still in debug mode"))) - - (ert-info ("Wait for activity to recommence in channels") - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) - (funcall expect 10 "forest of Arden")) - (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) - (funcall expect 10 "her elves come here anon"))))) - -(ert-deftest erc-scenarios-base-reconnect-options--buffer () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) - - ;; FooNet (the server buffer) is not switched to because it's - ;; already current (but not shown) when `erc-open' is called. See - ;; related conditional guard towards the end of that function. - - (let ((erc-reconnect-display 'buffer)) - (erc-scenarios-common--base-reconnect-options - (lambda () - (pop-to-buffer-same-window "*Messages*") - - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) - - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan"))))))) - -(ert-deftest erc-scenarios-base-reconnect-options--default () - :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) - (should-not erc-reconnect-display) - - (erc-scenarios-common--base-reconnect-options - - (lambda () - (pop-to-buffer-same-window "*Messages*") - - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) - - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) - - (eq (window-buffer) (messages-buffer))))) - ;; Upon reconnecting, playback for channel and target buffers is ;; routed correctly. Autojoin is irrelevant here, but for the ;; skeptical, see `erc-scenarios-common--join-network-id', which 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 a501cd55494..0ae70087fd1 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -674,7 +674,7 @@ nonzero for this to work." (ert-deftest erc-d-run-linger () :tags '(:unstable :expensive-test) (erc-d-tests-with-server (dumb-s _) linger - (with-current-buffer (erc-d-t-wait-for 6 (get-buffer "#chan")) + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (erc-d-t-search-for 2 "hey")) (with-current-buffer (process-buffer dumb-s) (erc-d-t-search-for 2 "Lingering for 1.00 seconds")) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index f4491bbb834..43f6552f0f3 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -299,9 +299,10 @@ PROCESS should be a client connection or a server network process." (concat (format-time-string "%s.%N: ") ,format-string) ,format-string)) - (want-insert (and ,process erc-d--in-process))) - (when want-insert - (with-current-buffer (process-buffer (process-get ,process :server)) + (want-insert (and ,process erc-d--in-process)) + (buffer (process-buffer (process-get ,process :server)))) + (when (and want-insert (buffer-live-p buffer)) + (with-current-buffer buffer (goto-char (point-max)) (insert (concat (format ,format-string ,@args) "\n")))) (when (or erc-d--m-debug (not want-insert)) From 5de90fa9611ec796a0c459dbcd32a246ff76543c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 10 Apr 2023 17:58:05 -0700 Subject: [PATCH 03/14] Extend erc-interactive-display to cover /JOINs * lisp/erc/erc.el (erc-display): Mention that buffer-related display options live in the customization group `erc-buffers'. (erc-buffer-display, erc-join-buffer): Swap alias and aliased so that the favored name, `erc-buffer-display', appears in the definition and in the Customize menu. Also note related buffer-display options in the doc string. (erc-query-display, erc-interactive-display): Make the former an alias of the latter, new in ERC 5.6, because their roles were functionally redundant and thus confusing. Inherit the default value from `erc-query-display' because users are more familiar with the pop-up window behavior than a single-window replacement. (erc-reconnect-display): Use preferred name for cross-referencing fallback option `erc-buffer-display' in doc string, and explain how /reconnect handling differs. (erc--setup-buffer-hook): Add new internal hook for modules that operate on windows and frames, such as erc-speedbar and erc-status-sidebar. (erc-open): Run `erc--setup-buffer-hook' after `erc-setup-buffer' so hook members know their code isn't tied to `erc-setup-buffer' itself, which may be used in other contexts, but rather to a new ERC buffer on which some display-related action has just been performed. (erc--called-as-input-p): New variable for "slash" commands, like `erc-cmd-FOO', to detect whether they're being called "interactively" as a result of input given at ERC's prompt. (erc-process-input-line): Bind `erc--called-as-input-p' when running slash commands. (erc-cmd-JOIN): When called interactively, schedule a callback to wrap the response handler and control how new buffers are thus displayed. (erc-cmd-QUERY): Use preferred alias for `erc-query-display'. * test/lisp/erc/erc-scenarios-base-buffer-display.el: (erc-scenarios-base-buffer-display--interactive-default): New test. * test/lisp/erc/erc-tests.el (erc-process-input-line, erc-select-read-args, erc-tls, erc--interactive): Change expected default value of `erc-interactive-display' from `buffer' to `window'. (Bug#62833) --- etc/ERC-NEWS | 17 ++-- lisp/erc/erc.el | 88 +++++++++++-------- .../erc/erc-scenarios-base-buffer-display.el | 37 ++++++++ test/lisp/erc/erc-tests.el | 13 +-- 4 files changed, 105 insertions(+), 50 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 6897993c628..57dce501760 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -37,15 +37,18 @@ decade overdue, this is no longer the case. Other UX improvements in this area aim to make the process of connecting interactively slightly more streamlined and less repetitive, even for veteran users. -** New buffer-display option 'erc-interactive-display'. +** Revised buffer-display handling for interactive commands. A point of friction for new users and one only just introduced with ERC 5.5 has been the lack of visual feedback when first connecting via -M-x erc. As explained below in the news for 5.5, the discovery of a -security issue led to new ERC buffers being "buried" on creation. On -further reflection, this was judged to have been an overcorrection in -the case of interactive invocations, hence the new option -'erc-interactive-display', which is set to 'buffer' (i.e., "take me -there") by default. +M-x erc or when issuing a "/JOIN" command at the prompt. As explained +below, in the news for 5.5, the discovery of a security issue led to +most new ERC buffers being "buried" on creation. On further +reflection, this was judged to have been an overcorrection in the case +of interactive invocations, hence the borrowing of an old option, +'erc-query-display', and the bestowing of a new alias, +'erc-interactive-display', which better describes its expanded role as +a more general buffer-display knob for interactive commands ("/QUERY" +still among them). Accompanying this addition are "display"-suffixed aliases for related options 'erc-join-buffer' and 'erc-auto-query', which users have diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 22b92a0d31b..13f6da2d5be 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -98,7 +98,9 @@ :group 'erc) (defgroup erc-display nil - "Settings for how various things are displayed." + "Settings controlling how various things are displayed. +See the customization group `erc-buffers' for display options +concerning buffers." :group 'erc) (defgroup erc-mode-line-and-header nil @@ -1507,9 +1509,9 @@ Defaults to the server buffer." "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") -(defvaralias 'erc-buffer-display 'erc-join-buffer) -(defcustom erc-join-buffer 'bury - "Determines how to display a newly created IRC buffer. +(defvaralias 'erc-join-buffer 'erc-buffer-display) +(defcustom erc-buffer-display 'bury + "How to display a newly created ERC buffer. The available choices are: @@ -1518,7 +1520,9 @@ The available choices are: `frame' - in another frame, `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, - any other value - in place of the current buffer." + +See related options `erc-interactive-display', +`erc-reconnect-display', and `erc-receive-query-display'." :package-version '(ERC . "5.5") :group 'erc-buffers :type '(choice (const :tag "Split window and select" window) @@ -1528,13 +1532,17 @@ The available choices are: (const :tag "Use current buffer" buffer) (const :tag "Use current buffer" t))) -(defcustom erc-interactive-display 'buffer - "How and whether to display server buffers for M-x erc. -See `erc-buffer-display' and friends for a description of -possible values." +(defvaralias 'erc-query-display 'erc-interactive-display) +(defcustom erc-interactive-display 'window + "How to display buffers as a result of user interaction. +This affects commands like /QUERY and /JOIN when issued +interactively at the prompt. It does not apply when calling a +handler for such a command, like `erc-cmd-JOIN', from lisp code. +See `erc-buffer-display' for a full description of available +values." :package-version '(ERC . "5.6") ; FIXME sync on release :group 'erc-buffers - :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -1542,15 +1550,14 @@ possible values." (const :tag "Use current buffer" buffer))) (defcustom erc-reconnect-display nil - "How (and whether) to display a channel buffer upon reconnecting. - -This only affects automatic reconnections and is ignored when -issuing a /reconnect command or reinvoking `erc-tls' with the -same args (assuming success, of course). See `erc-join-buffer' -for a description of possible values." + "How and whether to display a channel buffer when auto-reconnecting. +This only affects automatic reconnections and is ignored, like +all other buffer-display options, when issuing a /RECONNECT or +successfully reinvoking `erc-tls' with similar arguments. See +`erc-buffer-display' for a description of possible values." :package-version '(ERC . "5.5") :group 'erc-buffers - :type '(choice (const :tag "Use value of `erc-join-buffer'" nil) + :type '(choice (const :tag "Use value of `erc-buffer-display'" nil) (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) (const :tag "New frame" frame) @@ -2044,6 +2051,9 @@ to display-buffer machinery." (display-buffer-use-some-frame buffer `((frame-predicate . ,ercp) ,@alist))))) +(defvar erc--setup-buffer-hook nil + "Internal hook for module setup involving windows and frames.") + (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase (if (zerop (erc-with-server-buffer @@ -2251,7 +2261,8 @@ Returns the buffer for the given server or channel." ;; we can't log to debug buffer, it may not exist yet (message "erc: old buffer %s, switching to %s" old-buffer buffer)) - (erc-setup-buffer buffer)) + (erc-setup-buffer buffer) + (run-hooks 'erc--setup-buffer-hook)) buffer)) @@ -3057,6 +3068,10 @@ present." (let ((prop-val (erc-get-parsed-vector position))) (and prop-val (member (erc-response.command prop-val) list)))) +(defvar erc--called-as-input-p nil + "Non-nil when a user types a \"/slash\" command. +Remains bound until `erc-cmd-SLASH' returns.") + (defvar-local erc-send-input-line-function 'erc-send-input-line "Function for sending lines lacking a leading user command. When a line typed into a buffer contains an explicit command, like /msg, @@ -3110,7 +3125,8 @@ this function from interpreting the line as a command." (if (and command-list (not no-command)) (let* ((cmd (nth 0 command-list)) - (args (nth 1 command-list))) + (args (nth 1 command-list)) + (erc--called-as-input-p t)) (condition-case nil (if (listp args) (apply cmd args) @@ -3584,6 +3600,21 @@ were most recently invited. See also `invitation'." (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) (setq erc--server-last-reconnect-count 0) + (when-let* ; bind `erc-join-buffer' when /JOIN issued + ((erc--called-as-input-p) + (fn (lambda (proc parsed) + (when-let* ; `fn' wrapper already removed from hook + (((equal (car (erc-response.command-args parsed)) + channel)) + (sn (erc-extract-nick (erc-response.sender parsed))) + ((erc-nick-equal-p sn (erc-current-nick))) + (erc-join-buffer (or erc-interactive-display + erc-join-buffer))) + (run-hook-with-args-until-success + 'erc-server-JOIN-functions proc parsed) + t)))) + (erc-with-server-buffer + (erc-once-with-server-event "JOIN" fn))) (erc-server-join-channel nil chnl key)))) t) @@ -3947,27 +3978,10 @@ just as you provided it. Use this command with care!" (t nil))) (put 'erc-cmd-QUOTE 'do-not-parse-args t) -(defcustom erc-query-display 'window - "How to display query buffers when using the /QUERY command to talk to someone. - -The default behavior is to display the message in a new window -and bring it to the front. See the documentation for -`erc-join-buffer' for a description of the available choices. - -See also `erc-auto-query' to decide how private messages from -other people should be displayed." - :group 'erc-query - :type '(choice (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) - (defun erc-cmd-QUERY (&optional user) "Open a query with USER. How the query is displayed (in a new window, frame, etc.) depends -on the value of `erc-query-display'." +on the value of `erc-interactive-display'." ;; FIXME: The doc string used to say at the end: ;; "If USER is omitted, close the current query buffer if one exists ;; - except this is broken now ;-)" diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index d511c8ff738..3ed7a83653e 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -118,4 +118,41 @@ (should (eq (window-buffer) (messages-buffer)))))) + +;; This shows that the option `erc-interactive-display' overrides +;; `erc-join-buffer' during cold opens and interactive /JOINs. + +(ert-deftest erc-scenarios-base-buffer-display--interactive-default () + :tags '(:expensive-test) + (should (eq erc-join-buffer 'bury)) + (should (eq erc-interactive-display 'window)) + + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "join/legacy") + (dumb-server (erc-d-run "localhost" t 'foonet)) + (port (process-contact dumb-server :service)) + (url (format "tester:changeme@127.0.0.1:%d\r\r" port)) + (expect (erc-d-t-make-expecter)) + (erc-server-flood-penalty 0.1) + (erc-server-auto-reconnect t) + (erc-user-full-name "tester")) + + (ert-info ("Connect to foonet") + (with-current-buffer (let (inhibit-interaction) + (ert-simulate-keys url + (call-interactively #'erc))) + (should (string= (buffer-name) (format "127.0.0.1:%d" port))) + + (erc-d-t-wait-for 10 "Server buffer shown" + (eq (window-buffer) (current-buffer))) + (funcall expect 10 "debug mode") + (erc-scenarios-common-say "/JOIN #chan"))) + + (ert-info ("Wait for output in #chan") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "welcome") + (erc-d-t-ensure-for 3 "Channel #chan shown" + (eq (window-buffer) (current-buffer))) + (funcall expect 10 "be prosperous"))))) + ;;; erc-scenarios-base-buffer-display.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 29bda7e742d..88b9babf206 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1292,6 +1292,7 @@ (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) + (should erc--called-as-input-p) (funcall orig-erc-cmd-MSG line))) ((symbol-function 'erc-server-buffer) (lambda () (current-buffer))) @@ -1469,7 +1470,7 @@ :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when port matches default TLS port") (should (equal (ert-simulate-keys "irc.gnu.org\r6697\r\r\r" @@ -1479,7 +1480,7 @@ :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (ert-info ("Switches to TLS when URL is ircs://") (should (equal (ert-simulate-keys "ircs://irc.gnu.org\r\r\r\r" @@ -1489,7 +1490,7 @@ :nick (user-login-name) '&interactive-env '((erc-server-connect-function . erc-open-tls-stream) - (erc-join-buffer . buffer)))))) + (erc-join-buffer . window)))))) (setq-local erc-interactive-display nil) ; cheat to save space @@ -1625,7 +1626,7 @@ '("localhost" 6667 "nick" "unknown" t "sesame" nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) + '((erc-join-buffer window) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Custom connect function") @@ -1686,7 +1687,7 @@ '("irc.libera.chat" 6697 "tester" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) (erc-server-connect-function + '((erc-join-buffer window) (erc-server-connect-function erc-open-tls-stream))))) (ert-info ("Nick supplied, decline TLS upgrade") @@ -1696,7 +1697,7 @@ '("irc.libera.chat" 6667 "dummy" "unknown" t nil nil nil nil nil "user" nil))) (should (equal (pop env) - '((erc-join-buffer buffer) + '((erc-join-buffer window) (erc-server-connect-function erc-open-network-stream)))))))) From 9e1a5a389ed255c159e22d9d01b91631a114cd73 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 20 Apr 2023 19:20:59 -0700 Subject: [PATCH 04/14] Ignore erc-reconnect-display after a timeout * lisp/erc/erc-backend.el (erc--server-reconnect-display-timer): New variable to store active timer that, upon firing, zeroes out `erc--server-last-reconnect-count'. (erc--server-last-reconnect-on-disconnect): New function to run on `erc-disconnected-hook'. (erc--server-last-reconnect-display-reset): New function to ensure the reconnect-display period ends. * lisp/erc/erc.el (erc-reconnect-display-timeout): New option to control how long `erc-reconnect-display' affects the displaying of new buffers following an automatic reconnection. (erc-process-input-line): Ensure user input marks the end of the reconnect-display period. (erc-cmd-JOIN): Don't bother resetting `erc--server-last-reconnect-count' because it's now handled by its sometime caller, `erc-process-input-line'. (erc-connection-established): Schedule timer and register hook to reset last-reconnect count and terminate the reconnect-display period. * test/lisp/erc/erc-scenarios-base-buffer-display.el: (erc-scenarios-base-buffer-display--reconnect-common): Add new args to test fixture to allow for asserting display properties at various stages throughout a session. (erc-scenarios-base-reconnect-options--buffer, erc-scenarios-base-buffer-display--defwin-recbury-intbuf): Rename former to latter and rework to better reflect realistic settings for the relevant display options. (erc-scenarios-base-reconnect-options--default, erc-scenarios-base-buffer-display--defwino-recbury-intbuf): Rename former to latter and rework to be more realistic. (erc-scenarios-base-buffer-display--count-reset-timeout): New test for new option `erc-reconnect-display-timeout'. (Bug#62833) --- lisp/erc/erc-backend.el | 22 +++ lisp/erc/erc.el | 15 +- .../erc/erc-scenarios-base-buffer-display.el | 163 +++++++++++++----- 3 files changed, 156 insertions(+), 44 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 98a1c117cfa..d14640e798d 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -299,6 +299,12 @@ function `erc-server-process-alive' instead.") (defvar-local erc-server-reconnect-count 0 "Number of times we have failed to reconnect to the current server.") +(defvar-local erc--server-reconnect-display-timer nil + "Timer that resets `erc--server-last-reconnect-count' to zero. +Becomes non-nil in all server buffers when an IRC connection is +first \"established\" and carries out its duties +`erc-reconnect-display-timeout' seconds later.") + (defvar-local erc--server-last-reconnect-count 0 "Snapshot of reconnect count when the connection was established.") @@ -903,6 +909,22 @@ EVENT is the message received from the closed connection process." erc-server-reconnecting) (erc--server-reconnect-p event))) +(defun erc--server-last-reconnect-on-disconnect (&rest _) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect t) + (erc--server-last-reconnect-display-reset (current-buffer))) + +(defun erc--server-last-reconnect-display-reset (buffer) + "Deactivate `erc-reconnect-display'." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when erc--server-reconnect-display-timer + (cancel-timer erc--server-reconnect-display-timer) + (remove-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-display-reset t) + (setq erc--server-reconnect-display-timer nil + erc--server-last-reconnect-count 0))))) + (defconst erc--mode-line-process-reconnecting '(:eval (erc-with-server-buffer (and erc--server-reconnect-timer diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 13f6da2d5be..fec1e1a4eb9 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1564,6 +1564,13 @@ successfully reinvoking `erc-tls' with similar arguments. See (const :tag "Bury in new buffer" bury) (const :tag "Use current buffer" buffer))) +(defcustom erc-reconnect-display-timeout 10 + "Duration `erc-reconnect-display' remains active. +The countdown starts on MOTD and is canceled early by any +\"slash\" command." + :type 'integer + :group 'erc-buffers) + (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." @@ -3127,6 +3134,7 @@ this function from interpreting the line as a command." (let* ((cmd (nth 0 command-list)) (args (nth 1 command-list)) (erc--called-as-input-p t)) + (erc--server-last-reconnect-display-reset (erc-server-buffer)) (condition-case nil (if (listp args) (apply cmd args) @@ -3599,7 +3607,6 @@ were most recently invited. See also `invitation'." ((with-current-buffer existing (erc-get-channel-user (erc-current-nick))))) (switch-to-buffer existing) - (setq erc--server-last-reconnect-count 0) (when-let* ; bind `erc-join-buffer' when /JOIN issued ((erc--called-as-input-p) (fn (lambda (proc parsed) @@ -5204,6 +5211,12 @@ Set user modes and run `erc-after-connect' hook." (setq erc-server-connected t) (setq erc--server-last-reconnect-count erc-server-reconnect-count erc-server-reconnect-count 0) + (setq erc--server-reconnect-display-timer + (run-at-time erc-reconnect-display-timeout nil + #'erc--server-last-reconnect-display-reset + (current-buffer))) + (add-hook 'erc-disconnected-hook + #'erc--server-last-reconnect-on-disconnect nil t) (erc-update-mode-line) (erc-set-initial-user-mode nick buffer) (erc-server-setup-periodical-ping buffer) diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el b/test/lisp/erc/erc-scenarios-base-buffer-display.el index 3ed7a83653e..548ad00e2d9 100644 --- a/test/lisp/erc/erc-scenarios-base-buffer-display.el +++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el @@ -29,7 +29,8 @@ ;; These first couple `erc-reconnect-display' tests used to live in ;; erc-scenarios-base-reconnect but have since been renamed. -(defun erc-scenarios-base-buffer-display--reconnect-common (test) +(defun erc-scenarios-base-buffer-display--reconnect-common + (assert-server assert-chan assert-rest) (erc-scenarios-common-with-cleanup ((erc-scenarios-common-dialog "base/reconnect") (dumb-server (erc-d-run "localhost" t 'options 'options-again)) @@ -37,87 +38,163 @@ (expect (erc-d-t-make-expecter)) (erc-server-flood-penalty 0.1) (erc-server-auto-reconnect t) - erc-autojoin-channels-alist - erc-server-buffer) + erc-autojoin-channels-alist) (should (memq 'autojoin erc-modules)) (ert-info ("Connect to foonet") - (setq erc-server-buffer (erc :server "127.0.0.1" - :port port - :nick "tester" - :password "changeme" - :full-name "tester")) - (with-current-buffer erc-server-buffer + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester") + (funcall assert-server expect) (should (string= (buffer-name) (format "127.0.0.1:%d" port))) (funcall expect 10 "debug mode"))) (ert-info ("Wait for some output in channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall assert-chan expect) (funcall expect 10 "welcome"))) (ert-info ("Server buffer shows connection failed") - (with-current-buffer erc-server-buffer + (with-current-buffer "FooNet" (funcall expect 10 "Connection failed! Re-establishing"))) (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))) - - (funcall test) - - ;; A manual /JOIN command tells ERC we're done auto-reconnecting - (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - - (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" - (not (eq (window-buffer) (get-buffer "#spam")))) + (delete-other-windows) + (pop-to-buffer-same-window "*Messages*") (ert-info ("Wait for auto reconnect") - (with-current-buffer erc-server-buffer - (funcall expect 10 "still in debug mode"))) + (with-current-buffer "FooNet" (funcall expect 10 "still in debug mode"))) - (ert-info ("Wait for activity to recommence in channels") + (funcall assert-rest expect) + + (ert-info ("Wait for activity to recommence in both channels") (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) (funcall expect 10 "forest of Arden")) (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 10 "her elves come here anon"))))) -(ert-deftest erc-scenarios-base-reconnect-options--buffer () +(ert-deftest erc-scenarios-base-buffer-display--defwin-recbury-intbuf () :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) (should-not erc-reconnect-display) - ;; FooNet (the server buffer) is not switched to because it's - ;; already current (but not shown) when `erc-open' is called. See - ;; related conditional guard towards the end of that function. + (let ((erc-buffer-display 'window) + (erc-interactive-display 'buffer) + (erc-reconnect-display 'bury)) - (let ((erc-reconnect-display 'buffer)) (erc-scenarios-base-buffer-display--reconnect-common - (lambda () - (pop-to-buffer-same-window "*Messages*") - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should-not (frame-root-window-p (selected-window)))) - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan"))))))) + (lambda (_) + (should (eq (window-buffer) (current-buffer))) + (should (equal (get-buffer "FooNet") (window-buffer (next-window))))) -(ert-deftest erc-scenarios-base-reconnect-options--default () + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A manual /JOIN command tells ERC we're done auto-reconnecting + (with-current-buffer "FooNet" (erc-scenarios-common-say "/JOIN #spam")) + + (ert-info ("#spam ignores `erc-reconnect-display'") + ;; Uses `erc-interactive-display' instead. + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "#spam"))) + ;; Option `buffer' replaces entire window (no split) + (erc-d-t-wait-for 5 (frame-root-window-p (selected-window))))))))) + +(ert-deftest erc-scenarios-base-buffer-display--defwino-recbury-intbuf () :tags '(:expensive-test) - (should (eq erc-join-buffer 'bury)) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) (should-not erc-reconnect-display) - (erc-scenarios-base-buffer-display--reconnect-common + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer)) + (erc-scenarios-base-buffer-display--reconnect-common - (lambda () - (pop-to-buffer-same-window "*Messages*") + (lambda (_) + ;; Selected window shows some non-ERC buffer. New server + ;; buffer appears in another window (other side of split). + (should-not (frame-root-window-p (selected-window))) + (should-not (eq (window-buffer) (current-buffer))) + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (lambda (_) + (should-not (frame-root-window-p (selected-window))) + ;; Current split likely shows scratch. + (with-current-buffer (window-buffer) + (should-not (derived-mode-p 'erc-mode))) + (should (eq (current-buffer) (window-buffer (next-window))))) - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) + (lambda (_) + (with-current-buffer "FooNet" + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) - (should (eq (window-buffer) (messages-buffer)))))) + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting, and `erc-interactive-display' is + ;; ignored, so `erc-buffer-display' is again in charge (here, + ;; that means `window-noselect'). + (ert-info ("Join chan noninteractively and open a /QUERY") + (with-current-buffer "FooNet" + (erc-cmd-JOIN "#spam") + ;; However this will reset the option. + (erc-scenarios-common-say "/QUERY bob") + (should (eq (window-buffer) (get-buffer "bob"))) + (should (frame-root-window-p (selected-window))))) + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (get-buffer "bob"))) + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) + +(ert-deftest erc-scenarios-base-buffer-display--count-reset-timeout () + :tags '(:expensive-test) + (should (eq erc-buffer-display 'bury)) + (should (eq erc-interactive-display 'window)) + (should (eq erc-reconnect-display-timeout 10)) + (should-not erc-reconnect-display) + + (let ((erc-buffer-display 'window-noselect) + (erc-reconnect-display 'bury) + (erc-interactive-display 'buffer) + (erc-reconnect-display-timeout 0.5)) + (erc-scenarios-base-buffer-display--reconnect-common + #'ignore #'ignore ; These two are identical to the previous test. + + (lambda (_) + (with-current-buffer "FooNet" + (should erc--server-reconnect-display-timer) + (should (eq (window-buffer) (messages-buffer))) + (should (frame-root-window-p (selected-window)))) + + ;; A non-interactive JOIN command doesn't signal that we're + ;; done auto-reconnecting + (ert-info ("Join chan noninteractively") + (with-current-buffer "FooNet" + (erc-d-t-wait-for 1 (null erc--server-reconnect-display-timer)) + (erc-cmd-JOIN "#spam"))) + + (ert-info ("Newly joined chan ignores `erc-reconnect-display'") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) + (should (eq (window-buffer) (messages-buffer))) + ;; If `erc-reconnect-display-timeout' were left alone, this + ;; would be (frame-root-window-p #). + (should-not (frame-root-window-p (selected-window))) + (should (eq (current-buffer) (window-buffer (next-window)))))))))) ;; This shows that the option `erc-interactive-display' overrides ;; `erc-join-buffer' during cold opens and interactive /JOINs. From 90a9c7b7b594dfcdc985541eb366e5684136c3ec Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 21 Apr 2023 07:30:18 -0700 Subject: [PATCH 05/14] Actually define erc-default-server-functions * lisp/erc/erc-backend.el: Remove top-level `add-hook' for `erc-default-server-functions'. * lisp/erc/erc.el (erc-default-server-hook, erc-default-server-functions): Officially deprecate the former and rename it to the latter. (erc-default-server-handler): Mark obsolete because its replacement took over years ago. (erc-debug-missing-hooks): Append instead of mutate. --- lisp/erc/erc-backend.el | 2 -- lisp/erc/erc.el | 16 ++++++++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index d14640e798d..0c970a9d586 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1459,8 +1459,6 @@ Finds hooks by looking in the `erc-server-responses' hash table." (erc-with-server-buffer (run-hook-with-args 'erc-timer-hook (erc-current-time))))) -(add-hook 'erc-default-server-functions #'erc-handle-unknown-server-response) - (defun erc-handle-unknown-server-response (proc parsed) "Display unknown server response's message." (let ((line (concat (erc-response.sender parsed) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index fec1e1a4eb9..05b6b5bfd21 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4689,9 +4689,13 @@ This places `point' just after the prompt, or at the beginning of the line." ; Stolen from ZenIRC. I just wanna test this code, so here is ; experiment area. -(defcustom erc-default-server-hook '(erc-debug-missing-hooks - erc-default-server-handler) - "Default for server messages which aren't covered by `erc-server-hooks'." +;; This shouldn't be a user option but remains so for compatibility. +(define-obsolete-variable-alias + 'erc-default-server-hook 'erc-default-server-functions "30.1") +(defcustom erc-default-server-functions '(erc-handle-unknown-server-response) + "Abnormal hook for incoming messages without their own handlers. +See `define-erc-response-handler' for more." + :package-version '(ERC . "5.6") :group 'erc-server-hooks :type 'hook) @@ -4699,6 +4703,7 @@ This places `point' just after the prompt, or at the beginning of the line." "Default server handler. Displays PROC and PARSED appropriately using `erc-display-message'." + (declare (obsolete erc-handle-unknown-server-response "29.1")) (erc-display-message parsed 'notice proc (mapconcat @@ -4721,7 +4726,7 @@ See `erc-debug-missing-hooks'.") "Add PARSED server message ERC does not yet handle to `erc-server-vectors'. These vectors can be helpful when adding new server message handlers to ERC. See `erc-default-server-hook'." - (nconc erc-server-vectors (list parsed)) + (setq erc-server-vectors `(,@erc-server-vectors ,parsed)) nil) (defun erc--open-target (target) @@ -4915,6 +4920,9 @@ See also `erc-display-error-notice'." ;;; Server messages +;; FIXME remove on next major version release. This group is all but +;; unused because most `erc-server-FOO-functions' are plain variables +;; and not user options as implied by this doc string. (defgroup erc-server-hooks nil "Server event callbacks. Every server event - like numeric replies - has its own hook. From 2641dfd4b4334942282358b50d74f75424ebf4fa Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 26 Apr 2023 07:05:49 -0700 Subject: [PATCH 06/14] Add erc-timestamp property to invisible messages * lisp/erc/erc-fill.el (erc-fill--wrap-beginning-of-line): Pretend nicks with an empty string as a `display' prop are `invisible-p' and break out of hidden "merged" nicks after moving. (Bug#60936.) * lisp/erc/erc-match.el (erc-hide-fools): Add comment. * lisp/erc/erc-stamp.el (erc-add-timestamp): Always add `erc-timestamp' and `cursor-sensor-functions' properties but respect tradition and don't actually stamp any invisible messages. --- lisp/erc/erc-fill.el | 12 ++++++++++-- lisp/erc/erc-match.el | 2 ++ lisp/erc/erc-stamp.el | 10 ++++++---- 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 7b6495f9f3f..a56134d8188 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -221,8 +221,13 @@ messages less than a day apart." (let ((inhibit-field-text-motion t)) (erc-fill--wrap-move #'move-beginning-of-line #'beginning-of-visual-line arg)) - (when (get-text-property (point) 'erc-prompt) - (goto-char erc-input-marker))) + (if (get-text-property (point) 'erc-prompt) + (goto-char erc-input-marker) + ;; Mimic what `move-beginning-of-line' does with invisible text. + (when-let ((erc-fill-wrap-merge) + (empty (get-text-property (point) 'display)) + ((string-empty-p empty))) + (goto-char (text-property-not-all (point) (pos-eol) 'display empty))))) (defun erc-fill--wrap-end-of-line (arg) "Defer to `move-end-of-line' or `end-of-visual-line'." @@ -389,6 +394,9 @@ See `erc-fill-wrap-mode' for details." (progn (skip-syntax-forward "^-") (forward-char) + ;; Using the `invisible' property might make more + ;; sense, but that would require coordination + ;; with other modules, like `erc-match'. (cond ((and erc-fill-wrap-merge (erc-fill--wrap-continued-message-p)) (put-text-property (point-min) (point) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 82b821503a8..c08a640260c 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -654,6 +654,8 @@ See `erc-log-match-format'." (defvar-local erc-match--hide-fools-offset-bounds nil) +;; FIXME this should merge with instead of overwrite existing +;; `invisible' values. (defun erc-hide-fools (match-type _nickuserhost _message) "Hide foolish comments. This function should be called from `erc-text-matched-hook'." diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 61f289a8753..f90a8fc50b1 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -198,13 +198,15 @@ may not be unique, `equal'-wise." This function is meant to be called from `erc-insert-modify-hook' or `erc-send-modify-hook'." - (unless (get-text-property (point-min) 'invisible) + (progn ; remove this `progn' on next major refactor (let* ((ct (erc-stamp--current-time)) + (invisible (get-text-property (point-min) 'invisible)) (erc-stamp--current-time ct)) - (funcall erc-insert-timestamp-function - (erc-format-timestamp ct erc-timestamp-format)) + (unless invisible + (funcall erc-insert-timestamp-function + (erc-format-timestamp ct erc-timestamp-format))) ;; FIXME this will error when advice has been applied. - (when (and (fboundp erc-insert-away-timestamp-function) + (when (and (not invisible) (fboundp erc-insert-away-timestamp-function) erc-away-timestamp-format (erc-away-time) (not erc-timestamp-format)) From 2e18ba6302f3e4aa5485eeaca39c747beb55ca8f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 10 Apr 2023 17:58:05 -0700 Subject: [PATCH 07/14] Simplify erc-button movement commands * etc/ERC-NEWS: Mention TAB being bound to new command `erc-tab' and `erc-previous-button' now stopping at the start of buttons. * lisp/erc/erc-button.el (erc-button-mode, erc-button-enable, erc-button-disable): Add and remove `erc-button-next' to `erc--tab-functions' hook, which is tantamount to binding the command in the read-only area of an ERC buffer. (erc-button-next-function): Deprecate and remove from client code path because this module doesn't concern itself with prompt input and thus no longer needs to conform to the `completion-at-point-functions' interface. (erc-button--prev-next-predicate-functions): New variable, a hook to determine whether to continue searching for a button. Other modules should utilize this as needed. (erc-button--end-of-button-p): Add function to serve as default value for `erc-button--continue-predicate'. (erc--button-next): Add generalized button-movement function. (erc-button-next, erc-button-previous): Make `erc-button-previous' behave more predictably by having it land at the beginning of buttons. And remove roundabout appeal to HOF in `erc-button-next'. (erc-button-previous-of-nick): New command to jump to previous appearance of nick at point. * lisp/erc/erc-fill.el (erc-fill-wrap, erc-fill-wrap-enable, erc-fill-wrap-disable): Add and remove merge-related hookee from `erc-button--prev-next-predicate-functions'. (erc-fill--wrap-merged-button-p): New function to detect redundant speakers. * lisp/erc/erc.el (erc-complete-functions): Quote TAB in doc string. (erc-mode-map): Bind `erc-tab' to TAB. (erc--tab-functions, erc-tab): Add new command and hook to serve as unified dispatch for TAB-related operations. It calls `c-a-p' in the input area and defers to module code in the read-only message area. * test/lisp/erc/erc-button-tests.el: New file. * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--wrap-populate): Run finalizer for transient keymap timer. * test/lisp/erc/erc-tests.el (erc-button--display-error-notice-with-keys): Move to new dedicated test file for erc-button and fix expected behavior of `erc-button-previous'. (Bug#62834) --- etc/ERC-NEWS | 18 +-- lisp/erc/erc-button.el | 91 +++++++++++---- lisp/erc/erc-fill.el | 10 +- lisp/erc/erc.el | 17 ++- test/lisp/erc/erc-button-tests.el | 177 ++++++++++++++++++++++++++++++ test/lisp/erc/erc-fill-tests.el | 2 + test/lisp/erc/erc-tests.el | 61 ---------- 7 files changed, 283 insertions(+), 93 deletions(-) create mode 100644 test/lisp/erc/erc-button-tests.el diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 57dce501760..2cf2743701a 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -128,9 +128,10 @@ renamed 'erc-ensure-target-buffer-on-privmsg'. Some minor quality-of-life niceties have finally made their way to ERC. For example, the function 'erc-echo-timestamp' is now interactive and can be invoked on any message to view its timestamp in -the echo area. Also, the 'irccontrols' module now supports additional -colors and special handling for "spoilers" (hidden text). And issuing -an "/MOTD" now dispatches a purpose-built command handler. +the echo area. The command 'erc-button-previous' now moves to the +beginning instead of the end of buttons. And the 'irccontrols' module +now supports additional colors and special handling for "spoilers" +(hidden text). ** Changes in the library API. @@ -199,10 +200,13 @@ example, requiring the use of 'insert-before-markers' instead of changes are encouraged to voice their concerns on the bug list. *** Miscellaneous changes -For autoloading purposes, 'Info-goto-node' has been supplanted by -plain old 'info' in 'erc-button-alist', and two helper macros from GNU -ELPA's Compat library are now available to third-party modules as -'erc-compat-call' and 'erc-compat-function'. +Two helper macros from GNU ELPA's Compat library are now available to +third-party modules as 'erc-compat-call' and 'erc-compat-function'. +In the area of buttons, 'Info-goto-node' has been supplanted by plain +old 'info' in 'erc-button-alist', primarily for autoloading purposes. +And the "TAB" key is now bound to a new command, 'erc-tab', that only +calls 'completion-at-point' when point is in the input area and +module-specific commands, like 'erc-button-next', otherwise. * Changes in ERC 5.5 diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 33e69f3b0b8..e2447deecde 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -55,11 +55,11 @@ ((erc-button--check-nicknames-entry) (add-hook 'erc-insert-modify-hook #'erc-button-add-buttons 'append) (add-hook 'erc-send-modify-hook #'erc-button-add-buttons 'append) - (add-hook 'erc-complete-functions #'erc-button-next-function) + (add-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map t "" #'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-complete-functions #'erc-button-next-function) + (remove-hook 'erc--tab-functions #'erc-button-next) (erc--modify-local-map nil "" #'erc-button-previous))) ;;; Variables @@ -529,6 +529,7 @@ call it with the value of the `erc-data' text property." (defun erc-button-next-function () "Pseudo completion function that actually jumps to the next button. For use on `completion-at-point-functions'." + (declare (obsolete erc-nickserv-identify "30.1")) ;; FIXME: This is an abuse of completion-at-point-functions. (when (< (point) (erc-beg-of-input-line)) (let ((start (point))) @@ -546,27 +547,73 @@ For use on `completion-at-point-functions'." (error "No next button")) t))))) -(defun erc-button-next () - "Go to the next button in this buffer." - (interactive) - (let ((f (erc-button-next-function))) - (if f (funcall f)))) +(defvar erc-button--prev-next-predicate-functions + '(erc-button--end-of-button-p) + "Abnormal hook whose members can return non-nil to continue searching. +Otherwise, if all members return nil, point will stay at the +current button. Called with a single arg, a buffer position +greater than `point-min' with a text property of `erc-callback'.") -(defun erc-button-previous () - "Go to the previous button in this buffer." - (interactive) - (let ((here (point))) - (when (< here (erc-beg-of-input-line)) - (while (and (get-text-property here 'erc-callback) - (not (= here (point-min)))) - (setq here (1- here))) - (while (and (not (get-text-property here 'erc-callback)) - (not (= here (point-min)))) - (setq here (1- here))) - (if (> here (point-min)) - (goto-char here) - (error "No previous button")) - t))) +(defun erc-button--end-of-button-p (point) + (get-text-property (1- point) 'erc-callback)) + +(defun erc--button-next (arg) + (let* ((nextp (prog1 (>= arg 1) (setq arg (max 1 (abs arg))))) + (search-fn (if nextp + #'next-single-char-property-change + #'previous-single-char-property-change)) + (start (point)) + (p start)) + (while (progn + ;; Break out of current search context. + (when-let ((low (max (point-min) (1- (pos-bol)))) + (high (min (point-max) (1+ (pos-eol)))) + (prop (get-text-property p 'erc-callback)) + (q (if nextp + (text-property-not-all p high + 'erc-callback prop) + (funcall search-fn p 'erc-callback nil low))) + ((< low q high))) + (setq p q)) + ;; Assume that buttons occur frequently enough that + ;; omitting LIMIT is acceptable. + (while + (and (setq p (funcall search-fn p 'erc-callback)) + (if nextp (< p erc-insert-marker) (/= p (point-min))) + (run-hook-with-args-until-success + 'erc-button--prev-next-predicate-functions p))) + (and arg + (< (point-min) p erc-insert-marker) + (goto-char p) + (not (zerop (cl-decf arg)))))) + (when (= (point) start) + (user-error (if nextp "No next button" "No previous button"))) + t)) + +(defun erc-button-next (&optional arg) + "Go to the ARGth next button." + (declare (advertised-calling-convention (arg) "30.1")) + (interactive "p") + (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg))) + (erc--button-next arg)) + +(defun erc-button-previous (&optional arg) + "Go to ARGth previous button." + (declare (advertised-calling-convention (arg) "30.1")) + (interactive "p") + (setq arg (pcase arg ((pred listp) (prefix-numeric-value arg)) (_ arg))) + (erc--button-next (- arg))) + +(defun erc-button-previous-of-nick (arg) + "Go to ARGth previous button for nick at point." + (interactive "p") + (if-let* ((prop (get-text-property (point) 'erc-data)) + (erc-button--prev-next-predicate-functions + (cons (lambda (p) + (not (equal (get-text-property p 'erc-data) prop))) + erc-button--prev-next-predicate-functions))) + (erc--button-next (- arg)) + (user-error "No nick at point"))) (defun erc-browse-emacswiki (thing) "Browse to THING in the emacs-wiki." diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index a56134d8188..bf995a5a5e6 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -300,7 +300,9 @@ of the minor-mode toggles as usual." (setq msg (concat msg (and msg " ") (erc-fill--make-module-dependency-msg "button")))) (erc-with-server-buffer - (erc-button-mode +1)))) + (erc-button-mode +1))) + (add-hook 'erc-button--prev-next-predicate-functions + #'erc-fill--wrap-merged-button-p nil t)) ;; Set local value of user option (can we avoid this somehow?) (unless (eq erc-fill-function #'erc-fill-wrap) (setq-local erc-fill-function #'erc-fill-wrap)) @@ -328,6 +330,8 @@ of the minor-mode toggles as usual." (kill-local-variable 'erc-fill--wrap-value) (kill-local-variable 'erc-fill-function) (kill-local-variable 'erc-fill--wrap-visual-keys) + (remove-hook 'erc-button--prev-next-predicate-functions + #'erc-fill--wrap-merged-button-p t) (remove-function (local 'erc-stamp--insert-date-function) #'erc-fill--wrap-stamp-insert-prefixed-date) (visual-line-mode -1)) @@ -414,6 +418,10 @@ See `erc-fill-wrap-mode' for details." `((space :width (- erc-fill--wrap-value ,len)) (space :width erc-fill--wrap-value)))))) +;; FIXME use own text property to avoid false positives. +(defun erc-fill--wrap-merged-button-p (point) + (equal "" (get-text-property point 'display))) + ;; This is an experimental helper for third-party modules. You could, ;; for example, use this to automatically resize the prefix to a ;; fraction of the window's width on some event change. Another use diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 05b6b5bfd21..a439e2438b0 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -354,7 +354,7 @@ simply because we do not necessarily receive the QUIT event." :type 'hook) (defcustom erc-complete-functions nil - "These functions get called when the user hits TAB in ERC. + "These functions get called when the user hits \\`TAB' in ERC. Each function in turn is called until one returns non-nil to indicate it has handled the input." :group 'erc-hooks @@ -1231,7 +1231,7 @@ which the local user typed." (define-key map "\C-c\C-u" #'erc-kill-input) (define-key map "\C-c\C-x" #'erc-quit-server) (define-key map "\M-\t" #'ispell-complete-word) - (define-key map "\t" #'completion-at-point) + (define-key map "\t" #'erc-tab) ;; Suppress `font-lock-fontify-block' key binding since it ;; destroys face properties. @@ -4675,6 +4675,19 @@ This places `point' just after the prompt, or at the beginning of the line." (setq erc-input-ring-index nil)) (kill-line))) +(defvar erc--tab-functions nil + "Functions to try when user hits \\`TAB' outside of input area. +Called with a numeric prefix arg.") + +(defun erc-tab (&optional arg) + "Call `completion-at-point' when typing in the input area. +Otherwise call members of `erc--tab-functions' with raw prefix +ARG until one of them returns non-nil." + (interactive "P") + (if (>= (point) erc-input-marker) + (completion-at-point) + (run-hook-with-args-until-success 'erc--tab-functions arg))) + (defun erc-complete-word-at-point () (run-hook-with-args-until-success 'erc-complete-functions)) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el new file mode 100644 index 00000000000..ced08d117bc --- /dev/null +++ b/test/lisp/erc/erc-button-tests.el @@ -0,0 +1,177 @@ +;;; erc-button-tests.el --- Tests for erc-button -*- lexical-binding:t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'erc-button) + +(defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) + (declare (indent 1)) + (let ((msg (erc-format-privmessage speaker + (apply #'concat msg-parts) nil t))) + (erc-display-message nil nil (current-buffer) msg))) + +(defun erc-button-tests--populate (test) + (let ((inhibit-message noninteractive) + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + + (with-current-buffer + (cl-letf + (((symbol-function 'erc-server-connect) + (lambda (&rest _) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil)))) + + (erc-open "localhost" 6667 "tester" "Tester" 'connect + nil nil nil nil nil "tester" 'foonet)) + + (with-current-buffer (erc--open-target "#chan") + (erc-update-channel-member + "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-update-channel-member + "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t) + + (erc-display-message + nil 'notice (current-buffer) + (concat "This server is in debug mode and is logging all user I/O. " + "Blah alice (1) bob (2) blah.")) + + (funcall test)) + + (when noninteractive + (kill-buffer "#chan") + (kill-buffer))))) + +(ert-deftest erc-button-next () + (erc-button-tests--populate + (lambda () + (erc-button-tests--insert-privmsg "alice" + "(3) bob (4) come, you are a tedious fool: to the purpose.") + + (erc-button-tests--insert-privmsg "bob" + "(5) alice (6) Come me to what was done to her.") + + (should (= erc-input-marker (point))) + + ;; Break out of input area + (erc-button-previous 1) + (should (looking-at (rx "alice (6)"))) + + ;; No next button + (should-error (erc-button-next 1) :type 'user-error) + (should (looking-at (rx "alice (6)"))) + + ;; Next with negative arg is equivalent to previous + (erc-button-next -1) + (should (looking-at (rx "bob> (5)"))) + + ;; One past end of button + (forward-char 3) + (should (looking-at (rx "> (5)"))) + (should-not (get-text-property (point) 'erc-callback)) + (erc-button-previous 1) + (should (looking-at (rx "bob> (5)"))) + + ;; At end of button + (forward-char 2) + (should (looking-at (rx "b> (5)"))) + (erc-button-previous 1) + (should (looking-at (rx "bob (4)"))) + + ;; Skip multiple buttons back + (erc-button-previous 2) + (should (looking-at (rx "bob (2)"))) + + ;; Skip multiple buttons forward + (erc-button-next 2) + (should (looking-at (rx "bob (4)"))) + + ;; No error as long as some progress made + (erc-button-previous 100) + (should (looking-at (rx "alice (1)"))) + + ;; Error when no progress made + (should-error (erc-button-previous 1) :type 'user-error) + (should (looking-at (rx "alice (1)")))))) + +;; See also `erc-scenarios-networks-announced-missing' in +;; erc-scenarios-misc.el for a more realistic example. +(ert-deftest erc-button--display-error-notice-with-keys () + (with-current-buffer (get-buffer-create "*fake*") + (let ((mode erc-button-mode) + (inhibit-message noninteractive) + erc-modules + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) + (erc-mode) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (erc--initialize-markers (point) nil) + (erc-button-mode +1) + (should (equal (erc-button--display-error-notice-with-keys + "If \\[erc-bol] fails, " + "see \\[erc-bug] or `erc-mode-map'.") + "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) + (goto-char (point-min)) + + (ert-info ("Keymap substitution succeeds") + (erc-button-next 1) + (should (looking-at "C-a")) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (erc-button-press-button) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bol" nil t))) + (erc-button-next 1) + ;; End of interval correct + (erc-button-previous 1) + (should (looking-at "C-a fails"))) + + (ert-info ("Extended command mapping succeeds") + (erc-button-next 1) + (should (looking-at "M-x erc-bug")) + (erc-button-press-button) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (with-current-buffer "*Help*" + (goto-char (point-min)) + (should (search-forward "erc-bug" nil t)))) + + (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k + (erc-button-next 1) + (should (equal (get-text-property (point) 'font-lock-face) + '(erc-button erc-error-face))) + (should (eq (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq erc-button-face 'erc-button))) ; extent evaporates + + (ert-info ("Format when trailing args include non-strings") + (should (equal (erc-button--display-error-notice-with-keys + "abc" " %d def" " 45%s" 123 '\6) + "*** abc 123 def 456"))) + + (when noninteractive + (unless mode + (erc-button-mode -1)) + (kill-buffer "*Help*") + (kill-buffer))))) + +;;; erc-button-tests.el ends here diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el index e8dd25e8ea1..170436ffbaa 100644 --- a/test/lisp/erc/erc-fill-tests.el +++ b/test/lisp/erc/erc-fill-tests.el @@ -94,6 +94,8 @@ ;; Defend against non-local exits from `ert-skip' (unwind-protect (funcall test) + (when set-transient-map-timer + (timer-event-handler set-transient-map-timer)) (set-window-buffer (selected-window) original-window-buffer) (when noninteractive (while-let ((buf (pop erc-fill-tests--buffers))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 88b9babf206..5aaf7e499e3 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -2110,65 +2110,4 @@ connection." (put 'erc-mname-enable 'definition-name 'mname) (put 'erc-mname-disable 'definition-name 'mname)))))) - -;; XXX move erc-button tests to new file if more added. -(require 'erc-button) - -;; See also `erc-scenarios-networks-announced-missing' in -;; erc-scenarios-misc.el for a more realistic example. -(ert-deftest erc-button--display-error-notice-with-keys () - (with-current-buffer (get-buffer-create "*fake*") - (let ((mode erc-button-mode) - (inhibit-message noninteractive) - erc-modules - erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook) - (erc-mode) - (erc-tests--set-fake-server-process "sleep" "1") - (erc--initialize-markers (point) nil) - (erc-button-mode +1) - (should (equal (erc-button--display-error-notice-with-keys - "If \\[erc-bol] fails, " - "see \\[erc-bug] or `erc-mode-map'.") - "*** If C-a fails, see M-x erc-bug or `erc-mode-map'.")) - (goto-char (point-min)) - - (ert-info ("Keymap substitution succeeds") - (erc-button-next) - (should (looking-at "C-a")) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (erc-button-press-button) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bol" nil t))) - (erc-button-next) - (erc-button-previous) ; end of interval correct - (should (looking-at "a fails"))) - - (ert-info ("Extended command mapping succeeds") - (erc-button-next) - (should (looking-at "M-x erc-bug")) - (erc-button-press-button) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (with-current-buffer "*Help*" - (goto-char (point-min)) - (should (search-forward "erc-bug" nil t)))) - - (ert-info ("Symbol-description face preserved") ; mutated by d-e-n-w-k - (erc-button-next) - (should (equal (get-text-property (point) 'font-lock-face) - '(erc-button erc-error-face))) - (should (eq (get-text-property (point) 'mouse-face) 'highlight)) - (should (eq erc-button-face 'erc-button))) ; extent evaporates - - (ert-info ("Format when trailing args include non-strings") - (should (equal (erc-button--display-error-notice-with-keys - "abc" " %d def" " 45%s" 123 '\6) - "*** abc 123 def 456"))) - - (when noninteractive - (unless mode - (erc-button-mode -1)) - (kill-buffer "*Help*") - (kill-buffer))))) - ;;; erc-tests.el ends here From b0d761be0f9b0180566d7cde1ef2eea33402dd4e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 14 Apr 2023 00:07:31 -0700 Subject: [PATCH 08/14] Restore module var toggles in ERC's Custom buffers * lisp/erc/erc-common.el (erc--neuter-custom-variable-state): Remove function. ERC famously toggles global minor-mode vars during normal operations, which adds noise to its customization buffers because `customize-variable-state' always sees an activated module's mode variable as having "CHANGED". To suppress this annoyance, a workaround was employed that used a dishonest `:get' function to simply return the "saved value," when present. While this improved the Customize experience, it also misled users, which likely wasn't justified. (erc--make-show-me-widget): Add helper to avoid forward declarations. (erc--prepare-custom-module-type): Don't deprive users of a working minor-mode toggle. (erc--find-feature): New function to guess the feature of a module's containing library. (define-erc-module): Remove `:get' keyword. Specify `:require' instead, whose value may be nil. Users who currently have mode vars in their `custom-file' won't be impacted by this addition because those `custom-set-variables' entries will still lack a REQUEST list and hence won't incur a startup penalty. And new users intent on using the toggle will hopefully do so with the knowledge they're opting in to requiring ERC on startup, which is not the case if they follow the recommended practice of using `erc-modules' instead. (erc-with-server-buffer): Inline `erc-server-buffer'. * test/lisp/erc/erc-tests.el (erc-process-input-line): Use helper. (define-erc-module--global): Change expected expansion. (Bug#60935) --- lisp/erc/erc-common.el | 76 +++++++++++++++++++++++--------------- test/lisp/erc/erc-tests.el | 7 +--- 2 files changed, 49 insertions(+), 34 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 6c015c71ff9..708cdb0c422 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -32,6 +32,7 @@ (defvar erc-dbuf) (defvar erc-log-p) (defvar erc-modules) +(defvar erc-server-process) (defvar erc-server-users) (defvar erc-session-server) @@ -40,6 +41,9 @@ (declare-function erc-server-buffer "erc" nil) (declare-function widget-apply-action "wid-edit" (widget &optional event)) (declare-function widget-at "wid-edit" (&optional pos)) +(declare-function widget-create-child-and-convert "wid-edit" + (parent type &rest args)) +(declare-function widget-default-format-handler "wid-edit" (widget escape)) (declare-function widget-get-sibling "wid-edit" (widget)) (declare-function widget-move "wid-edit" (arg &optional suppress-echo)) (declare-function widget-type "wid-edit" (widget)) @@ -195,16 +199,6 @@ instead of a `set' state, which precludes any actual saving." (throw 'found found))) 'erc)) -(defun erc--neuter-custom-variable-state (variable) - "Lie to Customize about VARIABLE's true state. -Do so by always returning its standard value, namely nil." - ;; Make a module's global minor-mode toggle blind to Customize, so - ;; that `customize-variable-state' never sees it as "changed", - ;; regardless of its value. This snippet is - ;; `custom--standard-value' from Emacs 28+. - (cl-assert (null (eval (car (get variable 'standard-value)) t))) - nil) - ;; This exists as a separate, top-level function to prevent the byte ;; compiler from warning about widget-related dependencies not being ;; loaded at runtime. @@ -230,25 +224,42 @@ Do so by always returning its standard value, namely nil." (substitute-command-keys "\\[Custom-set]") (substitute-command-keys "\\[Custom-save]")))) +;; This stands apart to avoid needing forward declarations for +;; `wid-edit' functions in every file requiring `erc-common'. +(defun erc--make-show-me-widget (widget escape &rest plist) + (if (eq escape ?i) + (apply #'widget-create-child-and-convert widget 'push-button plist) + (widget-default-format-handler widget escape))) + (defun erc--prepare-custom-module-type (name) `(let* ((name (erc--normalize-module-symbol ',name)) (fmtd (format " `%s' " name))) `(boolean - :button-face '(custom-variable-obsolete custom-button) - :format "%{%t%}: %[Deprecated Toggle%] \n%h\n" + :format "%{%t%}: %i %[Deprecated Toggle%] %v \n%h\n" + :format-handler + ,(lambda (widget escape) + (erc--make-show-me-widget + widget escape + :button-face '(custom-variable-obsolete custom-button) + :tag "Show Me" + :action (apply-partially #'erc--tick-module-checkbox name) + :help-echo (lambda (_) + (let ((hasp (memq name erc-modules))) + (concat (if hasp "Remove" "Add") fmtd + (if hasp "from" "to") + " `erc-modules'."))))) + :action widget-toggle-action :documentation-property ,(lambda (_) (let ((hasp (memq name erc-modules))) - (concat "Setting a module's minor-mode variable is " - (propertize "ineffective" 'face 'error) - ".\nPlease " (if hasp "remove" "add") fmtd - (if hasp "from" "to") " `erc-modules' directly instead.\n" - "You can do so now by clicking the scary button above."))) - :help-echo ,(lambda (_) - (let ((hasp (memq name erc-modules))) - (concat (if hasp "Remove" "Add") fmtd - (if hasp "from" "to") " `erc-modules'."))) - :action ,(apply-partially #'erc--tick-module-checkbox name)))) + (concat + "Setting a module's minor-mode variable is " + (propertize "ineffective" 'face 'error) + ".\nPlease " (if hasp "remove" "add") fmtd + (if hasp "from" "to") " `erc-modules' directly instead.\n" + "You can do so now by clicking " + (propertize "Show Me" 'face 'custom-variable-obsolete) + " above.")))))) (defun erc--fill-module-docstring (&rest strings) (with-temp-buffer @@ -264,6 +275,12 @@ Do so by always returning its standard value, namely nil." (goto-char (point-min)) (nth 3 (read (current-buffer))))) +(defmacro erc--find-feature (name alias) + `(pcase (erc--find-group ',name ,(and alias (list 'quote alias))) + ('erc (and-let* ((file (or (macroexp-file-name) buffer-file-name))) + (intern (file-name-base file)))) + (v v))) + (defmacro define-erc-module (name alias doc enable-body disable-body &optional local-p) "Define a new minor mode using ERC conventions. @@ -310,7 +327,7 @@ if ARG is omitted or nil. \n%s" name name doc)) :global ,(not local-p) :group (erc--find-group ',name ,(and alias (list 'quote alias))) - ,@(unless local-p '(:get #'erc--neuter-custom-variable-state)) + ,@(unless local-p `(:require ',(erc--find-feature name alias))) ,@(unless local-p `(:type ,(erc--prepare-custom-module-type name))) (if ,mode (,enable) @@ -371,12 +388,13 @@ If no server buffer exists, return nil." (not (cdr body)) (special-variable-p (car body)))) (buffer (make-symbol "buffer"))) - `(let ((,buffer (erc-server-buffer))) - (when (buffer-live-p ,buffer) - ,(if varp - `(buffer-local-value ',(car body) ,buffer) - `(with-current-buffer ,buffer - ,@body)))))) + `(when-let* (((processp erc-server-process)) + (,buffer (process-buffer erc-server-process)) + ((buffer-live-p ,buffer))) + ,(if varp + `(buffer-local-value ',(car body) ,buffer) + `(with-current-buffer ,buffer + ,@body))))) (defmacro erc-with-all-buffers-of-server (process pred &rest forms) "Execute FORMS in all buffers which have same process as this server. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5aaf7e499e3..bafe418f0cd 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1289,15 +1289,12 @@ (erc-default-recipients '("#chan")) calls) (with-temp-buffer + (erc-tests--set-fake-server-process "sleep" "1") (cl-letf (((symbol-function 'erc-cmd-MSG) (lambda (line) (push line calls) (should erc--called-as-input-p) (funcall orig-erc-cmd-MSG line))) - ((symbol-function 'erc-server-buffer) - (lambda () (current-buffer))) - ((symbol-function 'erc-server-process-alive) - (lambda () t)) ((symbol-function 'erc-server-send-queue) #'ignore)) @@ -2018,7 +2015,7 @@ ARG is omitted or nil. Some docstring." :global t :group (erc--find-group 'mname 'malias) - :get #'erc--neuter-custom-variable-state + :require 'nil :type "mname" (if erc-mname-mode (erc-mname-enable) From 16306567706c9621cef169d0e992b9b3b08a9d7e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 17 Apr 2023 23:09:49 -0700 Subject: [PATCH 09/14] Don't send multiline commands as messages in ERC * lisp/erc/erc.el (erc-command-regexp): Relocate from further down in same file. (erc--check-prompt-input-for-multiline-command): Reject slash commands containing multiple lines during input validation and before running additional hooks. (erc--discard-trailing-multiline-nulls): Don't mark input that begins with a possible "slash command" as constituting a plain message just because it has a trailing newline. It's relatively easy to add a newline by accident, which can result in the unintended sharing of a command line. Also, ERC already has a /SAY command that allows a user to send a message starting a literal command. * test/lisp/erc/erc-tests.el (erc-send-whitespace-lines): Fix test to expect validation error when non-blank lines follow a slash command. (Bug#62947) --- lisp/erc/erc.el | 23 +++++++++++++++-------- test/lisp/erc/erc-tests.el | 16 ++++++++++++---- 2 files changed, 27 insertions(+), 12 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index a439e2438b0..8552023804a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6082,6 +6082,9 @@ submitted line to be intentional." (defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r))) +(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" + "Regular expression used for matching commands in ERC.") + (defun erc--blank-in-multiline-input-p (lines) "Detect whether LINES contains a blank line. When `erc-send-whitespace-lines' is in effect, return nil if @@ -6131,11 +6134,19 @@ is empty or consists of one or more spaces, tabs, or form-feeds." (erc-command-no-process-p string)) "ERC: No process running")) +(defun erc--check-prompt-input-for-multiline-command (line lines) + "Return non-nil when non-blank lines follow a command line." + (when (and (cdr lines) + (string-match erc-command-regexp line) + (seq-drop-while #'string-empty-p (reverse (cdr lines)))) + "Excess input after command line")) + (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process - erc--check-prompt-input-for-excess-lines) + erc--check-prompt-input-for-excess-lines + erc--check-prompt-input-for-multiline-command) "Validators for user input typed at prompt. Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns @@ -6190,19 +6201,15 @@ When the returned value is a string, pass it to `erc-error'.") erc-input-marker (erc-end-of-input-line))) -(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" - "Regular expression used for matching commands in ERC.") - (defun erc--discard-trailing-multiline-nulls (state) "Ensure last line of STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil. STATE is an `erc--input-split' object." (when (and erc-send-whitespace-lines (erc--input-split-lines state)) (let ((reversed (nreverse (erc--input-split-lines state)))) - (when (string-empty-p (car reversed)) - (pop reversed) - (setf (erc--input-split-cmdp state) nil)) - (nreverse (seq-drop-while #'string-empty-p reversed))))) + (while (and reversed (string-empty-p (car reversed))) + (setq reversed (cdr reversed))) + (setf (erc--input-split-lines state) (nreverse reversed))))) (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index bafe418f0cd..4725d289e5b 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1236,15 +1236,23 @@ (pcase-dolist (`(,p . ,q) '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n") ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n") - ("a b\nc\n\n" "c\n" "a b\n") - ("/a b\nc\n\n" "c\n" "/a b\n") - ("/a b\n\nc\n\n" "c\n" "\n" "/a b\n"))) + ("/a b\n\n\n" "/a b\n"))) (insert p) (erc-send-current-line) (erc-bol) (should (eq (point) (point-max))) (while q - (should (equal (funcall next) (list (pop q) nil t)))) + (should (pcase (funcall next) + (`(,cmd ,_ nil) (equal cmd (pop q)))))) + (should-not (funcall next)))) + + (ert-info ("Multiline command with non-blanks errors") + (dolist (p '("/a b\nc\n\n" "/a b\n/c\n\n" "/a b\n\nc\n\n" + "/a\n c\n" "/a\nb\n" "/a\n/b\n" "/a \n \n")) + (insert p) + (should-error (erc-send-current-line)) + (goto-char erc-input-marker) + (delete-region (point) (point-max)) (should-not (funcall next)))) (ert-info ("Multiline hunk with trailing whitespace not filtered") From 3a5a6fce957468be5ef0a8ac76fec8507c3e4e99 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 17 Apr 2023 00:01:15 -0700 Subject: [PATCH 10/14] Redo line splitting for outgoing messages in ERC * lisp/erc/erc-backend.el (erc--reject-unbreakable-lines): New variable, an escape hatch for somewhat regaining pre-5.6 line-splitting behavior. (erc--split-line): New utility function that doesn't rely on column-oriented filling. * lisp/erc/erc.el (erc--pre-send-split-functions): Append `erc--split-lines' to value. (erc--split-lines): New function to re-split current selection of lines. (erc-send-input): Hard-code line preparation instead of calling `erc--pre-send-split-functions', in order to bake in traditional behavior before move to "pre-splitting". * test/lisp/erc/erc-scenarios-base-split-line.el: New file. * test/lisp/erc/erc-tests.el (erc--split-line): New test. (erc-send-current-line): Don't expect a flood argument when interpreting a command because it's not passed along to the command's handler. This was previously misleading because it assigned undue significance to something that had no bearing on the fate of a command. * test/lisp/erc/resources/base/flood/ascii.eld: New file. * test/lisp/erc/resources/base/flood/koi8-r.eld: New file. * test/lisp/erc/resources/base/flood/utf-8.eld: New file. * test/lisp/erc/resources/erc-d/erc-d.el: Don't decode input. (Bug#62947) --- lisp/erc/erc-backend.el | 41 ++++ lisp/erc/erc.el | 41 ++-- .../lisp/erc/erc-scenarios-base-split-line.el | 202 ++++++++++++++++++ test/lisp/erc/erc-tests.el | 50 ++++- test/lisp/erc/resources/base/flood/ascii.eld | 49 +++++ test/lisp/erc/resources/base/flood/koi8-r.eld | 47 ++++ test/lisp/erc/resources/base/flood/utf-8.eld | 54 +++++ test/lisp/erc/resources/erc-d/erc-d.el | 2 +- 8 files changed, 467 insertions(+), 19 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-base-split-line.el create mode 100644 test/lisp/erc/resources/base/flood/ascii.eld create mode 100644 test/lisp/erc/resources/base/flood/koi8-r.eld create mode 100644 test/lisp/erc/resources/base/flood/utf-8.eld diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 0c970a9d586..bc8e603e10a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -572,6 +572,47 @@ If this is set to nil, never try to reconnect." ;;;; Helper functions +(defvar erc--reject-unbreakable-lines nil + "Signal an error when a line exceeds `erc-split-line-length'. +Sending such lines and hoping for the best is no longer supported +in ERC 5.6. This internal var exists as a possibly temporary +escape hatch for inhibiting their transmission.") + +(defun erc--split-line (longline) + (let* ((coding (erc-coding-system-for-target nil)) + (original-window-buf (window-buffer (selected-window))) + out) + (when (consp coding) + (setq coding (car coding))) + (setq coding (coding-system-change-eol-conversion coding 'unix)) + (unwind-protect + (with-temp-buffer + (set-window-buffer (selected-window) (current-buffer)) + (insert longline) + (goto-char (point-min)) + (while (not (eobp)) + (let ((upper (filepos-to-bufferpos erc-split-line-length + 'exact coding))) + (goto-char (or upper (point-max))) + (unless (eobp) + (skip-chars-backward "^ \t")) + (when (bobp) + (when erc--reject-unbreakable-lines + (user-error + (substitute-command-keys + (concat "Unbreakable line encountered " + "(Recover input with \\[erc-previous-command])")))) + (goto-char upper)) + (when-let ((cmp (find-composition (point) (1+ (point))))) + (if (= (car cmp) (point-min)) + (goto-char (nth 1 cmp)) + (goto-char (car cmp))))) + (cl-assert (/= (point-min) (point))) + (push (buffer-substring-no-properties (point-min) (point)) out) + (delete-region (point-min) (point))) + (or (nreverse out) (list ""))) + (set-window-buffer (selected-window) original-window-buf)))) + ;; From Circe (defun erc-split-line (longline) "Return a list of lines which are not too long for IRC. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8552023804a..bc2285a5560 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -909,6 +909,9 @@ Flooding is sending too much information to the server in too short of an interval, which may cause the server to terminate the connection. +Note that older code conflated rate limiting and line splitting. +Starting in ERC 5.6, this option no longer influences the latter. + See `erc-server-flood-margin' for other flood-related parameters.") ;; Script parameters @@ -1103,7 +1106,8 @@ The struct has three slots: ;; remove this hook and the struct completely. IOW, if you need this, ;; please say so. -(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls) +(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls + erc--split-lines) "Special hook for modifying individual lines in multiline prompt input. The functions are called with one argument, an `erc--input-split' struct, which they can optionally modify. @@ -6211,6 +6215,14 @@ an `erc--input-split' object." (setq reversed (cdr reversed))) (setf (erc--input-split-lines state) (nreverse reversed))))) +(defun erc--split-lines (state) + "Partition non-command input into lines of protocol-compliant length." + ;; Prior to ERC 5.6, line splitting used to be predicated on + ;; `erc-flood-protect' being non-nil. + (unless (erc--input-split-cmdp state) + (setf (erc--input-split-lines state) + (mapcan #'erc--split-line (erc--input-split-lines state))))) + (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. @@ -6241,23 +6253,22 @@ Return non-nil only if we actually send anything." :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) - (setq state (make-erc--input-split - :string (erc-input-string state) - :insertp (erc-input-insertp state) - :sendp (erc-input-sendp state) - :lines (split-string (erc-input-string state) - erc--input-line-delim-regexp) - :cmdp (string-match erc-command-regexp - (erc-input-string state)))) - (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) erc-send-this) - (let ((lines (erc--input-split-lines state))) - (if (and (erc--input-split-cmdp state) (not (cdr lines))) - (erc-process-input-line (concat (car lines) "\n") t nil) + (if-let* ((first (split-string (erc-input-string state) + erc--input-line-delim-regexp)) + (split (mapcan #'erc--split-line first)) + (lines (nreverse (seq-drop-while #'string-empty-p + (nreverse split)))) + ((string-match erc-command-regexp (car lines)))) + (progn + ;; Asking users what to do here might make more sense. + (cl-assert (not (cdr lines))) + ;; The `force' arg (here t) is ignored for command lines. + (erc-process-input-line (concat (car lines) "\n") t nil)) + (progn ; temporarily preserve indentation (dolist (line lines) - (dolist (line (or (and erc-flood-protect (erc-split-line line)) - (list line))) + (progn ; temporarily preserve indentation (when (erc-input-insertp state) (erc-display-msg line)) (erc-process-input-line (concat line "\n") diff --git a/test/lisp/erc/erc-scenarios-base-split-line.el b/test/lisp/erc/erc-scenarios-base-split-line.el new file mode 100644 index 00000000000..f6d888c1f28 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-base-split-line.el @@ -0,0 +1,202 @@ +;;; erc-scenarios-base-split-line.el --- ERC line splitting -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(ert-deftest erc-scenarios-base-split-line--koi8-r () + :tags '(:expensive-test) + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'koi8-r)) + (erc-encoding-coding-alist '(("#koi8" . cyrillic-koi8))) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#koi8"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#koi8")) + (funcall expect 10 "короче теперь") + (ert-info ("Message well within `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно")) + (funcall expect 1 "") + (funcall expect -0.1 "")) + + (ert-info ("Message over `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " будет разрыв строки непонятно где")) + (funcall expect 1 "") + (funcall expect 1 " разрыв"))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +(ert-deftest erc-scenarios-base-split-line--ascii () + :tags '(:expensive-test) + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (msg-432 (string-join (make-list 18 "twenty-three characters") " ")) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'ascii)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#ascii"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#ascii")) + (ert-info ("Message with spaces fits exactly") + (funcall expect 10 "Welcome") + (should (= (length (concat msg-432 " 12345678")) 440)) + (erc-scenarios-common-say (concat msg-432 " 12345678")) + (funcall expect 1 "") + ;; Sent in a single go, hence no second . + (funcall expect -0.1 "") + (funcall expect 0.1 "12345678")) + + (ert-info ("Message with spaces too long.") + (erc-scenarios-common-say (concat msg-432 " 123456789")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " 123456789")) + + (ert-info ("Message sans spaces fits exactly") + (erc-scenarios-common-say (make-string 440 ?x)) + (funcall expect 1 "") + ;; Sent in a single go, hence no second . + (funcall expect -0.1 "")) + + (ert-info ("Message sans spaces too long.") + (erc-scenarios-common-say (concat (make-string 440 ?y) "z")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " z")) + + (ert-info ("Rejected when escape-hatch set") + (let ((erc--reject-unbreakable-lines t)) + (should-error + (erc-scenarios-common-say + (concat + "https://mail.example.org/verify?token=" + (string-join (make-list 18 "twenty-three_characters") "_"))))))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +(ert-deftest erc-scenarios-base-split-line--utf-8 () + :tags '(:expensive-test) + (unless (> emacs-major-version 27) + (ert-skip "No emojis in Emacs 27")) + + (should (equal erc-split-line-length 440)) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/flood") + (msg-432 (string-join (make-list 18 "twenty-three characters") " ")) + (erc-server-flood-penalty 0.1) + (dumb-server (erc-d-run "localhost" t 'utf-8)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect to server") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :full-name "tester") + (funcall expect 10 "debug mode") + (erc-cmd-JOIN "#utf-8"))) + + (with-current-buffer (erc-d-t-wait-for 8 (get-buffer "#utf-8")) + (funcall expect 10 "Welcome") + + (ert-info ("Message with spaces over `erc-split-line-length'") + (erc-scenarios-common-say + (concat + "короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " короче теперь если по русски написать все четко или все равно" + " будет разрыв строки непонятно где" + " будет разрыв строки непонятно где")) + (funcall expect 1 " короче") + (funcall expect 1 " все") + (funcall expect 1 " разрыв") + (funcall expect 1 "Entirely honour")) + + (ert-info ("Message sans spaces over `erc-split-line-length'") + (erc-scenarios-common-say + (concat "話說天下大勢，分久必合，合久必分：周末七國分爭，并入於秦。" + "及秦滅之後，楚、漢分爭，又并入於漢。漢朝自高祖斬白蛇而起義，" + "一統天下。後來光武中興，傳至獻帝，遂分為三國。推其致亂之由，" + "殆始於桓、靈二帝。桓帝禁錮善類，崇信宦官。及桓帝崩，靈帝即位，" + "大將軍竇武、太傅陳蕃，共相輔佐。時有宦官曹節等弄權，竇武、陳蕃謀誅之，" + "作事不密，反為所害。中涓自此愈橫")) + (funcall expect 1 "") + ;; Sent in two passes, split at last word. + (funcall expect 0.1 " 竇武") + (funcall expect 1 "this prey out")) + + ;; Combining emojis are respected. + (ert-info ("Message sans spaces over small `erc-split-line-length'") + (let ((erc-split-line-length 100)) + (erc-scenarios-common-say + "будет разрыв строки непонятно где🏁🚩🎌🏴🏳️🏳️‍🌈🏳️‍⚧️🏴‍☠️")) + (funcall expect 1 "") + (funcall expect 1 " 🏳️‍🌈"))) + + (with-current-buffer "foonet" + (erc-cmd-QUIT "") + (funcall expect 10 "finished")))) + +;;; erc-scenarios-base-split-line.el ends here diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 4725d289e5b..b6702617aeb 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1044,6 +1044,48 @@ (kill-buffer "*erc-protocol*") (should-not erc-debug-irc-protocol))) +(ert-deftest erc--split-line () + (let ((erc-default-recipients '("#chan")) + (erc-split-line-length 10)) + (should (equal (erc--split-line "") '(""))) + (should (equal (erc--split-line "0123456789") '("0123456789"))) + (should (equal (erc--split-line "0123456789a") '("0123456789" "a"))) + + (should (equal (erc--split-line "0123456789 ") '("0123456789" " "))) + (should (equal (erc--split-line "01234567 89") '("01234567 " "89"))) + (should (equal (erc--split-line "0123456 789") '("0123456 " "789"))) + (should (equal (erc--split-line "0 123456789") '("0 " "123456789"))) + (should (equal (erc--split-line " 0123456789") '(" " "0123456789"))) + (should (equal (erc--split-line "012345678 9a") '("012345678 " "9a"))) + (should (equal (erc--split-line "0123456789 a") '("0123456789" " a"))) + + ;; UTF-8 vs. KOI-8 + (should (= 10 (string-bytes "Русск"))) ; utf-8 + (should (equal (erc--split-line "Русск") '("Русск"))) + (should (equal (erc--split-line "РусскийТекст") '("Русск" "ийТек" "ст"))) + (should (equal (erc--split-line "Русский Текст") '("Русск" "ий " "Текст"))) + (let ((erc-encoding-coding-alist '(("#chan" . cyrillic-koi8)))) + (should (equal (erc--split-line "Русск") '("Русск"))) + (should (equal (erc--split-line "РусскийТекст") '("РусскийТек" "ст"))) + (should (equal (erc--split-line "Русский Текст") '("Русский " "Текст")))) + + ;; UTF-8 vs. Latin 1 + (should (= 17 (string-bytes "Hyvää päivää"))) + (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää"))) + (should (equal (erc--split-line "HyvääPäivää") '("HyvääPä" "ivää"))) + (let ((erc-encoding-coding-alist '(("#chan" . latin-1)))) + (should (equal (erc--split-line "Hyvää päivää") '("Hyvää " "päivää"))) + (should (equal (erc--split-line "HyvääPäivää") '("HyvääPäivä" "ä")))) + + ;; Combining characters + (should (= 10 (string-bytes "Åström"))) + (should (equal (erc--split-line "_Åström") '("_Åströ" "m"))) + (should (equal (erc--split-line "__Åström") '("__Åstr" "öm"))) + (should (equal (erc--split-line "___Åström") '("___Åstr" "öm"))) + (when (> emacs-major-version 27) + (should (equal (erc--split-line "🏁🚩🎌🏴🏳️🏳️‍🌈🏳️‍⚧️🏴‍☠️") + '("🏁🚩" "🎌🏴" "🏳️" "🏳️‍🌈" "🏳️‍⚧️" "🏴‍☠️")))))) + (ert-deftest erc--input-line-delim-regexp () (let ((p erc--input-line-delim-regexp)) ;; none @@ -1181,8 +1223,9 @@ (ert-info ("Input cleared") (erc-bol) (should (eq (point) (point-max)))) - ;; Commands are forced (no flood protection) - (should (equal (funcall next) '("/msg #chan hi\n" t nil)))) + ;; The `force' argument is irrelevant here because it can't + ;; influence dispatched handlers, such as `erc-cmd-MSG'. + (should (pcase (funcall next) (`("/msg #chan hi\n" ,_ nil) t)))) (ert-info ("Simple non-command") (insert "hi") @@ -1190,7 +1233,8 @@ (should (eq (point) (point-max))) (should (save-excursion (forward-line -1) (search-forward " hi"))) - ;; Non-ommands are forced only when `erc-flood-protect' is nil + ;; Non-commands are forced only when `erc-flood-protect' is + ;; nil, which conflates two orthogonal concerns. (should (equal (funcall next) '("hi\n" nil t)))) (should (consp erc-last-input-time))))) diff --git a/test/lisp/erc/resources/base/flood/ascii.eld b/test/lisp/erc/resources/base/flood/ascii.eld new file mode 100644 index 00000000000..a3d127326c3 --- /dev/null +++ b/test/lisp/erc/resources/base/flood/ascii.eld @@ -0,0 +1,49 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":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.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-spam 10 "JOIN #ascii") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #ascii") + (0 ":irc.foonet.org 353 tester = #ascii :alice tester @bob") + (0 ":irc.foonet.org 366 tester #ascii :End of NAMES list")) + +((mode-spam 10 "MODE #ascii") + (0 ":irc.foonet.org 324 tester #ascii +nt") + (0 ":irc.foonet.org 329 tester #ascii 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #ascii :tester, welcome!")) + +((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters 12345678")) +((privmsg 10 "PRIVMSG #ascii :twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters twenty-three characters ")) +((privmsg 10 "PRIVMSG #ascii :123456789")) +((privmsg 10 "PRIVMSG #ascii :xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")) +((privmsg 10 "PRIVMSG #ascii :yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy")) +((privmsg 10 "PRIVMSG #ascii :z")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/base/flood/koi8-r.eld b/test/lisp/erc/resources/base/flood/koi8-r.eld new file mode 100644 index 00000000000..0f10717fc2c --- /dev/null +++ b/test/lisp/erc/resources/base/flood/koi8-r.eld @@ -0,0 +1,47 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":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.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-chan 6 "JOIN #koi8") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #koi8") + (0 ":irc.foonet.org 353 tester = #koi8 :alice tester @bob") + (0 ":irc.foonet.org 366 tester #koi8 :End of NAMES list")) + +((mode-chan 8 "MODE #koi8") + (0 ":irc.foonet.org 324 tester #koi8 +nt") + (0 ":irc.foonet.org 329 tester #koi8 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :tester, welcome!") + (0.0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317")) + +((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317")) +((privmsg 10 "PRIVMSG #koi8 :\313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \313\317\322\317\336\305 \324\305\320\305\322\330 \305\323\314\311 \320\317 \322\325\323\323\313\311 \316\301\320\311\323\301\324\330 \327\323\305 \336\305\324\313\317 \311\314\311 \327\323\305 \322\301\327\316\317 \302\325\304\305\324 ")) +((privmsg 10 "PRIVMSG #koi8 :\322\301\332\322\331\327 \323\324\322\317\313\311 \316\305\320\317\316\321\324\316\317 \307\304\305")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/base/flood/utf-8.eld b/test/lisp/erc/resources/base/flood/utf-8.eld new file mode 100644 index 00000000000..8e7f8f7eed2 --- /dev/null +++ b/test/lisp/erc/resources/base/flood/utf-8.eld @@ -0,0 +1,54 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Mar 2023 02:30:29 UTC") + (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.00 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1 server(s)") + (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.00 ":irc.foonet.org 254 tester 1 :channels formed") + (0.00 ":irc.foonet.org 255 tester :I have 3 clients and 0 servers") + (0.00 ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3") + (0.00 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") + (0.00 ":irc.foonet.org 375 tester :- irc.foonet.org Message of the day - ") + (0.00 ":irc.foonet.org 372 tester :- This is the default Ergo MOTD.") + (0.01 ":irc.foonet.org 372 tester :- ") + (0.02 ":irc.foonet.org 372 tester :- For more information on using these, see MOTDFORMATTING.md") + (0.00 ":irc.foonet.org 376 tester :End of MOTD command")) + +((mode-tester 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.00 ":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.") + (0.05 ":irc.foonet.org 221 tester +i")) + +((join-spam 10 "JOIN #utf-8") + (0 ":tester!~u@9g6b728983yd2.irc JOIN #utf-8") + (0 ":irc.foonet.org 353 tester = #utf-8 :alice tester @bob") + (0 ":irc.foonet.org 366 tester #utf-8 :End of NAMES list")) + +((mode-spam 10 "MODE #utf-8") + (0 ":irc.foonet.org 324 tester #utf-8 +nt") + (0 ":irc.foonet.org 329 tester #utf-8 1620104779") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :tester, welcome!")) + +((privmsg-a 10 "PRIVMSG #utf-8 :\320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 ")) +((privmsg-b 10 "PRIVMSG #utf-8 :\320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\272\320\276\321\200\320\276\321\207\320\265 \321\202\320\265\320\277\320\265\321\200\321\214 \320\265\321\201\320\273\320\270 \320\277\320\276 \321\200\321\203\321\201\321\201\320\272\320\270 \320\275\320\260\320\277\320\270\321\201\320\260\321\202\321\214 \320\262\321\201\320\265 \321\207\320\265\321\202\320\272\320\276 \320\270\320\273\320\270 \320\262\321\201\320\265 \321\200\320\260\320\262\320\275\320\276 \320\261\321\203\320\264\320\265\321\202 \321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265 \320\261\321\203\320\264\320\265\321\202 ")) +((privmsg-c 10 "PRIVMSG #utf-8 :\321\200\320\260\320\267\321\200\321\213\320\262 \321\201\321\202\321\200\320\276\320\272\320\270 \320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276 \320\263\320\264\320\265") + (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :alice: Entirely honour; I would not be delay'd.")) + +((privmsg-g 10 "PRIVMSG #utf-8 :\350\251\261\350\252\252\345\244\251\344\270\213\345\244\247\345\213\242\357\274\214\345\210\206\344\271\205\345\277\205\345\220\210\357\274\214\345\220\210\344\271\205\345\277\205\345\210\206\357\274\232\345\221\250\346\234\253\344\270\203\345\234\213\345\210\206\347\210\255\357\274\214\345\271\266\345\205\245\346\226\274\347\247\246\343\200\202\345\217\212\347\247\246\346\273\205\344\271\213\345\276\214\357\274\214\346\245\232\343\200\201\346\274\242\345\210\206\347\210\255\357\274\214\345\217\210\345\271\266\345\205\245\346\226\274\346\274\242\343\200\202\346\274\242\346\234\235\350\207\252\351\253\230\347\245\226\346\226\254\347\231\275\350\233\207\350\200\214\350\265\267\347\276\251\357\274\214\344\270\200\347\265\261\345\244\251\344\270\213\343\200\202\345\276\214\344\276\206\345\205\211\346\255\246\344\270\255\350\210\210\357\274\214\345\202\263\350\207\263\347\215\273\345\270\235\357\274\214\351\201\202\345\210\206\347\202\272\344\270\211\345\234\213\343\200\202\346\216\250\345\205\266\350\207\264\344\272\202\344\271\213\347\224\261\357\274\214\346\256\206\345\247\213\346\226\274\346\241\223\343\200\201\351\235\210\344\272\214\345\270\235\343\200\202\346\241\223\345\270\235\347\246\201\351\214\256\345\226\204\351\241\236\357\274\214\345\264\207\344\277\241\345\256\246\345\256\230\343\200\202\345\217\212\346\241\223\345\270\235\345\264\251\357\274\214\351\235\210\345\270\235\345\215\263\344\275\215\357\274\214\345\244\247\345\260\207\350\273\215\347\253\207\346\255\246\343\200\201\345\244\252\345\202\205\351\231\263\350\225\203\357\274\214\345\205\261\347\233\270\350\274\224\344\275\220\343\200\202\346\231\202\346\234\211\345\256\246\345\256\230\346\233\271\347\257\200\347\255\211\345\274\204\346\254\212\357\274\214")) +((privmsg-h 10 "PRIVMSG #utf-8 :\347\253\207\346\255\246\343\200\201\351\231\263\350\225\203\350\254\200\350\252\205\344\271\213\357\274\214\344\275\234\344\272\213\344\270\215\345\257\206\357\274\214\345\217\215\347\202\272\346\211\200\345\256\263\343\200\202\344\270\255\346\266\223\350\207\252\346\255\244\346\204\210\346\251\253") + (0.0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #utf-8 :Shall seize this prey out of his father's hands.")) + +((privmsg-d 10 "PRIVMSG #utf-8 :\320\261\321\203\320\264\320\265\321\202\302\240\321\200\320\260\320\267\321\200\321\213\320\262\302\240\321\201\321\202\321\200\320\276\320\272\320\270\302\240\320\275\320\265\320\277\320\276\320\275\321\217\321\202\320\275\320\276\302\240\320\263\320\264\320\265\360\237\217\201\360\237\232\251\360\237\216\214\360\237\217\264\360\237\217\263\357\270\217")) +((privmsg-e 10 "PRIVMSG #utf-8 :\360\237\217\263\357\270\217\342\200\215\360\237\214\210\360\237\217\263\357\270\217\342\200\215\342\232\247\357\270\217\360\237\217\264\342\200\215\342\230\240\357\270\217")) + +((quit 10 "QUIT :\2ERC\2") + (0.07 ":tester!~u@h3f95zveyc38a.irc QUIT :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)") + (0.01 "ERROR :Quit: \2ERC\2 5.5 (IRC client for GNU Emacs 30.0.50)")) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index 43f6552f0f3..e9d880644d4 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -456,7 +456,7 @@ including line delimiters." (setq string (unless (= (match-end 0) (length string)) (substring string (match-end 0)))) (erc-d--log process line nil) - (ring-insert queue (erc-d-i--parse-message line 'decode)))) + (ring-insert queue (erc-d-i--parse-message line nil)))) (when string (setf (process-get process :stashed-input) string)))) From 35dd1ade7f1e583f736e6f707343402fe868daec Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 30 Apr 2023 07:12:56 -0700 Subject: [PATCH 11/14] Preprocess prompt input linewise in ERC * etc/ERC-NEWS: Mention revised role of `erc-pre-send-functions' relative to line splitting. * lisp/erc/erc-common.el (erc-input): Add new slot `refoldp' to allow `erc-pre-send-functions' members to indicate that splitting should occur a second time after all members have had their say. (erc--input-split): Specify some defaults for overridden slots and explicitly declare some types for good measure. * lisp/erc/erc-goodies.el (erc-noncommands-mode, erc-noncommands-enable, erc-noncommands-disable): Replace `erc-pre-send-functions' with `erc--input-review-functions'. * lisp/erc/erc-ring.el (erc-ring-enable, erc-ring-disable, erc-ring-mode): Subscribe to `erc--input-review-functions' instead of `erc-pre-send-functions' for `erc--add-to-input-ring'. * lisp/erc/erc.el (erc-pre-send-functions): Note some nuances regarding line splitting in doc string and note that a new slot is available. (erc--pre-send-split-functions, erc--input-review-functions): Rename former to latter, while also obsoleting. Remove large comment. Add new default member `erc--run-input-validation-checks'. (erc-send-modify-hook): Replace the obsolete `erc-send-pre-hook' and `erc-send-this' with `erc-pre-send-functions' in doc string. (erc--check-prompt-input-for-excess-lines): Don't trim trailing blanks. Rework to also report overages in characters as well as lines. (erc--run-input-validation-hooks): New function to adapt an `erc--input-split' object to `erc--check-prompt-input-functions'. (erc-send-current-line): Run `erc--input-review-functions' in place of the validation hooks they've subsumed. Call `erc--send-input-lines' instead of the now retired but not deprecated `erc-send-input'. (erc--run-send-hooks, erc--send-input-lines): New functions that together form an alternate version of `erc-send-input'. They operate on input linewise but make accommodations for older interfaces. * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Replace `erc-pre-send-functions' with `erc--input-review-functions'. (erc-tests--with-process-input-spy): Shadow `erc--input-review-functions'. (erc-check-prompt-input-for-excess-lines): Don't expect trailing blanks to be trimmed. (erc--run-send-hooks): New test. (Bug#62947) --- etc/ERC-NEWS | 6 ++ lisp/erc/erc-common.el | 12 +++- lisp/erc/erc-goodies.el | 5 +- lisp/erc/erc-ring.el | 4 +- lisp/erc/erc.el | 135 +++++++++++++++++++++++++++---------- test/lisp/erc/erc-tests.el | 101 +++++++++++++++++++++++++-- 6 files changed, 217 insertions(+), 46 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 2cf2743701a..3907b7bc5f2 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -187,6 +187,12 @@ The 'fill' module is now defined by 'define-erc-module'. The same goes for ERC's imenu integration, which has 'imenu' now appearing in the default value of 'erc-modules'. +*** Prompt input is split before 'erc-pre-send-functions' has a say. +Hook members are now treated to input whose lines have already been +adjusted to fall within the allowed length limit. For convenience, +third-party code can request that the final input be "re-filled" prior +to being sent. See doc string for details. + *** ERC's prompt survives the insertion of user input and messages. Previously, ERC's prompt and its input marker disappeared while running hooks during message insertion, and the position of its diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 708cdb0c422..86d78768374 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -30,8 +30,10 @@ (defvar erc--casemapping-rfc1459-strict) (defvar erc-channel-users) (defvar erc-dbuf) +(defvar erc-insert-this) (defvar erc-log-p) (defvar erc-modules) +(defvar erc-send-this) (defvar erc-server-process) (defvar erc-server-users) (defvar erc-session-server) @@ -49,10 +51,14 @@ (declare-function widget-type "wid-edit" (widget)) (cl-defstruct erc-input - string insertp sendp) + string insertp sendp refoldp) -(cl-defstruct (erc--input-split (:include erc-input)) - lines cmdp) +(cl-defstruct (erc--input-split (:include erc-input + (string :read-only) + (insertp erc-insert-this) + (sendp erc-send-this))) + (lines nil :type (list-of string)) + (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) ;; User data diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6235de5f1c0..cc60ba0018b 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -338,8 +338,9 @@ does not appear in the ERC buffer after the user presses ENTER.") "This mode distinguishes non-commands. Commands listed in `erc-insert-this' know how to display themselves." - ((add-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands)) - ((remove-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands))) + ((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands)) + ((remove-hook 'erc--input-review-functions + #'erc-send-distinguish-noncommands))) (defun erc-send-distinguish-noncommands (state) "If STR is an ERC non-command, set `insertp' in STATE to nil." diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 2451ac56f6f..4534e913204 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -46,10 +46,10 @@ (define-erc-module ring nil "Stores input in a ring so that previous commands and messages can be recalled using M-p and M-n." - ((add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((add-hook 'erc--input-review-functions #'erc-add-to-input-ring 90) (define-key erc-mode-map "\M-p" #'erc-previous-command) (define-key erc-mode-map "\M-n" #'erc-next-command)) - ((remove-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + ((remove-hook 'erc--input-review-functions #'erc-add-to-input-ring) (define-key erc-mode-map "\M-p" #'undefined) (define-key erc-mode-map "\M-n" #'undefined))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index bc2285a5560..72ec8134eab 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1094,34 +1094,40 @@ The struct has three slots: `string': The current input string. `insertp': Whether the string should be inserted into the erc buffer. - `sendp': Whether the string should be sent to the irc server." + `sendp': Whether the string should be sent to the irc server. + `refoldp': Whether the string should be re-split per protocol limits. + +This hook runs after protocol line splitting has taken place, so +the value of `string' is originally \"pre-filled\". If you need +ERC to refill the entire payload before sending it, set the +`refoldp' slot to a non-nil value. Preformatted text and encoded +subprotocols should probably be handled manually." :group 'erc :type 'hook :version "27.1") -;; This is being auditioned for possible exporting (as a custom hook -;; option). Likewise for (public versions of) `erc--input-split' and -;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just -;; run the latter on the input after `erc-pre-send-functions', and -;; remove this hook and the struct completely. IOW, if you need this, -;; please say so. - -(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls - erc--split-lines) - "Special hook for modifying individual lines in multiline prompt input. -The functions are called with one argument, an `erc--input-split' -struct, which they can optionally modify. +(define-obsolete-variable-alias 'erc--pre-send-split-functions + 'erc--input-review-functions "30.1") +(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls + erc--split-lines + erc--run-input-validation-checks) + "Special hook for reviewing and modifying prompt input. +ERC runs this before clearing the prompt and before running any +send-related hooks, such as `erc-pre-send-functions'. Thus, it's +quite \"safe\" to bail out of this hook with a `user-error', if +necessary. The hook's members are called with one argument, an +`erc--input-split' struct, which they can optionally modify. The struct has five slots: - `string': the input string delivered by `erc-pre-send-functions' - `insertp': whether to insert the lines into the buffer - `sendp': whether the lines should be sent to the IRC server + `string': the original input as a read-only reference + `insertp': same as in `erc-pre-send-functions' + `sendp': same as in `erc-pre-send-functions' + `refoldp': same as in `erc-pre-send-functions' `lines': a list of lines to be sent, each one a `string' `cmdp': whether to interpret input as a command, like /ignore -The `string' field is effectively read-only. When `cmdp' is -non-nil, all but the first line will be discarded.") +When `cmdp' is non-nil, all but the first line will be discarded.") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -1163,8 +1169,8 @@ preserve point if needed." (defcustom erc-send-modify-hook nil "Sending hook for functions that will change the text's appearance. -This hook is called just after `erc-send-pre-hook' when the values -of `erc-send-this' and `erc-insert-this' are both t. +ERC runs this just after `erc-pre-send-functions' if its shared +`erc-input' object's `sendp' and `insertp' slots remain non-nil. While this hook is run, narrowing is in effect and `current-buffer' is the buffer where the text got inserted. @@ -6106,16 +6112,18 @@ is empty or consists of one or more spaces, tabs, or form-feeds." (defun erc--check-prompt-input-for-excess-lines (_ lines) "Return non-nil when trying to send too many LINES." (when erc-inhibit-multiline-input - ;; Assume `erc--discard-trailing-multiline-nulls' is set to run - (let ((reversed (seq-drop-while #'string-empty-p (reverse lines))) - (max (if (eq erc-inhibit-multiline-input t) + (let ((max (if (eq erc-inhibit-multiline-input t) 2 erc-inhibit-multiline-input)) (seen 0) - msg) - (while (and (pop reversed) (< (cl-incf seen) max))) + last msg) + (while (and lines (setq last (pop lines)) (< (cl-incf seen) max))) (when (= seen max) - (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (push last lines) + (setq msg + (format "-- exceeded by %d (%d chars)" + (length lines) + (apply #'+ (mapcar #'length lines)))) (unless (and erc-ask-about-multiline-input (y-or-n-p (concat "Send input " msg "?"))) (concat "Too many lines " msg)))))) @@ -6155,7 +6163,17 @@ is empty or consists of one or more spaces, tabs, or form-feeds." Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns non-nil, processing is abandoned and input is left untouched. -When the returned value is a string, pass it to `erc-error'.") +When the returned value is a string, ERC passes it to `erc-error'.") + +(defun erc--run-input-validation-checks (state) + "Run input checkers from STATE, an `erc--input-split' object." + (when-let ((msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (unless (stringp msg) + (setq msg (format "Input error: %S" msg))) + (user-error msg))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6170,12 +6188,15 @@ When the returned value is a string, pass it to `erc-error'.") (eolp)) (expand-abbrev)) (widen) - (if-let* ((str (erc-user-input)) - (msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions str - (split-string str erc--input-line-delim-regexp)))) - (when (stringp msg) - (erc-error msg)) + (let* ((str (erc-user-input)) + (state (make-erc--input-split + :string str + :insertp erc-insert-this + :sendp erc-send-this + :lines (split-string + str erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp str)))) + (run-hook-with-args 'erc--input-review-functions state) (let ((inhibit-read-only t) (old-buf (current-buffer))) (progn ; unprogn this during next major surgery @@ -6183,7 +6204,7 @@ When the returned value is a string, pass it to `erc-error'.") ;; Kill the input and the prompt (delete-region erc-input-marker (erc-end-of-input-line)) (unwind-protect - (erc-send-input str 'skip-ws-chk) + (erc--send-input-lines (erc--run-send-hooks state)) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf @@ -6223,6 +6244,52 @@ an `erc--input-split' object." (setf (erc--input-split-lines state) (mapcan #'erc--split-line (erc--input-split-lines state))))) +(defun erc--run-send-hooks (lines-obj) + "Run send-related hooks that operate on the entire prompt input. +Sequester some of the back and forth involved in honoring old +interfaces, such as the reconstituting and re-splitting of +multiline input. Optionally readjust lines to protocol length +limits and pad empty ones, knowing full well that additional +processing may still corrupt messages before they reach the send +queue. Expect LINES-OBJ to be an `erc--input-split' object." + (when (or erc-send-pre-hook erc-pre-send-functions) + (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) + (defvar str) ; see note in string `erc-send-input'. + (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) + (erc-send-this (erc--input-split-sendp lines-obj)) + (erc-insert-this (erc--input-split-insertp lines-obj)) + (state (progn + ;; This may change `str' and `erc-*-this'. + (run-hook-with-args 'erc-send-pre-hook str) + (make-erc-input :string str + :insertp erc-insert-this + :sendp erc-send-this)))) + (run-hook-with-args 'erc-pre-send-functions state) + (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state) + (erc--input-split-insertp lines-obj) (erc-input-insertp state) + ;; See note in test of same name re trailing newlines. + (erc--input-split-lines lines-obj) + (cl-nsubst " " "" (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :test #'equal)) + (when (erc-input-refoldp state) + (erc--split-lines lines-obj))))) + (when (and (erc--input-split-cmdp lines-obj) + (cdr (erc--input-split-lines lines-obj))) + (user-error "Multiline command detected" )) + 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) + (dolist (line (erc--input-split-lines lines-obj)) + (unless (erc--input-split-cmdp lines-obj) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line))) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) + (not (erc--input-split-cmdp lines-obj)))))) + (defun erc-send-input (input &optional skip-ws-chk) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index b6702617aeb..be5a566a268 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -942,8 +942,8 @@ (should-not (local-variable-if-set-p 'erc-send-completed-hook)) (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals) ;; Just in case erc-ring-mode is already on - (setq-local erc-pre-send-functions nil) - (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring) + (setq-local erc--input-review-functions nil) + (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) (lambda (&rest _) @@ -1156,7 +1156,9 @@ (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") - (let* ((erc-pre-send-functions + (let* ((erc--input-review-functions + (remove #'erc-add-to-input-ring erc--input-review-functions)) + (erc-pre-send-functions (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now (inhibit-message noninteractive) (erc-server-current-nick "tester") @@ -1314,13 +1316,14 @@ (ert-info ("With `erc-inhibit-multiline-input' as t (2)") (let ((erc-inhibit-multiline-input t)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" ""))) + ;; Does not trim trailing blanks. + (should (erc--check-prompt-input-for-excess-lines "" '("a" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) (ert-info ("With `erc-inhibit-multiline-input' as 3") (let ((erc-inhibit-multiline-input 3)) (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) - (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" ""))) (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "c"))))) (ert-info ("With `erc-ask-about-multiline-input'") @@ -1399,6 +1402,94 @@ (should-not calls)))))) + +;; The behavior of `erc-pre-send-functions' differs between versions +;; in how hook members see and influence a trailing newline that's +;; part of the original prompt submission: +;; +;; 5.4: both seen and sent +;; 5.5: seen but not sent* +;; 5.6: neither seen nor sent* +;; +;; * requires `erc-send-whitespace-lines' for hook to run +;; +;; Two aspects that have remained consistent are +;; +;; - a final nonempty line in any submission is always sent +;; - a trailing newline appended by a hook member is always sent +;; +;; The last bullet would seem to contradict the "not sent" behavior of +;; 5.5 and 5.6, but what's actually happening is that exactly one +;; trailing newline is culled, so anything added always goes through. +;; Also, in ERC 5.6, all empty lines are actually padded, but this is +;; merely incidental WRT the above. +;; +;; Note that this test doesn't run any input-prep hooks and thus can't +;; account for the "seen" dimension noted above. + +(ert-deftest erc--run-send-hooks () + (with-suppressed-warnings ((obsolete erc-send-this) + (obsolete erc-send-pre-hook)) + (should erc-insert-this) + (should erc-send-this) ; populates `erc--input-split-sendp' + + (let (erc-pre-send-functions erc-send-pre-hook) + + (ert-info ("String preserved, lines rewritten, empties padded") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "bar\n\nbaz\n"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("bar" " " "baz" " ")) (cmdp 'nil)) + t)))) + + (ert-info ("Multiline commands rejected") + (should-error (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)))) + + (ert-info ("Single-line commands pass") + (setq erc-pre-send-functions + (lambda (o) (setf (erc-input-sendp o) nil + (erc-input-string o) "/mycmd bar"))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "/mycmd foo" + :lines '("/mycmd foo") + :cmdp t)) + ((cl-struct erc--input-split + (string "/mycmd foo") (sendp 'nil) (insertp 't) + (lines '("/mycmd bar")) (cmdp 't)) + t)))) + + (ert-info ("Legacy hook respected, special vars confined") + (setq erc-send-pre-hook (lambda (_) (setq erc-send-this nil)) + erc-pre-send-functions (lambda (o) ; propagates + (should-not (erc-input-sendp o)))) + (should (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 'nil) (insertp 't) + (lines '("foo")) (cmdp 'nil)) + t))) + (should erc-send-this)) + + (ert-info ("Request to resplit honored") + (setq erc-send-pre-hook nil + erc-pre-send-functions + (lambda (o) (setf (erc-input-string o) "foo bar baz" + (erc-input-refoldp o) t))) + (let ((erc-split-line-length 8)) + (should + (pcase (erc--run-send-hooks (make-erc--input-split + :string "foo" :lines '("foo"))) + ((cl-struct erc--input-split + (string "foo") (sendp 't) (insertp 't) + (lines '("foo bar " "baz")) (cmdp 'nil)) + t)))))))) + ;; Note: if adding an erc-backend-tests.el, please relocate this there. (ert-deftest erc-message () From 5adda2f4683fe23efd659fc7418044c8230772c5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 15 Apr 2023 09:52:05 -0700 Subject: [PATCH 12/14] Revise FORM-as-function interface in erc-button-alist * lisp/erc/erc-button.el (erc-button-alist): Remove redundant "" entry, which adds nothing beyond highlighting the surrounding bookends at the expense of doubling up on face properties for no reason. Revise the FORM-as-function interface by removing the dynamic binding of face options and treating all implementers as replacements for `erc-button-add-button'. (erc-button--maybe-warn-arbitrary-sexp): Make more robust by having it handle all accepted FORM types other than booleans. (erc-button-add-buttons-1): Rework to only check FORM field once. (erc-button--substitute-command-keys-in-region, erc-button--display-error-with-buttons): Rename former as latter and change signature to conform to new `erc-button-add-buttons' interface. (erc-button--display-error-notice-with-keys): Call renamed helper. * test/lisp/erc/erc-button-tests.el (erc-button-alist--url, erc-button-tests--form, erc-button-tests--some-var, erc-button-tests--erc-button-alist--function-as-form, erc-button-alist--function-as-form, erc-button-tests--erc-button-alist--nil-form, erc-button-alist---nil-form): Add tests and helpers. (Bug#60933) --- etc/ERC-NEWS | 3 +- lisp/erc/erc-button.el | 91 +++++++++++++------------ test/lisp/erc/erc-button-tests.el | 106 ++++++++++++++++++++++++++++++ 3 files changed, 153 insertions(+), 47 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 3907b7bc5f2..f2a8eb72b95 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -209,7 +209,8 @@ changes are encouraged to voice their concerns on the bug list. Two helper macros from GNU ELPA's Compat library are now available to third-party modules as 'erc-compat-call' and 'erc-compat-function'. In the area of buttons, 'Info-goto-node' has been supplanted by plain -old 'info' in 'erc-button-alist', primarily for autoloading purposes. +old 'info' in 'erc-button-alist', and the bracketed "" +pattern entry has been removed because it was more or less redundant. And the "TAB" key is now bound to a new command, 'erc-tab', that only calls 'completion-at-point' when point is in the input area and module-specific commands, like 'erc-button-next', otherwise. diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index e2447deecde..7376c18ad4c 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -128,7 +128,6 @@ longer than `erc-fill-column'." ;; things hard to maintain. '((nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0) (erc-button-url-regexp 0 t browse-url-button-open-url 0) - (" ]+\\) *>" 0 t browse-url-button-open-url 1) ;;; ("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3) ;; emacs internal ("[`‘]\\([a-zA-Z][-a-zA-Z_0-9!*<=>+]+\\)['’]" @@ -166,17 +165,14 @@ REGEXP is the string matching text around the button or a symbol BUTTON is the number of the regexp grouping actually matching the button. This is ignored if REGEXP is `nicknames'. -FORM is a Lisp symbol for a special variable whose value must be - true for the button to be added. Alternatively, when REGEXP is - not `nicknames', FORM can be a function whose arguments are BEG - and END, the bounds of the button in the current buffer. It's - expected to return a cons of (possibly identical) bounds or - nil, to deny. For the extent of the call, all face options - defined for the button module are re-bound, shadowing - themselves, so the function is free to change their values. - When regexp is the special symbol `nicknames', FORM must be the - symbol `erc-button-buttonize-nicks'. Specifying anything else - is deprecated. +FORM is either a boolean or a special variable whose value must + be non-nil for the button to be added. When REGEXP is the + special symbol `nicknames', FORM must be the symbol + `erc-button-buttonize-nicks'. Anything else is deprecated. + For all other entries, FORM can also be a function to call in + place of `erc-button-add-button' with the exact same arguments. + When FORM is also a special variable, ERC disregards the + variable and calls the function. CALLBACK is the function to call when the user push this button. CALLBACK can also be a symbol. Its variable value will be used @@ -288,15 +284,18 @@ specified by `erc-button-alist'." entry))))))))))) (defun erc-button--maybe-warn-arbitrary-sexp (form) - (if (and (symbolp form) (special-variable-p form)) - (symbol-value form) - (unless (get 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp) - (put 'erc-button--maybe-warn-arbitrary-sexp 'warned-arbitrary-sexp t) - (lwarn 'erc :warning - (concat "Arbitrary sexps for the third FORM" - " slot of `erc-button-alist' entries" - " have been deprecated."))) - (eval form t))) + (cl-assert (not (booleanp form))) ; covered by caller + ;; If a special-variable is also a function, favor the function. + (cond ((functionp form) form) + ((and (symbolp form) (special-variable-p form)) (symbol-value form)) + (t (unless (get 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp) + (put 'erc-button--maybe-warn-arbitrary-sexp + 'warned-arbitrary-sexp t) + (lwarn 'erc :warning (concat "Arbitrary sexps for the third FORM" + " slot of `erc-button-alist' entries" + " have been deprecated."))) + (eval form t)))) (defun erc-button--check-nicknames-entry () ;; This helper exists because the module is defined after its options. @@ -412,22 +411,22 @@ early (outer), args-filtering advice wrapping (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry)) - (fun (nth 3 entry)) - (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) - (when (or (eq t form) - (and (functionp form) - (let* ((erc-button-face erc-button-face) - (erc-button-mouse-face erc-button-mouse-face) - (erc-button-nickname-face erc-button-nickname-face) - (rv (funcall form start end))) - (when rv - (setq end (cdr rv) start (car rv))))) - (erc-button--maybe-warn-arbitrary-sexp form)) - (erc-button-add-button start end fun nil data regexp))))) + (let (buttonizer) + (while + (and (re-search-forward regexp nil t) + (or buttonizer + (setq buttonizer + (and-let* + ((raw-form (nth 2 entry)) + (res (or (eq t raw-form) + (erc-button--maybe-warn-arbitrary-sexp + raw-form)))) + (if (functionp res) res #'erc-button-add-button))))) + (let ((start (match-beginning (nth 1 entry))) + (end (match-end (nth 1 entry))) + (fun (nth 3 entry)) + (data (mapcar #'match-string-no-properties (nthcdr 4 entry)))) + (funcall buttonizer start end fun nil data regexp))))) (defun erc-button-remove-old-buttons () "Remove all existing buttons. @@ -682,15 +681,15 @@ and `apropos' for other symbols." (message "@%s is %d:%02d local time" beats hours minutes))) -(defun erc-button--substitute-command-keys-in-region (beg end) +(defun erc-button--display-error-with-buttons + (from to fun nick-p &optional data regexp) "Replace command in region with keys and return new bounds" - (let* ((o (buffer-substring beg end)) - (s (substitute-command-keys o))) - (unless (equal o s) - (setq erc-button-face nil)) - (delete-region beg end) - (insert s)) - (cons beg (point))) + (let* ((o (buffer-substring from to)) + (s (substitute-command-keys o)) + (erc-button-face (and (equal o s) erc-button-face))) + (delete-region from to) + (insert s) + (erc-button-add-button from (point) fun nick-p data regexp))) ;;;###autoload (defun erc-button--display-error-notice-with-keys (&optional parsed buffer @@ -727,7 +726,7 @@ non-strings, concatenate leading string members before applying erc-insert-post-hook)) (erc-button-alist `((,(rx "\\[" (group (+ (not "]"))) "]") 0 - erc-button--substitute-command-keys-in-region + erc-button--display-error-with-buttons erc-button-describe-symbol 1) ,@erc-button-alist))) (erc-display-message parsed '(notice error) (or buffer 'active) string) diff --git a/test/lisp/erc/erc-button-tests.el b/test/lisp/erc/erc-button-tests.el index ced08d117bc..6a6f6934389 100644 --- a/test/lisp/erc/erc-button-tests.el +++ b/test/lisp/erc/erc-button-tests.el @@ -23,6 +23,112 @@ (require 'erc-button) +(ert-deftest erc-button-alist--url () + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + (with-current-buffer (erc--open-target "#chan") + (let ((verify + (lambda (p url) + (should (equal (get-text-property p 'erc-data) (list url))) + (should (equal (get-text-property p 'mouse-face) 'highlight)) + (should (eq (get-text-property p 'font-lock-face) 'erc-button)) + (should (eq (get-text-property p 'erc-callback) + 'browse-url-button-open-url))))) + (goto-char (point-min)) + + ;; Most common (unbracketed) + (erc-display-message nil nil (current-buffer) + "Foo https://example.com bar.") + (search-forward "https") + (funcall verify (point) "https://example.com") + + ;; The still works despite being removed in ERC 5.6. + (erc-display-message nil nil (current-buffer) + "Foo bar.") + (search-forward "https") + (funcall verify (point) "https://gnu.org") + + ;; Bracketed + (erc-display-message nil nil (current-buffer) "Foo bar.") + (search-forward "ftp") + (funcall verify (point) "ftp://gnu.org")) + + (when noninteractive + (kill-buffer)))) + +(defvar erc-button-tests--form nil) +(defvar erc-button-tests--some-var nil) + +(defun erc-button-tests--form (&rest rest) + (push rest erc-button-tests--form) + (apply #'erc-button-add-button rest)) + +(defun erc-button-tests--erc-button-alist--function-as-form (func) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 func #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should (equal (pop erc-button-tests--form) + '(53 55 ignore nil ("+1") "\\+1"))) + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should (equal (get-text-property (point) 'erc-data) '("+1"))) + (should (equal (get-text-property (point) 'mouse-face) 'highlight)) + (should (eq (get-text-property (point) 'font-lock-face) 'erc-button)) + (should (eq (get-text-property (point) 'erc-callback) 'ignore))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--function-as-form () + (erc-button-tests--erc-button-alist--function-as-form + #'erc-button-tests--form) + + (erc-button-tests--erc-button-alist--function-as-form + (symbol-function #'erc-button-tests--form)) + + (erc-button-tests--erc-button-alist--function-as-form + (lambda (&rest r) (push r erc-button-tests--form) + (apply #'erc-button-add-button r)))) + +(defun erc-button-tests--erc-button-alist--nil-form (form) + (setq erc-server-process + (start-process "sleep" (current-buffer) "sleep" "1")) + (set-process-query-on-exit-flag erc-server-process nil) + + (with-current-buffer (erc--open-target "#chan") + (let* ((erc-button-tests--form nil) + (entry (list (rx "+1") 0 form #'ignore 0)) + (erc-button-alist (cons entry erc-button-alist))) + + (erc-display-message nil 'notice (current-buffer) "Foo bar baz") + (erc-display-message nil nil (current-buffer) "+1") + (erc-display-message nil 'notice (current-buffer) "Spam") + (should-not erc-button-tests--form) + (goto-char (point-min)) + (search-forward "+") + (should-not (get-text-property (point) 'erc-data)) + (should-not (get-text-property (point) 'mouse-face)) + (should-not (get-text-property (point) 'font-lock-face)) + (should-not (get-text-property (point) 'erc-callback))) + + (when noninteractive + (kill-buffer)))) + +(ert-deftest erc-button-alist--nil-form () + (erc-button-tests--erc-button-alist--nil-form nil) + (erc-button-tests--erc-button-alist--nil-form 'erc-button-tests--some-var)) + (defun erc-button-tests--insert-privmsg (speaker &rest msg-parts) (declare (indent 1)) (let ((msg (erc-format-privmessage speaker From d141f7149b67daa93ac13420ee5edf4b0cbbf011 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 15 Apr 2023 09:52:05 -0700 Subject: [PATCH 13/14] Improve erc-button--modify-nick-function interface * lisp/erc/erc-button.el (erc-button--check-nicknames-entry): Remove unused let binding. (erc-button--preserve-bounds): Remove unused function. (erc-button--nick): New struct type to serve as collection plate for `erc-button--modify-nick-function' consumers. (erc-button--modify-nick-function): Reexplain interface, now based on `erc-button--nick' object. Change default value to `identity'. (erc-button--add-phantom-speaker): Redo to expect `erc-button--nick' object. (erc-button-add-nickname-buttons): Rework slightly to construct an `erc-button--nick' object for feeding to `erc-button--modify-nick-function'. Only run the latter when an `erc-server-user' has successfully been found. (Bug#60933) --- lisp/erc/erc-button.el | 91 ++++++++++++++++++++++++++++-------------- 1 file changed, 62 insertions(+), 29 deletions(-) diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index 7376c18ad4c..c7f6685c851 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -299,16 +299,39 @@ specified by `erc-button-alist'." (defun erc-button--check-nicknames-entry () ;; This helper exists because the module is defined after its options. - (when-let (((eq major-mode 'erc-mode)) - (entry (alist-get 'nicknames erc-button-alist))) - (unless (eq 'erc-button-buttonize-nicks (nth 1 entry)) + (when (eq major-mode 'erc-mode) + (unless (eq (nth 1 (alist-get 'nicknames erc-button-alist)) + 'erc-button-buttonize-nicks) (erc-button--display-error-notice-with-keys-and-warn "Values other than `erc-button-buttonize-nicks' in the third slot of " "the `nicknames' entry of `erc-button-alist' are deprecated.")))) -(defun erc-button--preserve-bounds (bounds _ server-user _) - "Return BOUNDS.\n\n(fn BOUNDS NICKNAME SERVER-USER CHANNEL-USER)" - (and server-user bounds)) +(cl-defstruct erc-button--nick + ( bounds nil :type cons + ;; Indicates the nick's position in the current message. BEG is + ;; normally also point. + :documentation "A cons of (BEG . END).") + ( data nil :type (or null cons) + ;; When non-nil, the CAR must be a non-casemapped nickname. For + ;; compatibility, the CDR should probably be nil, but this may + ;; have to change eventually. If non-nil, the entire cons should + ;; be mutated rather than replaced because it's used as a key in + ;; hash tables and text-property searches. + :documentation "A unique cons whose car is a nickname.") + ( downcased nil :type (or null string) + :documentation "The case-mapped nickname sans text properties.") + ( user nil :type (or null erc-server-user) + ;; Not necessarily present in `erc-server-users'. + :documentation "A possibly nil or spoofed `erc-server-user'.") + ( cuser nil :type (or null erc-channel-user) + ;; The CDR of a value from an `erc-channel-users' table. + :documentation "A possibly nil `erc-channel-user'.") + ( erc-button-face erc-button-face :type symbol + :documentation "Temp `erc-button-face' while buttonizing.") + ( erc-button-nickname-face erc-button-nickname-face :type symbol + :documentation "Temp `erc-button-nickname-face' while buttonizing.") + ( erc-button-mouse-face erc-button-mouse-face :type symbol + :documentation "Temp `erc-button-mouse-face' while buttonizing.")) ;; This variable is intended to serve as a "core" to be wrapped by ;; (built-in) modules during setup. It's unclear whether @@ -317,31 +340,29 @@ specified by `erc-button-alist'." ;; mostly concerned with ensuring one "piece" precedes or follows ;; another (specific piece), which may not yet (or ever) be present. -(defvar erc-button--modify-nick-function #'erc-button--preserve-bounds +(defvar erc-button--modify-nick-function #'identity "Function to possibly modify aspects of nick being buttonized. -Called with four args: BOUNDS NICKNAME SERVER-USER CHANNEL-USER. -BOUNDS is a cons of (BEG . END) marking the position of the nick -in the current message, which occupies the whole of the narrowed -buffer. BEG is normally also point. NICKNAME is a case-mapped -string without text properties. SERVER-USER and CHANNEL-USER are -the nick's `erc-server-users' entry and its associated (though -possibly nil) `erc-channel-user' object. The function should -return BOUNDS or a suitable replacement to indicate that -buttonizing ought to proceed, and nil if it should be inhibited.") +Called with one argument, an `erc-button--nick' object, or nil. +The function should return the same (or similar) object when +buttonizing ought to proceed and nil otherwise. While running, +all faces defined in `erc-button' are bound temporarily and can +be updated at will.") (defvar-local erc-button--phantom-users nil) (defun erc-button--add-phantom-speaker (args) "Maybe substitute fake `server-user' for speaker at point." - (pcase args - (`(,bounds ,downcased-nick nil ,channel-user) - (list bounds downcased-nick - ;; Like `with-memoization' but don't cache when value is nil. - (or (gethash downcased-nick erc-button--phantom-users) - (and-let* ((user (erc-button--get-user-from-speaker-naive - (car bounds)))) - (puthash downcased-nick user erc-button--phantom-users))) - channel-user)) + (pcase (car args) + ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil))) + ;; Like `with-memoization' but don't cache when value is nil. + (when-let ((user (or (gethash downcased erc-button--phantom-users) + (erc-button--get-user-from-speaker-naive + (car bounds))))) + (cl-assert (null (erc-button--nick-data obj))) + (puthash downcased user erc-button--phantom-users) + (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user)) + (erc-button--nick-user obj) user)) + (list obj)) (_ args))) (define-minor-mode erc-button--phantom-users-mode @@ -401,12 +422,24 @@ early (outer), args-filtering advice wrapping (gethash down erc-channel-users))) (user (or (and cuser (car cuser)) (and erc-server-users - (gethash down erc-server-users))))) + (gethash down erc-server-users)))) + (data (list word))) (when (or (not (functionp form)) - (setq bounds - (funcall form bounds down user (cdr cuser)))) + (and-let* ((user) + (obj (funcall form (make-erc-button--nick + :bounds bounds :data data + :downcased down :user user + :cuser (cdr cuser))))) + (setq bounds (erc-button--nick-bounds obj) + data (erc-button--nick-data obj) + erc-button-mouse-face + (erc-button--nick-erc-button-mouse-face obj) + erc-button-nickname-face + (erc-button--nick-erc-button-nickname-face obj) + erc-button-face + (erc-button--nick-erc-button-face obj)))) (erc-button-add-button (car bounds) (cdr bounds) - fun t (list word))))))))) + fun t data)))))))) (defun erc-button-add-buttons-1 (regexp entry) "Search through the buffer for matches to ENTRY and add buttons." From ba44b4818446afdda4ff04c92d4ea34803fbc9db Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 28 Apr 2023 06:34:09 -0700 Subject: [PATCH 14/14] Add interface for finding users in erc-server-PRIVMSG * lisp/erc/erc-backend.el (erc-server-PRIVMSG): Call new hook `erc--user-from-nick-function' for turning the sender's nick into a channel user, if any. * lisp/erc/erc-button.el (erc-button--add-phantom-speaker): Redo completely using simplified API. (erc-button--fallback-user-function): Add internal function-interface variable for finding an `erc-server-user' object when the usual places disappoint. (erc-button--get-phantom-user): Add new function, a getter for `erc-button--phantom-users'. (erc-button--phantom-users-mode): Replace advice subscription for `erc-button--modify-nick-function' with one for `erc-button--user-from-nick-function' and one for `erc-button--fallback-user-function'. (erc-button--get-user-from-speaker-naive): Remove unused function. (erc-button--add-nickname-buttons): Call `erc-button--fallback-user-function' when a user can't be found in `erc-server-users' or `erc-channel-users'. * lisp/erc/erc.el (erc--user-from-nick-function): New function-interface variable for determining an `erc-server-user' `erc-channel-user' pair from the sender's nick. (erc--examine-nick): Add new function to serve as default value for `erc--user-from-nick-function'. (Bug#60933) --- lisp/erc/erc-backend.el | 4 ++- lisp/erc/erc-button.el | 79 +++++++++++++++++++++-------------------- lisp/erc/erc.el | 10 ++++++ 3 files changed, 54 insertions(+), 39 deletions(-) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bc8e603e10a..2de24e7cb25 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -102,6 +102,7 @@ (require 'erc-common) (defvar erc--target) +(defvar erc--user-from-nick-function) (defvar erc-channel-list) (defvar erc-channel-users) (defvar erc-default-nicks) @@ -1912,7 +1913,8 @@ add things to `%s' instead." ;; at this point. (erc-update-channel-member (if privp nick tgt) nick nick privp nil nil nil nil nil host login nil nil t) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (funcall erc--user-from-nick-function + (erc-downcase nick) sndr parsed))) (setq fnick (funcall erc-format-nick-function (car cdata) (cdr cdata)))))) (cond diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index c7f6685c851..4307dc3b860 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -350,55 +350,56 @@ be updated at will.") (defvar-local erc-button--phantom-users nil) -(defun erc-button--add-phantom-speaker (args) - "Maybe substitute fake `server-user' for speaker at point." - (pcase (car args) - ((and obj (cl-struct erc-button--nick bounds downcased (user 'nil))) - ;; Like `with-memoization' but don't cache when value is nil. - (when-let ((user (or (gethash downcased erc-button--phantom-users) - (erc-button--get-user-from-speaker-naive - (car bounds))))) - (cl-assert (null (erc-button--nick-data obj))) - (puthash downcased user erc-button--phantom-users) - (setf (erc-button--nick-data obj) (list (erc-server-user-nickname user)) - (erc-button--nick-user obj) user)) - (list obj)) - (_ args))) +(defvar erc-button--fallback-user-function #'ignore + "Function to determine `erc-server-user' if not found in the usual places. +Called with DOWNCASED-NICK, NICK, and NICK-BOUNDS when +`erc-button-add-nickname-buttons' cannot find a user object for +DOWNCASED-NICK in `erc-channel-users' or `erc-server-users'.") +(defun erc-button--add-phantom-speaker (downcased nuh _parsed) + "Stash fictitious `erc-server-user' while processing \"PRIVMSG\". +Expect DOWNCASED to be the downcased nickname, NUH to be a triple +of (NICK LOGIN HOST), and parsed to be an `erc-response' object." + (pcase-let* ((`(,nick ,login ,host) nuh) + (user (or (gethash downcased erc-button--phantom-users) + (make-erc-server-user + :nickname nick + :host (and (not (string-empty-p host)) host) + :login (and (not (string-empty-p login)) login))))) + (list (puthash downcased user erc-button--phantom-users)))) + +(defun erc-button--get-phantom-user (down _word _bounds) + (gethash down erc-button--phantom-users)) + +;; In the future, we'll most likely create temporary +;; `erc-channel-users' tables during BATCH chathistory playback, thus +;; obviating the need for this mode entirely. (define-minor-mode erc-button--phantom-users-mode "Minor mode to recognize unknown speakers. Expect to be used by module setup code for creating placeholder users on the fly during history playback. Treat an unknown -PRIVMSG speaker, like , as if they were present in a 353 and -are thus a member of the channel. However, don't bother creating -an actual `erc-channel-user' object because their status prefix -is unknown. Instead, just spoof an `erc-server-user' by applying -early (outer), args-filtering advice wrapping -`erc-button--modify-nick-function'." +\"PRIVMSG\" speaker, like \"\", as if they previously +appeared in a prior \"353\" message and are thus a known member +of the channel. However, don't bother creating an actual +`erc-channel-user' object because their status prefix is unknown. +Instead, just spoof an `erc-server-user' and stash it during +\"PRIVMSG\" handling via `erc--user-from-nick-function' and +retrieve it during buttonizing via +`erc-button--fallback-user-function'." :interactive nil (if erc-button--phantom-users-mode (progn - (add-function :filter-args (local 'erc-button--modify-nick-function) - #'erc-button--add-phantom-speaker '((depth . -90))) + (add-function :after-until (local 'erc--user-from-nick-function) + #'erc-button--add-phantom-speaker '((depth . -50))) + (add-function :after-until (local 'erc-button--fallback-user-function) + #'erc-button--get-phantom-user '((depth . 50))) (setq erc-button--phantom-users (make-hash-table :test #'equal))) - (remove-function (local 'erc-button--modify-nick-function) + (remove-function (local 'erc--user-from-nick-function) #'erc-button--add-phantom-speaker) + (remove-function (local 'erc-button--fallback-user-function) + #'erc-button--get-phantom-user) (kill-local-variable 'erc-nicks--phantom-users))) -;; FIXME replace this after making ERC account-aware. -(defun erc-button--get-user-from-speaker-naive (point) - "Return `erc-server-user' object for nick at POINT." - (when-let* - (((eql ?< (char-before point))) - ((eq (get-text-property point 'font-lock-face) 'erc-nick-default-face)) - (parsed (erc-get-parsed-vector point))) - (pcase-let* ((`(,nick ,login ,host) - (erc-parse-user (erc-response.sender parsed)))) - (make-erc-server-user - :nickname nick - :host (and (not (string-empty-p host)) host) - :login (and (not (string-empty-p login)) login))))) - (defun erc-button-add-nickname-buttons (entry) "Search through the buffer for nicknames, and add buttons." (let ((form (nth 2 entry)) @@ -422,7 +423,9 @@ early (outer), args-filtering advice wrapping (gethash down erc-channel-users))) (user (or (and cuser (car cuser)) (and erc-server-users - (gethash down erc-server-users)))) + (gethash down erc-server-users)) + (funcall erc-button--fallback-user-function + down word bounds))) (data (list word))) (when (or (not (functionp form)) (and-let* ((user) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 72ec8134eab..dbf413bac74 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -4993,6 +4993,16 @@ and as second argument the event parsed as a vector." (and (erc-is-message-ctcp-p message) (not (string-match "^\C-aACTION.*\C-a$" message)))) +(defvar erc--user-from-nick-function #'erc--examine-nick + "Function to possibly consider unknown user. +Must return either nil or a cons of an `erc-server-user' and a +possibly nil `erc-channel-user' for formatting a server user's +nick. Called in the appropriate buffer with the downcased nick, +the parsed NUH, and the original `erc-response' object.") + +(defun erc--examine-nick (downcased _nuh _parsed) + (and erc-channel-users (gethash downcased erc-channel-users))) + (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." (let* ((mark-s (if msgp (if privp "*" "<") "-"))