master 174b3dd9bd7 5/9: Make nested input handling more robust in ERC

[F. Jason Park]

branch: master
commit 174b3dd9bd78c662ce9fff78404dcfa02259d21b
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Make nested input handling more robust in ERC
    
    * lisp/erc/erc.el (erc--send-action-function): New function-valued
    variable for locally advising `erc-send-action' so that built-in
    modules can elect to handle insertion and sending themselves.
    (erc-send-action): Defer to `erc--send-action-function'.
    (erc--send-action-perform-ctcp): Isolate the message-sending business
    for CTCP ACTIONs that used to reside in `erc-send-action'.
    (erc--send-action-display): Isolate the message-insertion business
    formerly residing in `erc-send-action' for more granular use.  Fix a
    minor bug involving inserted representations of CTCP ACTIONs not
    having `erc-my-nick-face' applied to the speaker.
    (erc--send-action): Perform the same displaying and sending of CTCP
    ACTION messages formerly handled by `erc-send-action', but display
    messages before sending them.
    (erc--current-line-input-split): New variable bound to the post-review
    `erc--input-split' object for the extent of display processing.  This
    mainly benefits slash-command handlers and the utility functions they
    employ, such as `erc-send-message'.
    (erc-cmd-SAY): Defer to `erc--send-message'.
    (erc--send-message-nested-function): New function-valued variable
    supporting an internal interface for influencing how
    `erc-send-message' inserts and sends prompt input.  Some handlers for
    slash commands, like /SV, use `erc-send-message' to perform their own
    insertion and sending, which is normally the domain of
    `erc-send-current-line'.  When this happens, modules can't easily
    leverage the normal hook-based API to do things like suppress
    insertion but allow sending or vice-versa.  This variable provides an
    internal seam for modules to exert such influence.
    (erc-send-message): Behave specially when called by the default
    interactive client via `erc-send-current-line' and friends.
    (erc--send-message-external): New function to house the former body of
    `erc-send-message', for third-party code needing to apply the
    traditional behavior.
    (erc--send-message-nested): New function for turning arbitrary text,
    such as replacement prompt input, into outgoing message text by doing
    things like ensuring "send" hooks run and invariants for prompt
    markers are preserved.
    (erc--make-input-split): New helper function for creating a standard
    `erc--input-split' object from a string.  This is arguably less
    confusing than adding another constructor to the struct definition.
    (erc-send-current-line): Bind `erc--current-line-input-split' when
    dispatching prompt-input handlers.  Use helper `erc--make-input-split'
    to initialize working `erc--input-split' state object.
    (erc--run-send-hooks): Honor existing `refoldp' slot from
    `erc--input-split' object.
    (erc--send-input-lines): Convert to generic function to allow modules
    control over fundamental insertion and sending operations, which is
    necessary for next-generation features, like multiline messages.
    (erc-modes): Don't output non-modules.  That is, only list actual
    modules created via `define-erc-module', and `quote' members of the
    resulting list.
    * test/lisp/erc/erc-scenarios-base-send-message.el: New test file.
    * test/lisp/erc/resources/base/send-message/noncommands.eld: New data
    file.  (Bug#67031)
---
 lisp/erc/erc.el                                    | 100 +++++++++++++++++----
 test/lisp/erc/erc-scenarios-base-send-message.el   |  72 +++++++++++++++
 .../resources/base/send-message/noncommands.eld    |  52 +++++++++++
 3 files changed, 207 insertions(+), 17 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 2d8f388328d..c9c24f2642f 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2948,17 +2948,40 @@ If ARG is non-nil, show the *erc-protocol* buffer."
 
 ;; send interface
 
+(defvar erc--send-action-function #'erc--send-action
+  "Function to display and send an outgoing CTCP ACTION message.
+Called with three arguments: the submitted input, the current
+target, and an `erc-server-send' FORCE flag.")
+
 (defun erc-send-action (tgt str &optional force)
   "Send CTCP ACTION information described by STR to TGT."
-  (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
-  ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
+  (funcall erc--send-action-function tgt str force))
+
+;; Sending and displaying are provided separately to afford modules
+;; more flexibility, e.g., to forgo displaying on the way out when
+;; expecting the server to echo messages back and/or to associate
+;; outgoing messages with IDs generated for `erc-ephemeral'
+;; placeholders.
+(defun erc--send-action-perform-ctcp (target string force)
+  "Send STRING to TARGET, possibly immediately, with FORCE."
+  (erc-send-ctcp-message target (format "ACTION %s" string) force))
+
+(defun erc--send-action-display (string)
+  "Display STRING as an outgoing \"CTCP ACTION\" message."
+  ;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us.
   (let ((erc--msg-prop-overrides `((erc-msg . msg)
                                    (erc-ctcp . ACTION)
                                    ,@erc--msg-prop-overrides))
         (nick (erc-current-nick)))
-    (setq nick (propertize nick 'erc-speaker nick))
+    (setq nick (propertize nick 'erc-speaker nick
+                           'font-lock-face 'erc-my-nick-face))
     (erc-display-message nil '(t action input) (current-buffer)
-                         'ACTION ?n nick ?a str ?u "" ?h "")))
+                         'ACTION ?n nick ?a string ?u "" ?h "")))
+
+(defun erc--send-action (target string force)
+  "Display STRING, then send to TARGET as a \"CTCP ACTION\" message."
+  (erc--send-action-display string)
+  (erc--send-action-perform-ctcp target string force))
 
 ;; Display interface
 
@@ -3655,6 +3678,12 @@ present."
   "Non-nil when a user types a \"/slash\" command.
 Remains bound until `erc-cmd-SLASH' returns.")
 
+(defvar erc--current-line-input-split nil
+  "Current `erc--input-split' instance when processing user input.
+This is for special cases in which a \"slash\" command needs
+details about the input it's handling or needs to detect whether
+it's been dispatched by `erc-send-current-line'.")
+
 (defvar-local erc-send-input-line-function #'erc-send-input-line
   "Function for sending lines lacking a leading \"slash\" command.
 When prompt input starts with a \"slash\" command, like \"/MSG\",
@@ -3791,9 +3820,7 @@ need this when pasting multiple lines of text."
   (if (string-match "^\\s-*$" line)
       nil
     (string-match "^ ?\\(.*\\)" line)
-    (let ((msg (match-string 1 line)))
-      (erc-display-msg msg)
-      (erc-process-input-line msg nil t))))
+    (erc-send-message (match-string 1 line) nil)))
 (put 'erc-cmd-SAY 'do-not-parse-args t)
 
 (defun erc-cmd-SET (line)
@@ -4489,10 +4516,25 @@ the matching is case-sensitive."
 (put 'erc-cmd-LASTLOG 'do-not-parse-args t)
 (put 'erc-cmd-LASTLOG 'process-not-needed t)
 
+(defvar erc--send-message-nested-function #'erc--send-message-nested
+  "Function for inserting and sending slash-command generated text.
+When a command like /SV or /SAY modifies or replaces command-line
+input originally submitted at the prompt, `erc-send-message'
+performs additional processing to ensure said input is fit for
+inserting and sending given this \"nested\" meta context.  This
+interface variable exists because modules extending fundamental
+insertion and sending operations need a say in this processing as
+well.")
+
 (defun erc-send-message (line &optional force)
   "Send LINE to the current channel or user and display it.
 
 See also `erc-message' and `erc-display-line'."
+  (if (erc--input-split-p erc--current-line-input-split)
+      (funcall erc--send-message-nested-function line force)
+    (erc--send-message-external line force)))
+
+(defun erc--send-message-external (line force)
   (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
   (erc-display-line
    (concat (erc-format-my-nick) line)
@@ -4500,6 +4542,24 @@ See also `erc-message' and `erc-display-line'."
   ;; FIXME - treat multiline, run hooks, or remove me?
   t)
 
+(defun erc--send-message-nested (input-line force)
+  "Process string INPUT-LINE almost as if it's normal chat input.
+Expect INPUT-LINE to differ from the `string' slot of the calling
+context's `erc--current-line-input-split' object because the
+latter is likely a slash command invocation whose handler
+generated INPUT-LINE.  Before inserting INPUT-LINE, split it and
+run `erc-send-modify-hook' and `erc-send-post-hook' on each
+actual outgoing line.  Forgo input validation because this isn't
+interactive input, and skip `erc-send-completed-hook' because it
+will run just before the outer `erc-send-current-line' call
+returns."
+  (let* ((erc-flood-protect (not force))
+         (lines-obj (erc--make-input-split input-line)))
+    (setf (erc--input-split-refoldp lines-obj) t
+          (erc--input-split-cmdp lines-obj) nil)
+    (erc--send-input-lines (erc--run-send-hooks lines-obj)))
+  t)
+
 (defun erc-cmd-MODE (line)
   "Change or display the mode value of a channel or user.
 The first word specifies the target.  The rest is the mode string
@@ -6873,6 +6933,14 @@ ERC prints them as a single message joined by newlines.")
   (when (erc--input-split-cmdp state)
     (setf (erc--input-split-insertp state) nil)))
 
+(defun erc--make-input-split (string)
+  (make-erc--input-split
+   :string string
+   :insertp erc-insert-this
+   :sendp erc-send-this
+   :lines (split-string string erc--input-line-delim-regexp)
+   :cmdp (string-match erc-command-regexp string)))
+
 (defun erc-send-current-line ()
   "Parse current line and send it to IRC."
   (interactive)
@@ -6887,16 +6955,11 @@ ERC prints them as a single message joined by 
newlines.")
             (expand-abbrev))
           (widen)
           (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))))
+                 (state (erc--make-input-split str)))
             (run-hook-with-args 'erc--input-review-functions state)
             (when-let (((not (erc--input-split-abortp state)))
                        (inhibit-read-only t)
+                       (erc--current-line-input-split state)
                        (old-buf (current-buffer)))
               (let ((erc--msg-prop-overrides `((erc-msg . msg)
                                                ,@erc--msg-prop-overrides)))
@@ -6962,6 +7025,8 @@ queue.  Expect LINES-OBJ to be an `erc--input-split' 
object."
                       (run-hook-with-args 'erc-send-pre-hook str)
                       (make-erc-input :string str
                                       :insertp erc-insert-this
+                                      :refoldp (erc--input-split-refoldp
+                                                lines-obj)
                                       :sendp erc-send-this))))
         (run-hook-with-args 'erc-pre-send-functions state)
         (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state)
@@ -6978,7 +7043,7 @@ queue.  Expect LINES-OBJ to be an `erc--input-split' 
object."
     (user-error "Multiline command detected" ))
   lines-obj)
 
-(defun erc--send-input-lines (lines-obj)
+(cl-defmethod erc--send-input-lines (lines-obj)
   "Send lines in `erc--input-split-lines' object LINES-OBJ."
   (when (erc--input-split-sendp lines-obj)
     (dolist (line (erc--input-split-lines lines-obj))
@@ -8103,10 +8168,11 @@ If optional argument HERE is non-nil, insert version 
number at point."
                     (let (modes (case-fold-search nil))
                       (dolist (var (apropos-internal "^erc-.*mode$"))
                         (when (and (boundp var)
+                                   (get var 'erc-module)
                                    (symbol-value var))
-                          (setq modes (cons (symbol-name var)
+                          (setq modes (cons (concat "`" (symbol-name var) "'")
                                             modes))))
-                      modes)
+                      (sort modes #'string<))
                     ", ")))
     (if here
         (insert string)
diff --git a/test/lisp/erc/erc-scenarios-base-send-message.el 
b/test/lisp/erc/erc-scenarios-base-send-message.el
new file mode 100644
index 00000000000..904381abe6a
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-send-message.el
@@ -0,0 +1,72 @@
+;;; erc-scenarios-base-send-message.el --- `send-message' scenarios -*- 
lexical-binding: t -*-
+
+;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+  (let ((load-path (cons (ert-resource-directory) load-path)))
+    (require 'erc-scenarios-common)))
+
+;; So-called "noncommands" are those that massage input submitted at
+;; the prompt and send it on behalf of the user.
+
+(ert-deftest erc-scenarios-base-send-message--noncommands ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/send-message")
+       (erc-server-flood-penalty 0.1)
+       (dumb-server (erc-d-run "localhost" t 'noncommands))
+       (erc-modules (cons 'fill-wrap erc-modules))
+       (erc-autojoin-channels-alist '((foonet "#chan")))
+       (expect (erc-d-t-make-expecter)))
+
+    (ert-info ("Connect to foonet")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port (process-contact dumb-server :service)
+                                :nick "tester"
+                                :full-name "tester")
+        (funcall expect 5 "debug mode")))
+
+    (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+      (ert-info ("Send CTCP ACTION")
+        (funcall expect 10 "<bob> alice: For hands, to do Rome")
+        (erc-scenarios-common-say "/me sad")
+        (funcall expect 10 "* tester sad"))
+
+      (ert-info ("Send literal command")
+        (funcall expect 10 "<alice> bob: Spotted, detested")
+        (erc-scenarios-common-say "/say /me sad")
+        (funcall expect 10 "<tester> /me sad"))
+
+      (ert-info ("\"Nested\" `noncommands'")
+
+        (ert-info ("Send version via /SV")
+          (funcall expect 10 "<bob> Marcus, my brother!")
+          (erc-scenarios-common-say "/sv")
+          (funcall expect 10 "<tester> I'm using ERC"))
+
+        (ert-info ("Send module list via /SM")
+          (funcall expect 10 "<bob> alice: You still wrangle")
+          (erc-scenarios-common-say "/sm")
+          (funcall expect 10 "<tester> I'm using the following modules: ")
+          (funcall expect 10 "<alice> No, not till Thursday;"))))))
+
+
+;;; erc-scenarios-base-send-message.el ends here
diff --git a/test/lisp/erc/resources/base/send-message/noncommands.eld 
b/test/lisp/erc/resources/base/send-message/noncommands.eld
new file mode 100644
index 00000000000..ba210bfff6f
--- /dev/null
+++ b/test/lisp/erc/resources/base/send-message/noncommands.eld
@@ -0,0 +1,52 @@
+;; -*- 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 Nov 2023 
17:40:20 UTC")
+ (0.01 ":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.02 ":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.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 
server(s)")
+ (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.01 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
+ (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
+ (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
+ (0.02 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is 
logging all user I/O. If you do not wish for everything you send to be readable 
by the server owner(s), please disconnect."))
+
+((mode-tester 10 "MODE tester +i"))
+
+((join-chan 10 "JOIN #chan")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":tester!~u@ggpg6r3a68wak.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!"))
+
+((mode-chan 10 "MODE #chan")
+ (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.02 ":irc.foonet.org 329 tester #chan 1699810829")
+ (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: To prove him false 
that says I love thee not.")
+ (0.02 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: For hands, to do Rome 
service, are but vain."))
+
+((privmsg-action 10 "PRIVMSG #chan :\1ACTION sad\1")
+ (0.07 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: Spotted, detested, and 
abominable."))
+
+((privmsg-me 10 "PRIVMSG #chan :/me sad")
+ (0.03 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :Marcus, my brother! 'tis sad 
Titus calls."))
+
+((privmsg-sv 10 "PRIVMSG #chan :I'm using ERC " (+ (not " ")) " with GNU 
Emacs")
+ (0.07 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: You still wrangle with 
her, Boyet, and she strikes at the brow."))
+
+((privmsg-sm 10 "PRIVMSG #chan :I'm using the following modules: 
`erc-autojoin-mode', ")
+ (0.04 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :No, not till Thursday; 
there is time enough."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.05 ":tester!~u@ggpg6r3a68wak.irc QUIT :Quit: \2ERC\2 5.x (IRC client for 
GNU Emacs)")
+ (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))