* bug#62947: 30.0.50; ERC 5.6: Improve partitioning of outgoing messages
[not found] <87wn27ncnk.fsf@neverwas.me>
@ 2023-05-02 4:39 ` J.P.
[not found] ` <87wn1rwdnd.fsf@neverwas.me>
2023-12-07 7:19 ` J.P.
2 siblings, 0 replies; 4+ messages in thread
From: J.P. @ 2023-05-02 4:39 UTC (permalink / raw)
To: 62947; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1702 bytes --]
This bug presents an opportunity for revisiting how input handling and
pre-send hook management happen in ERC. The groundwork has already been
laid by ERC 5.5, so we might as well try inching closer to something
more responsive and intuitive. This being ERC, flexibility is also a
priority, but for now, I'm thinking we should focus on honoring existing
interfaces rather than adding new ones.
In the current envisioning (v2 attached), this imagined shift toward
smarter input handling starts by moving all line splitting and related
input preparation forward so it runs earlier, alongside the various
validation checks. Doing this alone could, for example, give us
friendlier feedback when crossing the `erc-inhibit-multiline-input'
threshold, with the rejected goods being invited to hang around in the
prompt area for successive tweaking and do-overs (instead of seeing
their mutilated pieces clutter up the kill ring, which more or less
describes the current state of affairs).
The path I'm proposing does come with one minor hiccup in terms of
corner-case breakage, but only for third-parties that expect
protocol-length line splitting to occur after the more send-focused
hooks run (chiefly, `erc-pre-send-functions'). To smooth things over,
I'm proposing an off-by-default compat switch, which would manifest as a
new "refoldp" slot for the `erc-input' object that's shared among these
hook members. Third parties can toggle this on if they'd rather not
trust other members to perform the necessary bookeeping to keep line
lengths in check.
If you'd like to try this, just
(setq erc-inhibit-multiline-input t
erc-send-whitespace-lines t)
and submit a long passage at the prompt.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 26628 bytes --]
From f70e892a5457e48871bf0b817a8f017a8492318a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 1 May 2023 20:33:33 -0700
Subject: [PATCH 0/3] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (3):
[5.6] Don't send multiline slash commands as msgs in ERC
[5.6] Redo line splitting for outgoing messages in ERC
[5.6] Preprocess prompt input linewise in ERC
etc/ERC-NEWS | 6 +
lisp/erc/erc-backend.el | 41 ++++
lisp/erc/erc-common.el | 14 +-
lisp/erc/erc-goodies.el | 5 +-
lisp/erc/erc-ring.el | 4 +-
lisp/erc/erc.el | 195 ++++++++++++-----
.../lisp/erc/erc-scenarios-base-split-line.el | 202 ++++++++++++++++++
test/lisp/erc/erc-tests.el | 167 +++++++++++++--
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 +-
12 files changed, 710 insertions(+), 76 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
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 8f1b89f268b..e34a7ac1c78 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -170,6 +170,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'.
+*** Input splitting now happens before 'erc-pre-send-functions' runs.
+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 6c015c71ff9..dd803b45d61 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -30,8 +30,10 @@ erc--casemapping-rfc1459
(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-users)
(defvar erc-session-server)
@@ -45,10 +47,14 @@ erc-session-server
(declare-function widget-type "wid-edit" (widget))
(cl-defstruct erc-input
- string insertp sendp)
-
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
+ string insertp sendp refoldp)
+
+(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 @@ noncommands
"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 @@ erc-ring
(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 8e3625e72f5..e80cd350c38 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -907,6 +907,9 @@ erc-flood-protect
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
@@ -1089,34 +1092,40 @@ erc-pre-send-functions
`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.
@@ -1158,8 +1167,8 @@ erc-insert-done-hook
(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.
@@ -6026,16 +6035,18 @@ erc--blank-in-multiline-input-p
(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))))))
@@ -6075,7 +6086,17 @@ erc--check-prompt-input-functions
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."
@@ -6090,12 +6111,15 @@ erc-send-current-line
(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
@@ -6103,7 +6127,7 @@ erc-send-current-line
;; 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
@@ -6136,11 +6160,59 @@ erc--discard-trailing-multiline-nulls
(setf (erc--input-split-lines state) (nreverse reversed)))))
(defun erc--split-lines (state)
- "Partition input lines when flood protection is enabled."
- (when (and erc-flood-protect (not (erc--input-split-cmdp 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--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.
@@ -6171,26 +6243,27 @@ erc-send-input
: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)
- (dolist (line (erc--input-split-lines state))
- (if (erc--input-split-cmdp state)
- (cl-assert (not (cdr (erc--input-split-lines state))))
- (when (erc-input-insertp state)
- (erc-display-msg line)))
- (erc-process-input-line (concat line "\n")
- (null erc-flood-protect)
- (not (erc--input-split-cmdp state))))
- t))))
+ (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)
+ (progn ; temporarily preserve indentation
+ (when (erc-input-insertp state)
+ (erc-display-msg line))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect) t))))
+ t)))))
(defun erc-display-msg (line)
"Display LINE as a message of the user to the current target at point."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index bb36adf3393..e788dd8031d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -942,8 +942,8 @@ erc-ring-previous-command
(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 @@ erc--blank-in-multiline-input-p
(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")
@@ -1223,9 +1225,9 @@ erc-send-current-line
(ert-info ("Input cleared")
(erc-bol)
(should (eq (point) (point-max))))
- ;; The flood argument is irrelevant here because it can't
+ ;; The `force' argument is irrelevant here because it can't
;; influence dispatched handlers, such as `erc-cmd-MSG'.
- (should (equal (funcall next) '("/msg #chan hi\n" nil nil))))
+ (should (pcase (funcall next) (`("/msg #chan hi\n" ,_ nil) t))))
(ert-info ("Simple non-command")
(insert "hi")
@@ -1233,7 +1235,8 @@ erc-send-current-line
(should (eq (point) (point-max)))
(should (save-excursion (forward-line -1)
(search-forward "<tester> 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)))))
@@ -1285,12 +1288,13 @@ erc-send-whitespace-lines
(erc-bol)
(should (eq (point) (point-max)))
(while q
- (should (equal (funcall next) (list (pop q) nil nil))))
+ (should (pcase (funcall next)
+ (`(,cmd ,_ nil) (equal cmd (pop q))))))
(should-not (funcall next))))
- (ert-info ("Multiline non-command with trailing blank errors")
+ (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 \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)
@@ -1312,13 +1316,14 @@ erc--check-prompt-input-for-excess-lines
(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 +1404,94 @@ erc-process-input-line
(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 ()
--
2.40.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Don-t-send-multiline-slash-commands-as-msgs-in-E.patch --]
[-- Type: text/x-patch, Size: 5167 bytes --]
From b75ba0efbb44bda6a6da04d38490456a2545aa99 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 17 Apr 2023 23:09:49 -0700
Subject: [PATCH 1/3] [5.6] Don't send multiline slash commands as msgs 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. 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 284990e2d43..09e65671545 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -6005,6 +6005,9 @@ erc-accidental-paste-threshold-seconds
(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
@@ -6054,11 +6057,19 @@ erc--check-prompt-input-for-running-process
(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
@@ -6113,19 +6124,15 @@ erc-user-input
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 29bda7e742d..574df4106ee 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1236,15 +1236,23 @@ erc-send-whitespace-lines
(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")
--
2.40.0
[-- Attachment #4: 0002-5.6-Redo-line-splitting-for-outgoing-messages-in-ERC.patch --]
[-- Type: text/x-patch, Size: 44931 bytes --]
From 51e769fd860d921c6758584e57ae3d68646f2c33 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 17 Apr 2023 00:01:15 -0700
Subject: [PATCH 2/3] [5.6] 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.
(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.
* 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 bdf4e2ddca2..08e4f36b1fc 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -564,6 +564,47 @@ erc-server-ping-handler
;;;; Helper functions
+(defvar erc--reject-unbreakable-lines nil
+ "Raise 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 09e65671545..28fe724e491 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -907,6 +907,9 @@ erc-flood-protect
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
@@ -1101,7 +1104,8 @@ erc-pre-send-functions
;; 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.
@@ -6134,6 +6138,14 @@ erc--discard-trailing-multiline-nulls
(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.
@@ -6164,23 +6176,22 @@ erc-send-input
: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 <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)))
+
+(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 "<tester>")
+ (funcall expect -0.1 "<tester>"))
+
+ (ert-info ("Message over `erc-split-line-length'")
+ (erc-scenarios-common-say
+ (concat
+ "короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " короче теперь если по русски написать все четко или все равно"
+ " будет разрыв строки непонятно где"))
+ (funcall expect 1 "<tester>")
+ (funcall expect 1 "<tester> разрыв")))
+
+ (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 "<tester>")
+ ;; Sent in a single go, hence no second <speaker>.
+ (funcall expect -0.1 "<tester>")
+ (funcall expect 0.1 "12345678"))
+
+ (ert-info ("Message with spaces too long.")
+ (erc-scenarios-common-say (concat msg-432 " 123456789"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 123456789"))
+
+ (ert-info ("Message sans spaces fits exactly")
+ (erc-scenarios-common-say (make-string 440 ?x))
+ (funcall expect 1 "<tester>")
+ ;; Sent in a single go, hence no second <speaker>.
+ (funcall expect -0.1 "<tester>"))
+
+ (ert-info ("Message sans spaces too long.")
+ (erc-scenarios-common-say (concat (make-string 440 ?y) "z"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 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 "<tester> короче")
+ (funcall expect 1 "<tester> все")
+ (funcall expect 1 "<tester> разрыв")
+ (funcall expect 1 "Entirely honour"))
+
+ (ert-info ("Message sans spaces over `erc-split-line-length'")
+ (erc-scenarios-common-say
+ (concat "話說天下大勢，分久必合，合久必分：周末七國分爭，并入於秦。"
+ "及秦滅之後，楚、漢分爭，又并入於漢。漢朝自高祖斬白蛇而起義，"
+ "一統天下。後來光武中興，傳至獻帝，遂分為三國。推其致亂之由，"
+ "殆始於桓、靈二帝。桓帝禁錮善類，崇信宦官。及桓帝崩，靈帝即位，"
+ "大將軍竇武、太傅陳蕃，共相輔佐。時有宦官曹節等弄權，竇武、陳蕃謀誅之，"
+ "作事不密，反為所害。中涓自此愈橫"))
+ (funcall expect 1 "<tester>")
+ ;; Sent in two passes, split at last word.
+ (funcall expect 0.1 "<tester> 竇武")
+ (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 "<tester>")
+ (funcall expect 1 "<tester> 🏳️🌈")))
+
+ (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 574df4106ee..543b7bc002e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1044,6 +1044,48 @@ erc-log-irc-protocol
(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 @@ erc-send-current-line
(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 @@ erc-send-current-line
(should (eq (point) (point-max)))
(should (save-excursion (forward-line -1)
(search-forward "<tester> 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 f4491bbb834..08c8ba6f68d 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -455,7 +455,7 @@ erc-d--filter
(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))))
--
2.40.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Preprocess-prompt-input-linewise-in-ERC.patch --]
[-- Type: text/x-patch, Size: 22917 bytes --]
From f70e892a5457e48871bf0b817a8f017a8492318a Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 30 Apr 2023 07:12:56 -0700
Subject: [PATCH 3/3] [5.6] 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.
(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'.
* 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. This depends
on the line-splitting vs. hooks reorientation introduced elsewhere in
this change set.
(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 `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 | 14 ++--
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, 218 insertions(+), 47 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 8f1b89f268b..e34a7ac1c78 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -170,6 +170,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'.
+*** Input splitting now happens before 'erc-pre-send-functions' runs.
+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 6c015c71ff9..dd803b45d61 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -30,8 +30,10 @@ erc--casemapping-rfc1459
(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-users)
(defvar erc-session-server)
@@ -45,10 +47,14 @@ erc-session-server
(declare-function widget-type "wid-edit" (widget))
(cl-defstruct erc-input
- string insertp sendp)
-
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
+ string insertp sendp refoldp)
+
+(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 @@ noncommands
"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 @@ erc-ring
(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 28fe724e491..e80cd350c38 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1092,34 +1092,40 @@ erc-pre-send-functions
`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.
@@ -1161,8 +1167,8 @@ erc-insert-done-hook
(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.
@@ -6029,16 +6035,18 @@ erc--blank-in-multiline-input-p
(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))))))
@@ -6078,7 +6086,17 @@ erc--check-prompt-input-functions
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."
@@ -6093,12 +6111,15 @@ erc-send-current-line
(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
@@ -6106,7 +6127,7 @@ erc-send-current-line
;; 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
@@ -6146,6 +6167,52 @@ erc--split-lines
(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 543b7bc002e..e788dd8031d 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -942,8 +942,8 @@ erc-ring-previous-command
(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 @@ erc--blank-in-multiline-input-p
(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 @@ erc--check-prompt-input-for-excess-lines
(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'")
@@ -1401,6 +1404,94 @@ erc-process-input-line
(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 ()
--
2.40.0
^ permalink raw reply related [flat|nested] 4+ messages in thread