* 29.0.50; Improve ERC's handling of multiline prompt input
@ 2022-03-23 13:26 J.P.
2022-03-23 13:50 ` bug#54536: " Lars Ingebrigtsen
` (5 more replies)
0 siblings, 6 replies; 17+ messages in thread
From: J.P. @ 2022-03-23 13:26 UTC (permalink / raw)
To: bug-gnu-emacs; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 5846 bytes --]
Tags: patch
ERC suffers from a few related issues concerning the early handling of
user input at the prompt. Especially troublesome is "multiline" input
containing line feeds and/or carriage returns. This patch (or at least
this discussion) aims to tackle both.
Any solution should probably address these fundamental UX questions:
1. What should happen when a user submits multiline input containing
empty lines? Should these be padded so they're not rejected by the
server? If so, where in the processing pipeline should that occur?
Should `erc-send-whitespace-lines' play a role here?
This patch says yes to the latter and interprets that option as
meaning "preserve whitespace-only lines and create them as necessary
from blank ones." As to where padding should happen, this patch punts
and retains the existing (unfortunate) practice of treating them at
the last minute.
2. Should trailing blank lines be treated differently? If so, how?
Should they be auto-padded? Simply dropped? Or should encountering
them raise an error?
When `erc-send-whitespace-lines' is non-nil, this patch drops
trailing blanks by default, but it also provides an escape hatch.
3. When `erc-send-whitespace-lines' is non-nil, should it auto-pad a
submission consisting of a single empty line? Should it allow a
whitespace-only singleton through?
This patch says no to the first and yes to the second.
4. Should slash commands, like /MSG be allowed to lead a multiline
submission?
This patch says no, still choosing to interpret commands as always
consisting of a single line.
To offer some flexibility, I'm introducing a hook to perform some
validation on the input being submitted. It comes prepopulated with
functions that replicate existing behavior, such as ensuring point
resides within the input area. It also contains an additional function
to perform the blank-detection business. While it's true that multiple
members of this hook may end up repeating some basic operations (such as
splitting the input string), at present, this isn't the case, and such
waste is pretty negligible anyway since this is an interactive function.
There is one behavioral change being introduced that doesn't come
with an escape hatch, and that's the preservation of input when
a validation check fails. Previously, a user's input would be wiped
out, which seems undesirable and unnecessary in all cases (IMO).
For these and any other, less significant changes not mentioned, the
floor is open for questions and debate, as usual. Thanks.
(See also: "bug#50008: 28.0.50; ERC sends empty lines with user input"
and "bug#50006: 28.0.50; remove deprecated option erc-send-pre-hook".)
In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.31, cairo version 1.17.4)
of 2022-03-23 built on localhost
Repository revision: fed9a353dbe79a7a6acc74c1e223c46e7541e627
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 35 (Workstation Edition)
Configured using:
'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
'CFLAGS=-O0 -g3'
PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig'
Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XPM GTK3 ZLIB
Important settings:
value of $LANG: en_US.UTF-8
value of $XMODIFIERS: @im=ibus
locale-coding-system: utf-8-unix
Major mode: Lisp Interaction
Minor modes in effect:
tooltip-mode: t
global-eldoc-mode: t
eldoc-mode: t
show-paren-mode: t
electric-indent-mode: t
mouse-wheel-mode: t
tool-bar-mode: t
menu-bar-mode: t
file-name-shadow-mode: t
global-font-lock-mode: t
font-lock-mode: t
blink-cursor-mode: t
line-number-mode: t
indent-tabs-mode: t
transient-mark-mode: t
auto-composition-mode: t
auto-encryption-mode: t
auto-compression-mode: t
Load-path shadows:
None found.
Features:
(shadow sort mail-extr emacsbug message mailcap yank-media rmc puny
dired dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg
rfc6068 epg-config gnus-util text-property-search time-date seq gv
subr-x byte-opt bytecomp byte-compile cconv mm-decode mm-bodies
mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-loaddefs
cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils
iso-transl tooltip eldoc paren electric uniquify ediff-hook vc-hooks
lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd
tool-bar dnd fontset image regexp-opt fringe tabulated-list replace
newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar
rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock
font-lock syntax font-core term/tty-colors frame minibuffer nadvice
simple cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan
thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian
slovak czech european ethiopic indian cyrillic chinese composite
emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help
abbrev obarray cl-preloaded button loaddefs faces cus-face macroexp
files window text-properties overlay sha1 md5 base64 format env
code-pages mule custom widget keymap hashtable-print-readable backquote
threads dbusbind inotify lcms2 dynamic-setting system-font-setting
font-render-setting cairo move-toolbar gtk x-toolkit x multi-tty
make-network-process emacs)
Memory information:
((conses 16 43960 5198)
(symbols 48 5704 1)
(strings 32 15802 1589)
(string-bytes 1 526831)
(vectors 16 12066)
(vector-slots 8 167842 8149)
(floats 8 20 55)
(intervals 56 241 0)
(buffers 992 11))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-regression-in-erc-send-input-line.patch --]
[-- Type: text/x-patch, Size: 2448 bytes --]
From fe1f21eeb9027116f263b968d792943b92064df3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 21 Mar 2022 19:21:57 -0700
Subject: [PATCH 1/2] 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 52fe106f2d..d8ef62cf93 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Improve-ERC-s-handling-of-multiline-prompt-input.patch --]
[-- Type: text/x-patch, Size: 18130 bytes --]
From 8a921612bdafdc5720fe12b49d215c1a42f9c0d0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 21 Mar 2022 05:40:16 -0700
Subject: [PATCH 2/2] Improve ERC's handling of multiline prompt input
* lisp/erc/erc.el (erc-pre-send-functions,
erc-discard-trailing-multiline-nulls): Add the latter, a new function,
that drops any trailing null lines from a multiline sequence submitted
for processing. Add it to `erc-pre-send-functions' as the lone new
default.
(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--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.
(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.
* 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.
---
lisp/erc/erc.el | 103 ++++++++++++++-----
test/lisp/erc/erc-tests.el | 200 +++++++++++++++++++++++++++++++++++--
2 files changed, 273 insertions(+), 30 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d8ef62cf93..cbb30bab5b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1040,7 +1040,7 @@ erc-send-pre-hook
:type 'hook)
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
-(defcustom erc-pre-send-functions nil
+(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls)
"Special hook run to possibly alter the string that is sent.
The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
@@ -5536,7 +5536,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
@@ -5552,6 +5552,66 @@ 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 (string)
+ "Detect whether STRING contains any blank lines.
+When `erc-send-whitespace-lines' is in effect and the input is not a
+\"command\", like /msg, return nil if the input is multiline or the line
+is 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 ((lines (split-string string erc--input-line-delim-regexp))
+ (cmdp '--?--))
+ (dolist (line lines)
+ (when (if erc-send-whitespace-lines
+ (and (string= line "")
+ (or (null (cdr lines)) ; string is one line
+ (if (eq cmdp '--?--) ; string is /cmd
+ (setq cmdp (string-match erc-command-regexp
+ (car lines)))
+ cmdp)))
+ (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
+ (cl-callf (lambda (s) (string-trim-right s "[\r\n]+"))
+ (erc-input-string state))))
+
+(defun erc-check-prompt-input-for-multiline-blanks (string)
+ "Return non-nil when multiline prompt input has blank lines."
+ (when (erc--blank-in-multiline-input-p string)
+ (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"))
+
+(defcustom 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. If any member
+returns non-nil, processing is abandoned and input is left untouched.
+When the returned value is a string, pass it to `erc-error'."
+ :group 'erc
+ :version "29.1"
+ :type 'hook)
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
@@ -5565,20 +5625,20 @@ 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)))
+ (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
@@ -5593,8 +5653,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!"))))
@@ -5611,21 +5671,16 @@ erc-command-regexp
(cl-defstruct erc-input
string insertp sendp)
-(defun erc-send-input (input)
+(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))
+ (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.
@@ -5663,9 +5718,9 @@ erc-send-input
(null erc-flood-protect) t))
(or (and erc-flood-protect (erc-split-line line))
(list line))))
- (split-string string "\n"))
+ (split-string string erc--input-line-delim-regexp))
(erc-process-input-line (concat string "\n") t nil))
- 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 10e3c16dfc..6a9d291f8a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -197,14 +197,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)
@@ -285,6 +281,198 @@ 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 ()
+ (ert-info ("With `erc-send-whitespace-lines'")
+ (let ((erc-send-whitespace-lines t))
+ (should (erc--blank-in-multiline-input-p ""))
+ (should (erc--blank-in-multiline-input-p "/msg a\n")) ; likely oops
+ (should (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; "" not allowed
+ (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed
+ (should-not (erc--blank-in-multiline-input-p " "))
+ (should-not (erc--blank-in-multiline-input-p "\t"))
+ (should-not (erc--blank-in-multiline-input-p "a\nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n "))
+ (should-not (erc--blank-in-multiline-input-p "a\n \t"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \f"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \t\nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \f\nb"))))
+
+ (should (erc--blank-in-multiline-input-p ""))
+ (should (erc--blank-in-multiline-input-p " "))
+ (should (erc--blank-in-multiline-input-p "\t"))
+ (should (erc--blank-in-multiline-input-p "a\n\nb"))
+ (should (erc--blank-in-multiline-input-p "a\n\nb"))
+ (should (erc--blank-in-multiline-input-p "a\n "))
+ (should (erc--blank-in-multiline-input-p "a\n \t"))
+ (should (erc--blank-in-multiline-input-p "a\n \f"))
+ (should (erc--blank-in-multiline-input-p "a\n \nb"))
+ (should (erc--blank-in-multiline-input-p "a\n \t\nb"))
+
+ (should-not (erc--blank-in-multiline-input-p "a\rb"))
+ (should-not (erc--blank-in-multiline-input-p "a\nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\r\nb")))
+
+(defun erc-tests--send-prep ()
+ (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))
+
+(defmacro erc-tests--with-process-input-spy (calls-var &rest body)
+ (declare (indent 1))
+ `(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-var)
+ (cl-letf (((symbol-function 'erc-process-input-line)
+ (lambda (&rest r) (push r ,calls-var)))
+ ((symbol-function 'erc-server-buffer)
+ (lambda () (current-buffer))))
+ (erc-tests--send-prep)
+ ,@body))
+ (when noninteractive (kill-buffer))))
+
+(ert-deftest erc-check-prompt-input-functions ()
+ (erc-tests--with-process-input-spy calls
+
+ (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 calls)))
+
+;; These also indirectly tests `erc-send-input'
+
+(ert-deftest erc-send-current-line ()
+ (erc-tests--with-process-input-spy calls
+
+ (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 (pop calls) '("/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 (pop calls) '("hi\n" nil t))))
+
+ (should (consp erc-last-input-time))))
+
+(ert-deftest erc-send-whitespace-lines ()
+ (erc-tests--with-process-input-spy calls
+
+ (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 (pop calls) '("two\n" nil t)))
+ (should (equal (pop calls) '("\n" nil t)))
+ (should (equal (pop calls) '("one\n" nil t))))
+
+ (ert-info ("Multiline hunk with trailing blank filtered")
+ (insert "hi\n")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (pop calls) '("hi\n" nil t)))
+ (should-not (pop calls)))
+
+ (ert-info ("Multiline hunk with trailing whitespace not filtered")
+ (insert "there\n ")
+ (erc-send-current-line)
+ (should (equal (pop calls) '(" \n" nil t)))
+ (should (equal (pop calls) '("there\n" nil t)))
+ (should-not (pop calls)))))
;; The point of this test is to ensure output is handled identically
;; regardless of whether a command handler is summoned.
--
2.35.1
^ permalink raw reply related [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
@ 2022-03-23 13:50 ` Lars Ingebrigtsen
[not found] ` <87czic93sa.fsf@gnus.org>
` (4 subsequent siblings)
5 siblings, 0 replies; 17+ messages in thread
From: Lars Ingebrigtsen @ 2022-03-23 13:50 UTC (permalink / raw)
To: J.P.; +Cc: emacs-erc, 54536
"J.P." <jp@neverwas.me> writes:
> 1. What should happen when a user submits multiline input containing
> empty lines? Should these be padded so they're not rejected by the
> server? If so, where in the processing pipeline should that occur?
> Should `erc-send-whitespace-lines' play a role here?
>
> This patch says yes to the latter and interprets that option as
> meaning "preserve whitespace-only lines and create them as necessary
> from blank ones." As to where padding should happen, this patch punts
> and retains the existing (unfortunate) practice of treating them at
> the last minute.
Makes sense to me.
> 2. Should trailing blank lines be treated differently? If so, how?
> Should they be auto-padded? Simply dropped? Or should encountering
> them raise an error?
>
> When `erc-send-whitespace-lines' is non-nil, this patch drops
> trailing blanks by default, but it also provides an escape hatch.
Dropping trailing blank lines is a good thing, I think.
> 3. When `erc-send-whitespace-lines' is non-nil, should it auto-pad a
> submission consisting of a single empty line? Should it allow a
> whitespace-only singleton through?
>
> This patch says no to the first and yes to the second.
Sounds good.
> 4. Should slash commands, like /MSG be allowed to lead a multiline
> submission?
>
> This patch says no, still choosing to interpret commands as always
> consisting of a single line.
Ditto.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <87czic93sa.fsf@gnus.org>
@ 2022-03-24 19:50 ` J.P.
2022-03-24 20:16 ` Michael Albinus
[not found] ` <8735j7jecz.fsf@gmx.de>
[not found] ` <87ee2rb04e.fsf@neverwas.me>
1 sibling, 2 replies; 17+ messages in thread
From: J.P. @ 2022-03-24 19:50 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: emacs-erc, 54536
Lars Ingebrigtsen <larsi@gnus.org> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> 1. What should happen when a user submits multiline input containing
>> empty lines? [...] This patch says [...]
>
> Makes sense to me.
>
>> 2. Should trailing blank lines be treated differently? [...]
>>
> Dropping trailing blank lines is a good thing, I think.
>
>> 3. When `erc-send-whitespace-lines' is non-nil, should it [...]
>> This patch says no to the first and yes to the second.
>
> Sounds good.
Appreciate the feedback!
I'd like to get #48598 ("buffer-naming collisions involving bouncers in
ERC") up to snuff relatively soon. Would it make sense to petition
emacs-devel for eyeballs at some point? Also, is there any way to try
out some patches on EMBA CI? I have a feeling some of my tests that work
locally and on GitLab.com's GCP runners may have to be tuned a bit for
EMBA. (Or would these questions be better put to the build-automation
folks?) Thanks.
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-24 19:50 ` J.P.
@ 2022-03-24 20:16 ` Michael Albinus
[not found] ` <8735j7jecz.fsf@gmx.de>
1 sibling, 0 replies; 17+ messages in thread
From: Michael Albinus @ 2022-03-24 20:16 UTC (permalink / raw)
To: J.P.; +Cc: Lars Ingebrigtsen, emacs-erc, 54536
"J.P." <jp@neverwas.me> writes:
Hi,
> I'd like to get #48598 ("buffer-naming collisions involving bouncers in
> ERC") up to snuff relatively soon. Would it make sense to petition
> emacs-devel for eyeballs at some point? Also, is there any way to try
> out some patches on EMBA CI? I have a feeling some of my tests that work
> locally and on GitLab.com's GCP runners may have to be tuned a bit for
> EMBA. (Or would these questions be better put to the build-automation
> folks?) Thanks.
On EMBA, also git branches run the CI tests. See file test/infra/gitlab-ci.yml:
--8<---------------cut here---------------start------------->8---
- if: '$CI_COMMIT_BRANCH !~ /^(master|emacs|feature|fix)/'
when: never
--8<---------------cut here---------------end--------------->8---
So your branch name must start with one of these words.
Best regards, Michael.
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <8735j7jecz.fsf@gmx.de>
@ 2022-03-24 23:38 ` J.P.
[not found] ` <87tubm53ar.fsf@neverwas.me>
1 sibling, 0 replies; 17+ messages in thread
From: J.P. @ 2022-03-24 23:38 UTC (permalink / raw)
To: Michael Albinus; +Cc: Lars Ingebrigtsen, emacs-erc, 54536
Hi Michael,
Michael Albinus <michael.albinus@gmx.de> writes:
> So your branch name must start with one of these words.
Thanks a lot for the explanation. Among those prefixes, "fix" seems the
least misleading for my purposes, those being (1) rapid iteration toward
a passing pipeline and (2) minimal distraction for others. Hopefully,
there's already precedent for more ephemeral, fly-by-night "fix/*"
branches. If so, and there's a prescribed naming scheme to that end
(something like "fix/bug-48598-temp" or similar), perusing the remote
refs hasn't revealed it. Regardless, I'll wait for a go-ahead before
trying anything.
Thanks again,
J.P.
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <87tubm53ar.fsf@neverwas.me>
@ 2022-03-25 15:29 ` Lars Ingebrigtsen
[not found] ` <874k3mf3th.fsf@gnus.org>
1 sibling, 0 replies; 17+ messages in thread
From: Lars Ingebrigtsen @ 2022-03-25 15:29 UTC (permalink / raw)
To: J.P.; +Cc: Michael Albinus, emacs-erc, 54536
"J.P." <jp@neverwas.me> writes:
> Thanks a lot for the explanation. Among those prefixes, "fix" seems the
> least misleading for my purposes, those being (1) rapid iteration toward
> a passing pipeline and (2) minimal distraction for others. Hopefully,
> there's already precedent for more ephemeral, fly-by-night "fix/*"
> branches. If so, and there's a prescribed naming scheme to that end
> (something like "fix/bug-48598-temp" or similar), perusing the remote
> refs hasn't revealed it. Regardless, I'll wait for a go-ahead before
> trying anything.
Calling the branch fix/whatever is fine.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <87ee2rb04e.fsf@neverwas.me>
@ 2022-03-25 15:31 ` Lars Ingebrigtsen
[not found] ` <87zgledp6a.fsf@gnus.org>
1 sibling, 0 replies; 17+ messages in thread
From: Lars Ingebrigtsen @ 2022-03-25 15:31 UTC (permalink / raw)
To: J.P.; +Cc: emacs-erc, 54536
"J.P." <jp@neverwas.me> writes:
> I'd like to get #48598 ("buffer-naming collisions involving bouncers in
> ERC") up to snuff relatively soon. Would it make sense to petition
> emacs-devel for eyeballs at some point?
Sure, if you want to. I had a brief peek myself, but the patch series
was so long that I didn't really have anything to say. :-/
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <87zgledp6a.fsf@gnus.org>
@ 2022-03-25 19:20 ` J.P.
0 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-03-25 19:20 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: emacs-erc, 54536
Lars Ingebrigtsen <larsi@gnus.org> writes:
> "J.P." <jp@neverwas.me> writes:
>
>> I'd like to get #48598 ("buffer-naming collisions involving bouncers in
>> ERC") up to snuff relatively soon. Would it make sense to petition
>> emacs-devel for eyeballs at some point?
>
> Sure, if you want to. I had a brief peek myself, but the patch series
> was so long that I didn't really have anything to say. :-/
Thanks for the peek. Your impression is more than fair. I think for now
I'll try soliciting specific questions, perhaps via top-level replies to
that bug but with subject headers changed to reflect whatever's being
posed (while also Cc-ing various persons where appropriate). And in
cases where a question may have broader relevance, I'll hit up
help-gnu-emacs first/instead.
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <874k3mf3th.fsf@gnus.org>
@ 2022-03-25 19:23 ` J.P.
2022-03-26 16:44 ` Lars Ingebrigtsen
0 siblings, 1 reply; 17+ messages in thread
From: J.P. @ 2022-03-25 19:23 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: Michael Albinus, emacs-erc, 54536
Lars Ingebrigtsen <larsi@gnus.org> writes:
> Calling the branch fix/whatever is fine.
Thanks.
BTW, I think these can go:
refs/heads/features/erc-message-tags
refs/heads/fix/bug-34657-erc-hooks
Is it customary to contact the authors before deleting?
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-25 19:23 ` J.P.
@ 2022-03-26 16:44 ` Lars Ingebrigtsen
0 siblings, 0 replies; 17+ messages in thread
From: Lars Ingebrigtsen @ 2022-03-26 16:44 UTC (permalink / raw)
To: J.P.; +Cc: Michael Albinus, emacs-erc, 54536
"J.P." <jp@neverwas.me> writes:
> BTW, I think these can go:
>
> refs/heads/features/erc-message-tags
> refs/heads/fix/bug-34657-erc-hooks
>
> Is it customary to contact the authors before deleting?
If the branches have been merged (or their contents have been applied to
the trunk otherwise), it's OK to delete them. If not, it's better to
contact the authors first.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] <ADC23CE3-E6A4-4FF8-B033-174F60B2D59E@getmailspring.com>
@ 2022-04-03 19:44 ` J.P.
0 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-04-03 19:44 UTC (permalink / raw)
To: Matheus Fillipe; +Cc: emacs-erc, 54536
Matheus Fillipe <matheusfillipeag@gmail.com> writes:
> I've been testing this and as an evil-mode user I had a problem that
> whenever I paste something or sometimes just out of the blue I would
> send one empty line after my message. After a few hours using erc this
> it only happened once but Im not able to reproduce it so... I think
> this is a great addition and it solves my problem!
Appreciate the feedback! (Although, we ought not settle for "it
only happened once," if we can help it.) A few silly questions:
1. In your testing, what was the value of `erc-send-whitespace-lines'?
2. Do you have any unusual bindings or minor modes going (other than
Evil)? Just asking to try and gauge whether it's worth doing
something like an emacs -Q.
3. How do you send input normally? For example: switch to insert state,
type stuff after the prompt, hit RET. Just asking in case I try
recreating your setup.
4. Are you willing to keep testing it? If so and it happens again, can
you try a `view-lossage' and maybe also a `report-emacs-bug', and
just copy-paste all the generated facts into a reply?
BTW, I guess the "reply" button on the MHonArc-generated bug-gnu-emacs
pages doesn't do a "reply all" (or else there's some trick I don't know
about to get it to include Cc participants).
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] <87y20m7xzs.fsf@neverwas.me>
@ 2022-04-03 20:15 ` Matheus Fillipe
0 siblings, 0 replies; 17+ messages in thread
From: Matheus Fillipe @ 2022-04-03 20:15 UTC (permalink / raw)
To: J.P.; +Cc: emacs-erc@gnu.org, 54536@debbugs.gnu.org
[-- Attachment #1: Type: text/plain, Size: 1993 bytes --]
So far the patches seem to have fixed the issue I long had sending empty lines randomly.
Here are my replies to your questions.
1) erc-send-whitespace-lines was set to nil
2) Hmm no I don't have nothing quite unusual on erc that i can think of now. I have erc-nl-nicks.
3) Yes exactly nothing unusual about that.
4) I will since it seems to have "fixed" the issue so far. I will keep that in mind in case it happens again.
That one case was the only until now. Didn't happen again and I've tried to reproduce but would never happen, so I'm not sure if it really matters. I will keep testing.
On Apr 3 2022, at 4:44 pm, J.P. <jp@neverwas.me> wrote:
> Matheus Fillipe <matheusfillipeag@gmail.com> writes:
>
> > I've been testing this and as an evil-mode user I had a problem that
> > whenever I paste something or sometimes just out of the blue I would
> > send one empty line after my message. After a few hours using erc this
> > it only happened once but Im not able to reproduce it so... I think
> > this is a great addition and it solves my problem!
>
> Appreciate the feedback! (Although, we ought not settle for "it
> only happened once," if we can help it.) A few silly questions:
>
> 1. In your testing, what was the value of `erc-send-whitespace-lines'?
> 2. Do you have any unusual bindings or minor modes going (other than
> Evil)? Just asking to try and gauge whether it's worth doing
> something like an emacs -Q.
>
> 3. How do you send input normally? For example: switch to insert state,
> type stuff after the prompt, hit RET. Just asking in case I try
> recreating your setup.
>
> 4. Are you willing to keep testing it? If so and it happens again, can
> you try a `view-lossage' and maybe also a `report-emacs-bug', and
> just copy-paste all the generated facts into a reply?
>
> BTW, I guess the "reply" button on the MHonArc-generated bug-gnu-emacs
> pages doesn't do a "reply all" (or else there's some trick I don't know
> about to get it to include Cc participants).
>
[-- Attachment #2: Type: text/html, Size: 2355 bytes --]
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
2022-03-23 13:50 ` bug#54536: " Lars Ingebrigtsen
[not found] ` <87czic93sa.fsf@gnus.org>
@ 2022-04-23 3:17 ` J.P.
2022-04-29 13:05 ` J.P.
` (2 subsequent siblings)
5 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-04-23 3:17 UTC (permalink / raw)
To: 54536; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 2782 bytes --]
v3. Except for a subtle change involving compatibility, there aren't any
real differences in behavior.
"J.P." <jp@neverwas.me> writes:
> 4. Should slash commands, like /MSG be allowed to lead a multiline
> submission?
>
> This patch says no, still choosing to interpret commands as always
> consisting of a single line.
This description is rather sloppy and ambiguous, so I have attempted to
clarify things below (underscores are spaces). The subtle compat change
happens between the first two examples. Basically, when the option
`erc-send-whitespace-lines' is active and trailing blank lines are
present, the new (v3) iteration of this patch no longer interprets slash
commands but instead just sends lines as text. This more closely mirrors
traditional ERC behavior.
(I suppose we could also have an option to go the other, v2 route, if
people want.)
Patch v2 (previous)
~~~~~~~~~~~~~~~~~~~
- `erc-send-whitespace-lines' ON
- All trailing blanks stripped
- Command interpreted
- Nothing inserted (unless echo-message cap negotiated, coming in #49860)
input:
. ERC> /msg #chan hi
.
. [RET]
I/O:
-> PRIVMSG #chan :hi
shown:
(nothing)
Patch v3 (this)
~~~~~~~~~~~~~~~
- `erc-send-whitespace-lines' ON
- Trailing blanks stripped
- Command not interpreted
input:
. ERC> /msg #chan hi
.
. [RET]
I/O:
-> PRIVMSG #chan :/msg #chan hi
shown:
<me> /msg #chan hi
The rest are just included for good measure, but none has changed:
HEAD
~~~~
- `erc-send-whitespace-lines' ON or OFF
- Trailing blanks not stripped or padded
- Command not interpreted
- Protocol violation (my fault from #50008, not in 5.4.1 or 28)
input:
. ERC> /msg #chan hi
. [RET]
I/O:
-> PRIVMSG #chan :/msg #chan hi
-> PRIVMSG #chan :
<- :irc.foonet.org 412 me :No text to send
shown:
. <me> /msg #chan hi
. <me>
. *** No text to send
Patch v2 and v3
~~~~~~~~~~~~~~~
- `erc-send-whitespace-lines' OFF
- ding, input remains, echo area says "Blank line - ignoring ..."
input:
. ERC> /msg #chan hi
. _* [RET]
I/O:
(nothing)
shown:
(nothing)
All (HEAD, v2, v3)
~~~~~~~~~~~~~~~~~~
- `erc-send-whitespace-lines' ON (or OFF when old)
- Command not interpreted
- User-padded trailing blank preserved
input:
. ERC > /msg #chan hi
. _ [RET]
I/O:
-> PRIVMSG #chan :/msg #chan hi
-> PRIVMSG #chan :_
shown:
<me> /msg #chan hi
<me>
- `erc-send-whitespace-lines' ON (or OFF when old)
- Command not interpreted
- Intervening blank padded
input:
. ERC> /msg #chan hi
.
. again [RET]
I/O:
-> PRIVMSG #chan :/msg #chan hi
-> PRIVMSG #chan :_
-> PRIVMSG #chan :again
shown:
<me> /msg #chan hi
<me>
<me> again
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 17712 bytes --]
From b58ad0d7c08d0002276f261d508cfca4056cc9ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 22 Apr 2022 17:35:46 -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
[SQUASH-ME] Add hook for splitting multiline input in ERC
lisp/erc/erc.el | 160 +++++++++++++++++++-------
test/lisp/erc/erc-tests.el | 229 +++++++++++++++++++++++++++++++++++--
2 files changed, 337 insertions(+), 52 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ab786c1989..e2fe5c6476 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1040,7 +1040,7 @@ erc-send-pre-hook
:type 'hook)
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
-(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls)
+(defcustom erc-pre-send-functions nil
"Special hook run to possibly alter the string that is sent.
The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
@@ -1052,7 +1052,26 @@ erc-pre-send-functions
`sendp': Whether the string should be sent to the irc server."
:group 'erc
:type 'hook
- :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA
+ :version "27.1")
+
+(defcustom 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."
+ :group 'erc
+ :type 'hook
+ :package-version '(ERC . "5.4.1"))
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
@@ -5556,22 +5575,15 @@ erc--input-line-delim-regexp
(defun erc--blank-in-multiline-input-p (string)
"Detect whether STRING contains any blank lines.
-When `erc-send-whitespace-lines' is in effect and the input is not a
-\"command\", like /msg, return nil if the input is multiline or the line
-is 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."
+When `erc-send-whitespace-lines' is in effect, return nil if the input
+is multiline or the line is 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 ((lines (split-string string erc--input-line-delim-regexp))
- (cmdp '--?--))
+ (let ((lines (split-string string erc--input-line-delim-regexp)))
(dolist (line lines)
(when (if erc-send-whitespace-lines
- (and (string= line "")
- (or (null (cdr lines)) ; string is one line
- (if (eq cmdp '--?--) ; string is /cmd
- (setq cmdp (string-match erc-command-regexp
- (car lines)))
- cmdp)))
+ (and (string= line "") (null (cdr lines)))
(string-match (rx bot (* (in " \t\f")) eot) line))
(throw 'return t))))))
@@ -5579,8 +5591,13 @@ erc-discard-trailing-multiline-nulls
"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
- (cl-callf (lambda (s) (string-trim-right s "[\r\n]+"))
- (erc-input-string state))))
+ (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-multiline-blanks (string)
"Return non-nil when multiline prompt input has blank lines."
@@ -5671,6 +5688,9 @@ erc-command-regexp
(cl-defstruct erc-input
string insertp sendp)
+(cl-defstruct (erc-input-split (:include erc-input))
+ lines cmdp)
+
(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.
@@ -5700,26 +5720,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)
- (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 erc--input-line-delim-regexp))
- (erc-process-input-line (concat string "\n") t nil))
+ 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)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 53461accbc..3746f4862e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -330,9 +330,9 @@ erc--blank-in-multiline-input-p
(ert-info ("With `erc-send-whitespace-lines'")
(let ((erc-send-whitespace-lines t))
(should (erc--blank-in-multiline-input-p ""))
- (should (erc--blank-in-multiline-input-p "/msg a\n")) ; likely oops
- (should (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; "" not allowed
+ (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd
(should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed
+ (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd
(should-not (erc--blank-in-multiline-input-p " "))
(should-not (erc--blank-in-multiline-input-p "\t"))
(should-not (erc--blank-in-multiline-input-p "a\nb"))
@@ -358,121 +358,140 @@ erc--blank-in-multiline-input-p
(should-not (erc--blank-in-multiline-input-p "a\nb"))
(should-not (erc--blank-in-multiline-input-p "a\r\nb")))
-(defmacro erc-tests--with-process-input-spy (calls-var &rest body)
- (declare (indent 1))
- `(with-current-buffer (get-buffer-create "FakeNet")
- (let ((erc-pre-send-functions
+(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-var)
- (cl-letf (((symbol-function 'erc-process-input-line)
- (lambda (&rest r) (push r ,calls-var)))
- ((symbol-function 'erc-server-buffer)
- (lambda () (current-buffer))))
- (erc-tests--send-prep)
- ,@body))
- (when noninteractive (kill-buffer))))
+ ;;
+ 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 calls
-
- (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 calls)))
+ (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 calls
-
- (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 (pop calls) '("/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 (pop calls) '("hi\n" nil t))))
-
- (should (consp erc-last-input-time))))
+ (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 calls
-
- (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 (pop calls) '("two\n" nil t)))
- (should (equal (pop calls) '("\n" nil t)))
- (should (equal (pop calls) '("one\n" nil t))))
-
- (ert-info ("Multiline hunk with trailing blank filtered")
- (insert "hi\n")
- (erc-send-current-line)
- (ert-info ("Input cleared")
- (erc-bol)
- (should (eq (point) (point-max))))
- (should (equal (pop calls) '("hi\n" nil t)))
- (should-not (pop calls)))
-
- (ert-info ("Multiline hunk with trailing whitespace not filtered")
- (insert "there\n ")
- (erc-send-current-line)
- (should (equal (pop calls) '(" \n" nil t)))
- (should (equal (pop calls) '("there\n" nil t)))
- (should-not (pop calls)))))
+ (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")
+ (insert "/msg #chan hi\r")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("/msg #chan hi\n" 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Fix-regression-in-erc-send-input-line.patch --]
[-- Type: text/x-patch, Size: 2448 bytes --]
From aa381598d4ab452bf1a40269cd7c728e3c113a1b Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 52fe106f2d..d8ef62cf93 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Add-some-ERC-test-helpers.patch --]
[-- Type: text/x-patch, Size: 2161 bytes --]
From 914a58579c6efcdc6746763e382004b1f4e2a2fb Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 10e3c16dfc..c9254e6d42 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -114,6 +114,20 @@ erc-with-all-buffers-of-server
(should (get-buffer "#spam"))
(kill-buffer "#spam")))
+(defun erc-tests--send-prep ()
+ (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 +211,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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch --]
[-- Type: text/x-patch, Size: 17694 bytes --]
From 6f084d00e7776527b58bf9ed3c4356b85c1dadd7 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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-functions,
erc-discard-trailing-multiline-nulls): Add the latter, a new function,
that drops any trailing null lines from a multiline sequence submitted
for processing. Add it to `erc-pre-send-functions' as the lone new
default.
(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--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.
(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.
* 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.
---
lisp/erc/erc.el | 98 +++++++++++++-----
test/lisp/erc/erc-tests.el | 197 +++++++++++++++++++++++++++++++++++++
2 files changed, 270 insertions(+), 25 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d8ef62cf93..f3685dd2a7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1040,7 +1040,7 @@ erc-send-pre-hook
:type 'hook)
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
-(defcustom erc-pre-send-functions nil
+(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls)
"Special hook run to possibly alter the string that is sent.
The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
@@ -1052,7 +1052,7 @@ erc-pre-send-functions
`sendp': Whether the string should be sent to the irc server."
:group 'erc
:type 'hook
- :version "27.1")
+ :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
@@ -5536,7 +5536,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
@@ -5552,6 +5552,59 @@ 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 (string)
+ "Detect whether STRING contains any blank lines.
+When `erc-send-whitespace-lines' is in effect, return nil if the input
+is multiline or the line is 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 ((lines (split-string string erc--input-line-delim-regexp)))
+ (dolist (line lines)
+ (when (if erc-send-whitespace-lines
+ (and (string= line "") (null (cdr lines)))
+ (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
+ (cl-callf (lambda (s) (string-trim-right s "[\r\n]+"))
+ (erc-input-string state))))
+
+(defun erc-check-prompt-input-for-multiline-blanks (string)
+ "Return non-nil when multiline prompt input has blank lines."
+ (when (erc--blank-in-multiline-input-p string)
+ (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"))
+
+(defcustom 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. If any member
+returns non-nil, processing is abandoned and input is left untouched.
+When the returned value is a string, pass it to `erc-error'."
+ :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
+ :group 'erc
+ :type 'hook)
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
@@ -5565,20 +5618,20 @@ 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)))
+ (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
@@ -5593,8 +5646,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!"))))
@@ -5611,21 +5664,16 @@ erc-command-regexp
(cl-defstruct erc-input
string insertp sendp)
-(defun erc-send-input (input)
+(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))
+ (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.
@@ -5663,9 +5711,9 @@ erc-send-input
(null erc-flood-protect) t))
(or (and erc-flood-protect (erc-split-line line))
(list line))))
- (split-string string "\n"))
+ (split-string string erc--input-line-delim-regexp))
(erc-process-input-line (concat string "\n") t nil))
- 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 c9254e6d42..3746f4862e 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -295,6 +295,203 @@ 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 ()
+ (ert-info ("With `erc-send-whitespace-lines'")
+ (let ((erc-send-whitespace-lines t))
+ (should (erc--blank-in-multiline-input-p ""))
+ (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd
+ (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed
+ (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd
+ (should-not (erc--blank-in-multiline-input-p " "))
+ (should-not (erc--blank-in-multiline-input-p "\t"))
+ (should-not (erc--blank-in-multiline-input-p "a\nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n "))
+ (should-not (erc--blank-in-multiline-input-p "a\n \t"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \f"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \t\nb"))
+ (should-not (erc--blank-in-multiline-input-p "a\n \f\nb"))))
+
+ (should (erc--blank-in-multiline-input-p ""))
+ (should (erc--blank-in-multiline-input-p " "))
+ (should (erc--blank-in-multiline-input-p "\t"))
+ (should (erc--blank-in-multiline-input-p "a\n\nb"))
+ (should (erc--blank-in-multiline-input-p "a\n\nb"))
+ (should (erc--blank-in-multiline-input-p "a\n "))
+ (should (erc--blank-in-multiline-input-p "a\n \t"))
+ (should (erc--blank-in-multiline-input-p "a\n \f"))
+ (should (erc--blank-in-multiline-input-p "a\n \nb"))
+ (should (erc--blank-in-multiline-input-p "a\n \t\nb"))
+
+ (should-not (erc--blank-in-multiline-input-p "a\rb"))
+ (should-not (erc--blank-in-multiline-input-p "a\nb"))
+ (should-not (erc--blank-in-multiline-input-p "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")
+ (insert "/msg #chan hi\r")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("/msg #chan hi\n" 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-SQUASH-ME-Add-hook-for-splitting-multiline-input-in-.patch --]
[-- Type: text/x-patch, Size: 5852 bytes --]
From b58ad0d7c08d0002276f261d508cfca4056cc9ac Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 22 Apr 2022 03:56:25 -0700
Subject: [PATCH 4/4] [SQUASH-ME] Add hook for splitting multiline input in ERC
* lisp/erc/erc.el (erc-pre-send-split-functions): Add new hook
allowing members to revise individual lines before sending.
(erc-discard-trailing-multiline-nulls): Conditionally truncate
list of lines to be sent, skipping trailing blanks.
(erc-input-split): Add new struct containing split input line.
(erc-send-input): Call hook `erc-pre-send-split-functions'.
---
lisp/erc/erc.el | 74 ++++++++++++++++++++++++++++++++++---------------
1 file changed, 51 insertions(+), 23 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f3685dd2a7..e2fe5c6476 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1040,7 +1040,7 @@ erc-send-pre-hook
:type 'hook)
(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
-(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls)
+(defcustom erc-pre-send-functions nil
"Special hook run to possibly alter the string that is sent.
The functions are called with one argument, an `erc-input' struct,
and should alter that struct.
@@ -1052,7 +1052,26 @@ erc-pre-send-functions
`sendp': Whether the string should be sent to the irc server."
:group 'erc
:type 'hook
- :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA
+ :version "27.1")
+
+(defcustom 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."
+ :group 'erc
+ :type 'hook
+ :package-version '(ERC . "5.4.1"))
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
@@ -5572,8 +5591,13 @@ erc-discard-trailing-multiline-nulls
"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
- (cl-callf (lambda (s) (string-trim-right s "[\r\n]+"))
- (erc-input-string state))))
+ (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-multiline-blanks (string)
"Return non-nil when multiline prompt input has blank lines."
@@ -5664,6 +5688,9 @@ erc-command-regexp
(cl-defstruct erc-input
string insertp sendp)
+(cl-defstruct (erc-input-split (:include erc-input))
+ lines cmdp)
+
(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.
@@ -5693,26 +5720,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)
- (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 erc--input-line-delim-regexp))
- (erc-process-input-line (concat string "\n") t nil))
+ 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)
--
2.35.1
^ permalink raw reply related [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
` (2 preceding siblings ...)
2022-04-23 3:17 ` J.P.
@ 2022-04-29 13:05 ` J.P.
2022-05-17 13:10 ` J.P.
[not found] ` <874k1os3te.fsf@neverwas.me>
5 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-04-29 13:05 UTC (permalink / raw)
To: 54536; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 1381 bytes --]
v4.
I've decided it's probably better to abstain from exporting the input
validation hooks or their members without good reason. Likewise for the
hook involving split-lines and command-detection. So they've all been
renamed as internal, for now.
This version also brings with it some out-of-scope feature creep in
response to recent clamoring for a way to prevent all multiline input.
I've therefore added two options and wired them into the pre-send
validation mechanism introduced earlier in this series. The first is
called `erc-inhibit-multiline-input', which must be either a positive
integer or t. As an int, it indicates the maximum number of lines
allowed to be submitted for sending (above which a beep and a scolding
result). The second is called `erc-ask-about-multiline-input'. When
non-nil, instead of getting scolded, the user is asked whether to go
ahead and send anyway (just this once).
A few (arguably surprising) idiosyncrasies surround the interaction
between `erc-send-whitespace-lines' and these newly proposed options,
but nothing too radical or inconsistent (IMO). For example, during the
reckoning of `erc-inhibit-multiline-input', trailing blanks are always
trimmed, but when `erc-send-whitespace-lines' is nil, this becomes
irrelevant because the send is preempted beforehand, which is in line
with the behavior described in the initial bug report.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v3-v4.diff --]
[-- Type: text/x-patch, Size: 15553 bytes --]
From bb190883389de0bdcdfa39bfdbb5d8953bf115fd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 27 Apr 2022 04:33:06 -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 | 259 +++++++++++++++++++++++++++++++++++--
2 files changed, 402 insertions(+), 52 deletions(-)
Interdiff:
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 472c103ee4..8e96dd30c4 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.
@@ -1054,10 +1068,16 @@ erc-pre-send-functions
:type 'hook
:version "27.1")
-(defcustom erc-pre-send-split-functions '(erc-discard-trailing-multiline-nulls)
+;; This is being auditioned for possible exporting (as a custom
+;; 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.
+
+(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 functions are called with one argument, an `erc--input-split'
+struct, which they can optionally modify.
The struct has five slots:
@@ -1068,10 +1088,7 @@ erc-pre-send-split-functions
`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."
- :group 'erc
- :type 'hook
- :package-version '(ERC . "5.4.1"))
+all but the first line will be discarded.")
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
@@ -5573,61 +5590,77 @@ erc-accidental-paste-threshold-seconds
(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r)))
-(defun erc--blank-in-multiline-input-p (string)
- "Detect whether STRING contains any blank lines.
-When `erc-send-whitespace-lines' is in effect, return nil if the input
-is multiline or the line is non-empty. When `erc-send-whitespace-lines'
-is nil, return non-nil when any line is empty or consists of one or more
+(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 ((lines (split-string string erc--input-line-delim-regexp)))
+ (let ((multilinep (cdr lines)))
(dolist (line lines)
(when (if erc-send-whitespace-lines
- (and (string= line "") (null (cdr lines)))
+ (and (string-empty-p line) (not multilinep))
(string-match (rx bot (* (in " \t\f")) eot) line))
(throw 'return t))))))
-(defun erc-discard-trailing-multiline-nulls (state)
+(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)
+ (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-multiline-blanks (string)
- "Return non-nil when multiline prompt input has blank lines."
- (when (erc--blank-in-multiline-input-p string)
+ (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
+ ;; 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)
(if erc-warn-about-blank-lines
"Blank line - ignoring..."
'invalid)))
-(defun erc-check-prompt-input-for-point-in-bounds (_)
+(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)
+(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"))
-(defcustom 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)
+(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)
"Validators for user input typed at prompt.
-Called with latest input string submitted by user. If any member
-returns non-nil, processing is abandoned and input is left untouched.
-When the returned value is a string, pass it to `erc-error'."
- :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA
- :group 'erc
- :type 'hook)
+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."
@@ -5644,7 +5677,8 @@ erc-send-current-line
(widen)
(if-let* ((str (erc-user-input))
(msg (run-hook-with-args-until-success
- 'erc-check-prompt-input-functions str)))
+ '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)
@@ -5688,7 +5722,7 @@ erc-command-regexp
(cl-defstruct erc-input
string insertp sendp)
-(cl-defstruct (erc-input-split (:include erc-input))
+(cl-defstruct (erc--input-split (:include erc-input))
lines cmdp)
(defun erc-send-input (input &optional skip-ws-chk)
@@ -5697,7 +5731,8 @@ erc-send-input
Return non-nil only if we actually send anything."
;; Handle different kinds of inputs
(if (and (not skip-ws-chk)
- (erc-check-prompt-input-for-multiline-blanks input))
+ (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))
@@ -5720,7 +5755,7 @@ 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
+ (setq state (make-erc--input-split
:string (erc-input-string state)
:insertp (erc-input-insertp state)
:sendp (erc-input-sendp state)
@@ -5728,11 +5763,11 @@ erc-send-input
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)
+ (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)))
+ (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))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 3746f4862e..fa39f4fcc6 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -327,36 +327,41 @@ erc--input-line-delim-regexp
(should (equal '("" "" "") (split-string "\n\r" p)))))
(ert-deftest erc--blank-in-multiline-input-p ()
- (ert-info ("With `erc-send-whitespace-lines'")
- (let ((erc-send-whitespace-lines t))
- (should (erc--blank-in-multiline-input-p ""))
- (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd
- (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed
- (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd
- (should-not (erc--blank-in-multiline-input-p " "))
- (should-not (erc--blank-in-multiline-input-p "\t"))
- (should-not (erc--blank-in-multiline-input-p "a\nb"))
- (should-not (erc--blank-in-multiline-input-p "a\n "))
- (should-not (erc--blank-in-multiline-input-p "a\n \t"))
- (should-not (erc--blank-in-multiline-input-p "a\n \f"))
- (should-not (erc--blank-in-multiline-input-p "a\n \nb"))
- (should-not (erc--blank-in-multiline-input-p "a\n \t\nb"))
- (should-not (erc--blank-in-multiline-input-p "a\n \f\nb"))))
-
- (should (erc--blank-in-multiline-input-p ""))
- (should (erc--blank-in-multiline-input-p " "))
- (should (erc--blank-in-multiline-input-p "\t"))
- (should (erc--blank-in-multiline-input-p "a\n\nb"))
- (should (erc--blank-in-multiline-input-p "a\n\nb"))
- (should (erc--blank-in-multiline-input-p "a\n "))
- (should (erc--blank-in-multiline-input-p "a\n \t"))
- (should (erc--blank-in-multiline-input-p "a\n \f"))
- (should (erc--blank-in-multiline-input-p "a\n \nb"))
- (should (erc--blank-in-multiline-input-p "a\n \t\nb"))
-
- (should-not (erc--blank-in-multiline-input-p "a\rb"))
- (should-not (erc--blank-in-multiline-input-p "a\nb"))
- (should-not (erc--blank-in-multiline-input-p "a\r\nb")))
+ (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")
@@ -376,7 +381,7 @@ erc-tests--with-process-input-spy
(funcall test (lambda () (pop calls)))))
(when noninteractive (kill-buffer))))
-(ert-deftest erc-check-prompt-input-functions ()
+(ert-deftest erc--check-prompt-input-functions ()
(erc-tests--with-process-input-spy
(lambda (next)
@@ -493,6 +498,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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Fix-regression-in-erc-send-input-line.patch --]
[-- Type: text/x-patch, Size: 2448 bytes --]
From bdfb502f7f0e6b1fbc0ea8cfb0336757bf813ab5 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 06381c5ebe..29a465a759 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Add-some-ERC-test-helpers.patch --]
[-- Type: text/x-patch, Size: 2161 bytes --]
From 97f18350d52791c57e325e828997e4440119b7ff Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 | 22 ++++++++++++++++------
1 file changed, 16 insertions(+), 6 deletions(-)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 10e3c16dfc..c9254e6d42 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -114,6 +114,20 @@ erc-with-all-buffers-of-server
(should (get-buffer "#spam"))
(kill-buffer "#spam")))
+(defun erc-tests--send-prep ()
+ (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 +211,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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch --]
[-- Type: text/x-patch, Size: 20689 bytes --]
From 0898d4eb0b37e3faae8cd8c37c756a2cfde1873d Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 | 202 +++++++++++++++++++++++++++++++++++++
2 files changed, 322 insertions(+), 41 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 29a465a759..d4ca8665a4 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1054,6 +1054,28 @@ erc-pre-send-functions
:type 'hook
:version "27.1")
+;; This is being auditioned for possible exporting (as a custom
+;; 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.
+
+(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
@@ -5536,7 +5558,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
@@ -5552,6 +5574,62 @@ 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--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-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)
@@ -5565,20 +5643,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
@@ -5593,8 +5672,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!"))))
@@ -5611,21 +5690,20 @@ 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-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.
@@ -5645,27 +5723,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 c9254e6d42..c076503933 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -295,6 +295,208 @@ 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")
+ (insert "/msg #chan hi\r")
+ (erc-send-current-line)
+ (ert-info ("Input cleared")
+ (erc-bol)
+ (should (eq (point) (point-max))))
+ (should (equal (funcall next) '("/msg #chan hi\n" 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.35.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-Optionally-prevent-sending-multiline-input-in-ERC.patch --]
[-- Type: text/x-patch, Size: 5140 bytes --]
From cb445bf2b95737df7fdcb47be3e9937c983cd705 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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 d4ca8665a4..8e96dd30c4 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.
@@ -5602,6 +5616,23 @@ erc--discard-trailing-multiline-nulls
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
+ ;; 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)
@@ -5623,7 +5654,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 c076503933..fa39f4fcc6 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -498,6 +498,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.35.1
^ permalink raw reply related [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
` (3 preceding siblings ...)
2022-04-29 13:05 ` J.P.
@ 2022-05-17 13:10 ` J.P.
[not found] ` <874k1os3te.fsf@neverwas.me>
5 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-05-17 13:10 UTC (permalink / raw)
To: 54536; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 48 bytes --]
v5. Fix compiler error and other minor issues.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v4-v5.diff --]
[-- Type: text/x-patch, Size: 4709 bytes --]
From aaf22460711d8d669da296dfbf024053270e1cef Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Fix-regression-in-erc-send-input-line.patch --]
[-- Type: text/x-patch, Size: 2448 bytes --]
From 64ab9c43c08a7f2e5fb0b02c562f460dcf849c22 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Add-some-ERC-test-helpers.patch --]
[-- Type: text/x-patch, Size: 2270 bytes --]
From 4f71ec838470b8435d490e582177b7a9c2c8d520 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch --]
[-- Type: text/x-patch, Size: 20983 bytes --]
From 7bf47171db925286f293b995826b5a649702bff8 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-Optionally-prevent-sending-multiline-input-in-ERC.patch --]
[-- Type: text/x-patch, Size: 5128 bytes --]
From aaf22460711d8d669da296dfbf024053270e1cef Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
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
^ permalink raw reply related [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <874k1os3te.fsf@neverwas.me>
@ 2022-05-17 22:48 ` Will Mengarini via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <YoQmVCugPRXY58eO@eskimo.com>
1 sibling, 0 replies; 17+ messages in thread
From: Will Mengarini via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-05-17 22:48 UTC (permalink / raw)
To: J.P.; +Cc: emacs-erc, 54536
"It you need this" should be "If you need this".
^ permalink raw reply [flat|nested] 17+ messages in thread
* bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
[not found] ` <YoQmVCugPRXY58eO@eskimo.com>
@ 2022-05-18 1:34 ` J.P.
0 siblings, 0 replies; 17+ messages in thread
From: J.P. @ 2022-05-18 1:34 UTC (permalink / raw)
To: Will Mengarini; +Cc: emacs-erc, 54536
Will Mengarini <seldon@eskimo.com> writes:
> "It you need this" should be "If you need this".
Whoops! Thanks.
--
"It you build it, they will come."
^ permalink raw reply [flat|nested] 17+ messages in thread
end of thread, other threads:[~2022-05-18 1:34 UTC | newest]
Thread overview: 17+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
2022-03-23 13:50 ` bug#54536: " Lars Ingebrigtsen
[not found] ` <87czic93sa.fsf@gnus.org>
2022-03-24 19:50 ` J.P.
2022-03-24 20:16 ` Michael Albinus
[not found] ` <8735j7jecz.fsf@gmx.de>
2022-03-24 23:38 ` J.P.
[not found] ` <87tubm53ar.fsf@neverwas.me>
2022-03-25 15:29 ` Lars Ingebrigtsen
[not found] ` <874k3mf3th.fsf@gnus.org>
2022-03-25 19:23 ` J.P.
2022-03-26 16:44 ` Lars Ingebrigtsen
[not found] ` <87ee2rb04e.fsf@neverwas.me>
2022-03-25 15:31 ` Lars Ingebrigtsen
[not found] ` <87zgledp6a.fsf@gnus.org>
2022-03-25 19:20 ` J.P.
2022-04-23 3:17 ` J.P.
2022-04-29 13:05 ` J.P.
2022-05-17 13:10 ` J.P.
[not found] ` <874k1os3te.fsf@neverwas.me>
2022-05-17 22:48 ` Will Mengarini via Bug reports for GNU Emacs, the Swiss army knife of text editors
[not found] ` <YoQmVCugPRXY58eO@eskimo.com>
2022-05-18 1:34 ` J.P.
[not found] <ADC23CE3-E6A4-4FF8-B033-174F60B2D59E@getmailspring.com>
2022-04-03 19:44 ` J.P.
[not found] <87y20m7xzs.fsf@neverwas.me>
2022-04-03 20:15 ` Matheus Fillipe
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).