Re: bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input

"J.P." <[email protected]>
Newsgroups gmane.emacs.erc.general
Message-ID <[email protected]>
v5. Fix compiler error and other minor issues.
0000-v4-v5.diff (text/x-patch, 4.6 KB)
From aaf22460711d8d669da296dfbf024053270e1cef Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Tue, 17 May 2022 05:43:52 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (4):
  Fix regression in erc-send-input-line
  Add some ERC test helpers
  Improve ERC's handling of multiline prompt input
  Optionally prevent sending multiline input in ERC

 lisp/erc/erc.el            | 195 +++++++++++++++++++++------
 test/lisp/erc/erc-tests.el | 267 +++++++++++++++++++++++++++++++++++--
 2 files changed, 410 insertions(+), 52 deletions(-)

Interdiff:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 14194492e8..17bf3c9c0c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1068,11 +1068,12 @@ erc-pre-send-functions
   :type 'hook
   :version "27.1")
 
-;; This is being auditioned for possible exporting (as a custom
+;; 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.
+;; remove this hook and the struct completely.  It you need this,
+;; please say so!
 
 (defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls)
   "Special hook for modifying individual lines in multiline prompt input.
@@ -5594,18 +5595,6 @@ erc--blank-in-multiline-input-p
                 (string-match (rx bot (* (in " \t\f")) eot) line))
           (throw 'return t))))))
 
-(defun erc--discard-trailing-multiline-nulls (state)
-  "Ensure last line of `erc-input' STATE's string is non-null.
-But only when `erc-send-whitespace-lines' is non-nil."
-  (when erc-send-whitespace-lines
-    (when (string-match "[\r\n]+\\'" (erc-input-string state))
-      (setf (erc--input-split-lines state)
-            (split-string (substring (erc-input-string state)
-                                     0
-                                     (match-beginning 0))
-                          erc--input-line-delim-regexp)
-            (erc--input-split-cmdp state) nil))))
-
 (defun erc--check-prompt-input-for-excess-lines (_ lines)
   "Return non-nil when trying to send too many LINES."
   (when erc-inhibit-multiline-input
@@ -5715,6 +5704,17 @@ erc-input
 (cl-defstruct (erc--input-split (:include erc-input))
   lines cmdp)
 
+(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)))))
+
 (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 fa39f4fcc6..e956538afa 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -115,6 +115,8 @@ erc-with-all-buffers-of-server
     (kill-buffer "#spam")))
 
 (defun erc-tests--send-prep ()
+  ;; Caller should probably shadow `erc-insert-modify-hook' or
+  ;; populate user tables for erc-button.
   (erc-mode)
   (insert "\n\n")
   (setq erc-input-marker (make-marker)
@@ -483,13 +485,19 @@ erc-send-whitespace-lines
        (should-not (funcall next)))
 
      (ert-info ("Multiline command with trailing blank filtered")
-       (insert "/msg #chan hi\r")
-       (erc-send-current-line)
-       (ert-info ("Input cleared")
+       (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")))
+         (insert p)
+         (erc-send-current-line)
          (erc-bol)
-         (should (eq (point) (point-max))))
-       (should (equal (funcall next) '("/msg #chan hi\n" nil t)))
-       (should-not (funcall next)))
+         (should (eq (point) (point-max)))
+         (while q
+           (should (equal (funcall next) (list (pop q) nil t))))
+         (should-not (funcall next))))
 
      (ert-info ("Multiline hunk with trailing whitespace not filtered")
        (insert "there\n ")
-- 
2.36.1
0001-Fix-regression-in-erc-send-input-line.patch (text/x-patch, 2.4 KB)
From 64ab9c43c08a7f2e5fb0b02c562f460dcf849c22 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Mon, 21 Mar 2022 19:21:57 -0700
Subject: [PATCH 1/4] Fix regression in erc-send-input-line

* lisp/erc/erc.el (erc-send-input-line): Restore remedial single-space
padding to ensure empty messages typed at the prompt without an
explicit /msg aren't rejected by the server.  This behavior is only
noticeable when `erc-send-whitespace-lines' is active.

* test/lisp/erc/erc-tests.el (erc-process-input-line): Add trailing
newline to more correctly simulate how it's actually called by
`erc-send-input'. (Bug#50008)
---
 lisp/erc/erc.el            |  2 ++
 test/lisp/erc/erc-tests.el | 10 +++++-----
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff482d4933..6725226d11 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2817,6 +2817,8 @@ erc-send-input-line-function
 
 (defun erc-send-input-line (target line &optional force)
   "Send LINE to TARGET."
+  (when (string= line "\n")
+    (setq line " \n"))
   (erc-message "PRIVMSG" (concat target " " line) force))
 
 (defun erc-get-arglist (fun)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 520f10dd4e..10e3c16dfc 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -340,19 +340,19 @@ erc-process-input-line
         (ert-info ("Implicit cmd via `erc-send-input-line-function'")
 
           (ert-info ("Baseline")
-            (erc-process-input-line "hi")
+            (erc-process-input-line "hi\n")
             (should (equal (pop erc-server-flood-queue)
                            '("PRIVMSG #chan :hi\r\n" . utf-8))))
 
           (ert-info ("Spaces preserved")
-            (erc-process-input-line "hi you")
+            (erc-process-input-line "hi you\n")
             (should (equal (pop erc-server-flood-queue)
                            '("PRIVMSG #chan :hi you\r\n" . utf-8))))
 
-          (ert-info ("Empty line transmitted without injected-space kludge")
-            (erc-process-input-line "")
+          (ert-info ("Empty line transmitted with injected-space kludge")
+            (erc-process-input-line "\n")
             (should (equal (pop erc-server-flood-queue)
-                           '("PRIVMSG #chan :\r\n" . utf-8))))
+                           '("PRIVMSG #chan : \r\n" . utf-8))))
 
           (should-not calls))))))
 
-- 
2.36.1
0002-Add-some-ERC-test-helpers.patch (text/x-patch, 2.2 KB)
From 4f71ec838470b8435d490e582177b7a9c2c8d520 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Tue, 5 Apr 2022 17:45:00 -0700
Subject: [PATCH 2/4] Add some ERC test helpers

* test/lisp/erc/erc-tests.el (erc-tests--test-prep,
erc-tests--set-fake-server-process): Factor out some common
buffer-prep boilerplate involving user input and the server process.
Shared with bug#54536.
---
 test/lisp/erc/erc-tests.el | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 10e3c16dfc..8b2af6e7c8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -114,6 +114,22 @@ erc-with-all-buffers-of-server
     (should (get-buffer "#spam"))
     (kill-buffer "#spam")))
 
+(defun erc-tests--send-prep ()
+  ;; Caller should probably shadow `erc-insert-modify-hook' or
+  ;; populate user tables for erc-button.
+  (erc-mode)
+  (insert "\n\n")
+  (setq erc-input-marker (make-marker)
+        erc-insert-marker (make-marker))
+  (set-marker erc-insert-marker (point-max))
+  (erc-display-prompt)
+  (should (= (point) erc-input-marker)))
+
+(defun erc-tests--set-fake-server-process (&rest args)
+  (setq erc-server-process
+        (apply #'start-process (car args) (current-buffer) args))
+  (set-process-query-on-exit-flag erc-server-process nil))
+
 (ert-deftest erc--switch-to-buffer ()
   (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el
 
@@ -197,14 +213,10 @@ erc-ring-previous-command-base-case
 (ert-deftest erc-ring-previous-command ()
   (with-current-buffer (get-buffer-create "*#fake*")
     (erc-mode)
-    (insert "\n\n")
+    (erc-tests--send-prep)
+    (setq-local erc-last-input-time 0)
     (should-not (local-variable-if-set-p 'erc-send-completed-hook))
     (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
-    (setq erc-input-marker (make-marker)
-          erc-insert-marker (make-marker))
-    (set-marker erc-insert-marker (point-max))
-    (erc-display-prompt)
-    (should (= (point) erc-input-marker))
     ;; 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)
-- 
2.36.1
0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch (text/x-patch, 20.5 KB)
From 7bf47171db925286f293b995826b5a649702bff8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Mon, 21 Mar 2022 05:40:16 -0700
Subject: [PATCH 3/4] Improve ERC's handling of multiline prompt input

* lisp/erc/erc.el (erc--pre-send-split-functions): Add new internal
hook allowing members to revise individual lines before sending.  This
was created with an eye toward possibly exporting it publicly as a
customizable option.
(erc-last-input-time): Tweak meaning of variable to match likely
original intent, which is that it's only updated on successful calls
to `erc-send-current-line'.
(erc--discard-trailing-multiline-nulls): Conditionally truncate list
of lines to be sent, skipping trailing blanks.  This constitutes a
behavioral change, but considering the nature of the bug being fixed,
is thought to be justified.
(erc--input-split): Add new internal struct containing split input
lines and flag for command detection.
(erc--input-line-delim-regexp): Add regex var for splitting multiline
prompt input.
(erc--blank-in-multiline-p): Add helper for detecting blank lines.
(erc--check-prompt-input-for-multiline-blanks,
erc--check-prompt-input-for-point-in-bounds,
erc--check-prompt-input-for-running-process): New functions to
encapsulate logic for various pre-flight idiot checks.
(erc--check-prompt-input-functions): Add new hook for validating
prompt input prior to clearing it.  Keep it internal for now.
(erc-send-current-line): pre-screen for blank lines and bail out if
necessary.
(erc-send-input): Add optional param to skip checking for blank lines.
Call hook `erc--pre-send-split-functions'.

* test/lisp/erc/erc-tests.el (erc-ring-previous-command): Use new test
helper.
(erc--input-line-delim-regexp,
erc--blank-in-multiline-input-p): Add tests.
(erc-tests--send-prep, erc-tests--set-fake-server-process,
erc-tests--with-process-input-spy): Add test helpers.
(erc--check-prompt-input-functions, erc-send-current-line,
erc-send-whitespace-lines): Add tests.
(Bug#54536)
---
 lisp/erc/erc.el            | 161 ++++++++++++++++++++--------
 test/lisp/erc/erc-tests.el | 208 +++++++++++++++++++++++++++++++++++++
 2 files changed, 328 insertions(+), 41 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6725226d11..a23ccbb0ab 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1054,6 +1054,29 @@ erc-pre-send-functions
   :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.  It you need this,
+;; please say so!
+
+(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls)
+  "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.
+
+The struct has five slots:
+
+  `string': The input string delivered by `erc-pre-send-functions'.
+  `insertp': Whether the lines should be inserted into the ERC buffer.
+  `sendp': Whether the lines should be sent to the IRC server.
+  `lines': A list of lines to be sent, each one a `string'.
+  `cmdp': Whether to interpret the 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.")
+
 (defvar erc-insert-this t
   "Insert the text into the target buffer or not.
 Functions on `erc-insert-pre-hook' can set this variable to nil
@@ -5526,7 +5549,7 @@ erc-end-of-input-line
   (point-max))
 
 (defvar erc-last-input-time 0
-  "Time of last call to `erc-send-current-line'.
+  "Time of last successful call to `erc-send-current-line'.
 If that function has never been called, the value is 0.")
 
 (defcustom erc-accidental-paste-threshold-seconds 0.2
@@ -5542,6 +5565,50 @@ erc-accidental-paste-threshold-seconds
   :version "26.1"
   :type '(choice number (other :tag "disabled" nil)))
 
+(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r)))
+
+(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 LINES is
+multiline or the first non-empty.  When `erc-send-whitespace-lines' is
+nil, return non-nil when any line is empty or consists of one or more
+spaces, tabs, or form-feeds."
+  (catch 'return
+    (let ((multilinep (cdr lines)))
+      (dolist (line lines)
+        (when (if erc-send-whitespace-lines
+                  (and (string-empty-p line) (not multilinep))
+                (string-match (rx bot (* (in " \t\f")) eot) line))
+          (throw 'return t))))))
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+  "Return non-nil when multiline prompt input has blank LINES."
+  (when (erc--blank-in-multiline-input-p lines)
+    (if erc-warn-about-blank-lines
+        "Blank line - ignoring..."
+      'invalid)))
+
+(defun erc--check-prompt-input-for-point-in-bounds (_ _)
+  "Return non-nil when point is before prompt."
+  (when (< (point) (erc-beg-of-input-line))
+    "Point is not in the input area"))
+
+(defun erc--check-prompt-input-for-running-process (string _)
+  "Return non-nil unless in an active ERC server buffer."
+  (unless (or (erc-server-buffer-live-p)
+              (erc-command-no-process-p string))
+    "ERC: No process running"))
+
+(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)
+  "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 non-nil,
+processing is abandoned and input is left untouched.  When the returned
+value is a string, pass it to `erc-error'.")
+
 (defun erc-send-current-line ()
   "Parse current line and send it to IRC."
   (interactive)
@@ -5555,20 +5622,21 @@ erc-send-current-line
                      (eolp))
             (expand-abbrev))
           (widen)
-          (if (< (point) (erc-beg-of-input-line))
-              (erc-error "Point is not in the input area")
+          (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 ((inhibit-read-only t)
-                  (str (erc-user-input))
                   (old-buf (current-buffer)))
-              (if (and (not (erc-server-buffer-live-p))
-                       (not (erc-command-no-process-p str)))
-                  (erc-error "ERC: No process running")
+              (progn ; unprogn this during next major surgery
                 (erc-set-active-buffer (current-buffer))
                 ;; Kill the input and the prompt
                 (delete-region (erc-beg-of-input-line)
                                (erc-end-of-input-line))
                 (unwind-protect
-                    (erc-send-input str)
+                    (erc-send-input str 'skip-ws-chk)
                   ;; Fix the buffer if the command didn't kill it
                   (when (buffer-live-p old-buf)
                     (with-current-buffer old-buf
@@ -5583,8 +5651,8 @@ erc-send-current-line
                           (set-buffer-modified-p buffer-modified))))))
 
                 ;; Only when last hook has been run...
-                (run-hook-with-args 'erc-send-completed-hook str))))
-          (setq erc-last-input-time now))
+                (run-hook-with-args 'erc-send-completed-hook str)))
+            (setq erc-last-input-time now)))
       (switch-to-buffer "*ERC Accidental Paste Overflow*")
       (lwarn 'erc :warning
              "You seem to have accidentally pasted some text!"))))
@@ -5601,21 +5669,31 @@ erc-command-regexp
 (cl-defstruct erc-input
   string insertp sendp)
 
-(defun erc-send-input (input)
+(cl-defstruct (erc--input-split (:include erc-input))
+  lines cmdp)
+
+(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)))))
+
+(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.
 Return non-nil only if we actually send anything."
   ;; Handle different kinds of inputs
-  (cond
-   ;; Ignore empty input
-   ((if erc-send-whitespace-lines
-        (string= input "")
-      (string-match "\\`[ \t\r\f\n]*\\'" input))
-    (when erc-warn-about-blank-lines
-      (message "Blank line - ignoring...")
-      (beep))
-    nil)
-   (t
+  (if (and (not skip-ws-chk)
+           (erc--check-prompt-input-for-multiline-blanks
+            input (split-string input erc--input-line-delim-regexp)))
+      (when erc-warn-about-blank-lines
+        (message "Blank line - ignoring...") ; compat
+        (beep))
     ;; This dynamic variable is used by `erc-send-pre-hook'.  It's
     ;; obsolete, and when it's finally removed, this binding should
     ;; also be removed.
@@ -5635,27 +5713,28 @@ 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 ((string (erc-input-string state)))
-          (if (or (if (>= emacs-major-version 28)
-                      (string-search "\n" string)
-                    (string-match "\n" string))
-                  (not (string-match erc-command-regexp string)))
-              (mapc
-               (lambda (line)
-		 (mapc
-                  (lambda (line)
-                    ;; Insert what has to be inserted for this.
-		    (when (erc-input-insertp state)
-                      (erc-display-msg line))
-                    (erc-process-input-line (concat line "\n")
-                                            (null erc-flood-protect) t))
-                  (or (and erc-flood-protect (erc-split-line line))
-                      (list line))))
-               (split-string string "\n"))
-            (erc-process-input-line (concat string "\n") t nil))
-          t))))))
+                 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)
+            (dolist (line lines)
+              (dolist (line (or (and erc-flood-protect (erc-split-line line))
+                                (list line)))
+                (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-command (line)
 ;;   (when erc-insert-this
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 8b2af6e7c8..af8cdb6016 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -297,6 +297,214 @@ erc-log-irc-protocol
     (kill-buffer "*erc-protocol*")
     (should-not erc-debug-irc-protocol)))
 
+(ert-deftest erc--input-line-delim-regexp ()
+  (let ((p erc--input-line-delim-regexp))
+    ;; none
+    (should (equal '("a" "b") (split-string "a\r\nb" p)))
+    (should (equal '("a" "b") (split-string "a\nb" p)))
+    (should (equal '("a" "b") (split-string "a\rb" p)))
+
+    ;; one
+    (should (equal '("") (split-string "" p)))
+    (should (equal '("a" "" "b") (split-string "a\r\rb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\rb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\nb" p)))
+    (should (equal '("a" "" "b") (split-string "a\r\r\nb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\r\nb" p)))
+    (should (equal '("a" "") (split-string "a\n" p)))
+    (should (equal '("a" "") (split-string "a\r" p)))
+    (should (equal '("a" "") (split-string "a\r\n" p)))
+    (should (equal '("" "b") (split-string "\nb" p)))
+    (should (equal '("" "b") (split-string "\rb" p)))
+    (should (equal '("" "b") (split-string "\r\nb" p)))
+
+    ;; two
+    (should (equal '("" "") (split-string "\r" p)))
+    (should (equal '("" "") (split-string "\n" p)))
+    (should (equal '("" "") (split-string "\r\n" p)))
+
+    ;; three
+    (should (equal '("" "" "") (split-string "\r\r" p)))
+    (should (equal '("" "" "") (split-string "\n\n" p)))
+    (should (equal '("" "" "") (split-string "\n\r" p)))))
+
+(ert-deftest erc--blank-in-multiline-input-p ()
+  (let ((check (lambda (s)
+                 (erc--blank-in-multiline-input-p
+                  (split-string s erc--input-line-delim-regexp)))))
+
+    (ert-info ("With `erc-send-whitespace-lines'")
+      (let ((erc-send-whitespace-lines t))
+        (should (funcall check ""))
+        (should-not (funcall check "\na"))
+        (should-not (funcall check "/msg a\n")) ; real /cmd
+        (should-not (funcall check "a\n\nb")) ; "" allowed
+        (should-not (funcall check "/msg a\n\nb")) ; non-/cmd
+        (should-not (funcall check " "))
+        (should-not (funcall check "\t"))
+        (should-not (funcall check "a\nb"))
+        (should-not (funcall check "a\n "))
+        (should-not (funcall check "a\n \t"))
+        (should-not (funcall check "a\n \f"))
+        (should-not (funcall check "a\n \nb"))
+        (should-not (funcall check "a\n \t\nb"))
+        (should-not (funcall check "a\n \f\nb"))))
+
+    (should (funcall check ""))
+    (should (funcall check " "))
+    (should (funcall check "\t"))
+    (should (funcall check "a\n\nb"))
+    (should (funcall check "a\n\nb"))
+    (should (funcall check "a\n "))
+    (should (funcall check "a\n \t"))
+    (should (funcall check "a\n \f"))
+    (should (funcall check "a\n \nb"))
+    (should (funcall check "a\n \t\nb"))
+
+    (should-not (funcall check "a\rb"))
+    (should-not (funcall check "a\nb"))
+    (should-not (funcall check "a\r\nb"))))
+
+(defun erc-tests--with-process-input-spy (test)
+  (with-current-buffer (get-buffer-create "FakeNet")
+    (let* ((erc-pre-send-functions
+            (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now
+           (inhibit-message noninteractive)
+           (erc-server-current-nick "tester")
+           (erc-last-input-time 0)
+           erc-accidental-paste-threshold-seconds
+           ;;
+           calls)
+      (cl-letf (((symbol-function 'erc-process-input-line)
+                 (lambda (&rest r) (push r calls)))
+                ((symbol-function 'erc-server-buffer)
+                 (lambda () (current-buffer))))
+        (erc-tests--send-prep)
+        (funcall test (lambda () (pop calls)))))
+    (when noninteractive (kill-buffer))))
+
+(ert-deftest erc--check-prompt-input-functions ()
+  (erc-tests--with-process-input-spy
+   (lambda (next)
+
+     (ert-info ("Errors when point not in prompt area") ; actually just dings
+       (insert "/msg #chan hi")
+       (forward-line -1)
+       (let ((e (should-error (erc-send-current-line))))
+         (should (equal "Point is not in the input area" (cadr e))))
+       (goto-char (point-max))
+       (ert-info ("Input remains untouched")
+         (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+     (ert-info ("Errors when no process running")
+       (let ((e (should-error (erc-send-current-line))))
+         (should (equal "ERC: No process running" (cadr e))))
+       (ert-info ("Input remains untouched")
+         (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+     (ert-info ("Errors when line contains empty newline")
+       (erc-bol)
+       (delete-region (point) (point-max))
+       (insert "one\n")
+       (let ((e (should-error (erc-send-current-line))))
+         (should (equal "Blank line - ignoring..." (cadr e))))
+       (goto-char (point-max))
+       (ert-info ("Input remains untouched")
+         (should (save-excursion (goto-char erc-input-marker)
+                                 (looking-at "one\n")))))
+
+     (should (= 0 erc-last-input-time))
+     (should-not (funcall next)))))
+
+;; These also indirectly tests `erc-send-input'
+
+(ert-deftest erc-send-current-line ()
+  (erc-tests--with-process-input-spy
+   (lambda (next)
+     (erc-tests--set-fake-server-process "sleep" "1")
+     (should (= 0 erc-last-input-time))
+
+     (ert-info ("Simple command")
+       (insert "/msg #chan hi")
+       (erc-send-current-line)
+       (ert-info ("Prompt restored")
+         (forward-line 0)
+         (should (looking-at-p erc-prompt)))
+       (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))))
+
+     (ert-info ("Simple non-command")
+       (insert "hi")
+       (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
+       (should (equal (funcall next) '("hi\n" nil t))))
+
+     (should (consp erc-last-input-time)))))
+
+(ert-deftest erc-send-whitespace-lines ()
+  (erc-tests--with-process-input-spy
+   (lambda (next)
+     (erc-tests--set-fake-server-process "sleep" "1")
+     (setq-local erc-send-whitespace-lines t)
+
+     (ert-info ("Multiline hunk with blank line correctly split")
+       (insert "one\n\ntwo")
+       (erc-send-current-line)
+       (ert-info ("Prompt restored")
+         (forward-line 0)
+         (should (looking-at-p erc-prompt)))
+       (ert-info ("Input cleared")
+         (erc-bol)
+         (should (eq (point) (point-max))))
+       (should (equal (funcall next) '("two\n" nil t)))
+       (should (equal (funcall next) '("\n" nil t)))
+       (should (equal (funcall next) '("one\n" nil t))))
+
+     (ert-info ("Multiline hunk with trailing newline filtered")
+       (insert "hi\n")
+       (erc-send-current-line)
+       (ert-info ("Input cleared")
+         (erc-bol)
+         (should (eq (point) (point-max))))
+       (should (equal (funcall next) '("hi\n" nil t)))
+       (should-not (funcall next)))
+
+     (ert-info ("Multiline hunk with trailing carriage filtered")
+       (insert "hi\r")
+       (erc-send-current-line)
+       (ert-info ("Input cleared")
+         (erc-bol)
+         (should (eq (point) (point-max))))
+       (should (equal (funcall next) '("hi\n" nil t)))
+       (should-not (funcall next)))
+
+     (ert-info ("Multiline command with trailing blank filtered")
+       (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")))
+         (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-not (funcall next))))
+
+     (ert-info ("Multiline hunk with trailing whitespace not filtered")
+       (insert "there\n ")
+       (erc-send-current-line)
+       (should (equal (funcall next) '(" \n" nil t)))
+       (should (equal (funcall next) '("there\n" nil t)))
+       (should-not (funcall next))))))
 
 ;; The point of this test is to ensure output is handled identically
 ;; regardless of whether a command handler is summoned.
-- 
2.36.1
0004-Optionally-prevent-sending-multiline-input-in-ERC.patch (text/x-patch, 5 KB)
From aaf22460711d8d669da296dfbf024053270e1cef Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <[email protected]>
Date: Wed, 27 Apr 2022 02:27:32 -0700
Subject: [PATCH 4/4] Optionally prevent sending multiline input in ERC

* lisp/erc/erc.el (erc-inhibit-multiline-input): Add option to cap the
number of lines to be sent before admonishing the user.
(erc-ask-about-multiline-input): Add option to ask instead of warning
user when `erc-inhibit-multiline-input' is reached.
(erc--check-prompt-input-for-excess-lines): Add validator to check
to possibly warn when too many lines are submitted for transmission.

* test/lisp/erc/erc-tests.el
(erc--check-prompt-input-for-excess-lines): Add test.
(Bug#54536)
---
 lisp/erc/erc.el            | 34 +++++++++++++++++++++++++++++++++-
 test/lisp/erc/erc-tests.el | 25 +++++++++++++++++++++++++
 2 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a23ccbb0ab..17bf3c9c0c 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -224,6 +224,20 @@ erc-send-whitespace-lines
   :group 'erc
   :type 'boolean)
 
+(defcustom erc-inhibit-multiline-input nil
+  "Conditionally disallow input consisting of multiple lines.
+Issue an error when the number of input lines submitted for sending
+exceeds this value."
+  :package-version '(ERC . "5.4.1") ; FIXME match to next release
+  :group 'erc
+  :type '(choice integer boolean))
+
+(defcustom erc-ask-about-multiline-input nil
+  "Ask to ignore `erc-inhibit-multiline-input' when tripped."
+  :package-version '(ERC . "5.4.1") ; FIXME match to next release
+  :group 'erc
+  :type 'boolean)
+
 (defcustom erc-hide-prompt nil
   "If non-nil, do not display the prompt for commands.
 
@@ -5581,6 +5595,23 @@ erc--blank-in-multiline-input-p
                 (string-match (rx bot (* (in " \t\f")) eot) line))
           (throw 'return t))))))
 
+(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)
+                   2
+                 erc-inhibit-multiline-input))
+          (seen 0)
+          msg)
+      (while (and (pop reversed) (< (cl-incf seen) max)))
+      (when (= seen max)
+        (setq msg (format "(exceeded by %d)" (1+ (length reversed))))
+        (unless (and erc-ask-about-multiline-input
+                     (y-or-n-p (concat "Send input " msg "?")))
+          (concat "Too many lines " msg))))))
+
 (defun erc--check-prompt-input-for-multiline-blanks (_ lines)
   "Return non-nil when multiline prompt input has blank LINES."
   (when (erc--blank-in-multiline-input-p lines)
@@ -5602,7 +5633,8 @@ erc--check-prompt-input-for-running-process
 (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-running-process
+    erc--check-prompt-input-for-excess-lines)
   "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 non-nil,
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index af8cdb6016..e956538afa 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -506,6 +506,31 @@ erc-send-whitespace-lines
        (should (equal (funcall next) '("there\n" nil t)))
        (should-not (funcall next))))))
 
+(ert-deftest erc--check-prompt-input-for-excess-lines ()
+  (ert-info ("Without `erc-inhibit-multiline-input'")
+    (should-not erc-inhibit-multiline-input)
+    (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))
+
+  (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" "")))
+      (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" "c")))))
+
+  (ert-info ("With `erc-ask-about-multiline-input'")
+    (let ((erc-inhibit-multiline-input t)
+          (erc-ask-about-multiline-input t))
+      (ert-simulate-keys '(?n ?\r ?y ?\r)
+        (should (erc--check-prompt-input-for-excess-lines "" '("a" "b")))
+        (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))))
+    (should-not erc-ask-about-multiline-input)))
+
 ;; The point of this test is to ensure output is handled identically
 ;; regardless of whether a command handler is summoned.
 
-- 
2.36.1
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.