* bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt
@ 2023-09-18 14:25 J.P.
2023-09-22 14:20 ` J.P.
` (2 more replies)
0 siblings, 3 replies; 4+ messages in thread
From: J.P. @ 2023-09-18 14:25 UTC (permalink / raw)
To: 66073; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 10001 bytes --]
Tags: patch
ERC has made some strides in recent versions when it comes to dealing
with unwelcome or irregular whitespace in user input [1]. But rough
edges definitely remain. One important option influencing this area is
`erc-warn-about-blank-lines'. It concerns feedback in the echo area from
blank lines submitted at the prompt [2]. Its purview overlaps somewhat
with that of `erc-send-whitespace-lines', though the latter option also
affects implicit trimming and padding. This proposal attempts to clarify
and formalize ERC's treatment of both.
One thing this bug does not attempt is to define and attain optimal UX
in this area because finding a sweet spot between user friendliness and
compatibility is likely infeasible given the many options whose defaults
can't be changed without breaking ancient bots and user code [3].
Instead, this bug attempts to file down some burry bits affecting how
submitted input is massaged and how accompanying feedback is
communicated, both currently inconsistent and not super predictable. (It
also attempts to fix a closely related bug [4].)
To better understand what's being proposed here, compare the last row of
the following table with the "desired output" below (see [5] for
baseline cases):
| vers/opts | "" | " " | "\n" | "\n " | " \n" | "\n\n" | "a\n" | "a\n " | "a\n \nb" |
|-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------|
| 28 +w,-s* | err | e/c | e/c | e/c | e/c | e/c | a,\s | a,\s | a,\s,b |
| 28 -w,-s | nop | clr | clr | clr | clr | clr | a,\s | a,\s | a,\s,b |
| 28 +w,+s | err | \s | \s,\s | \s,\s | \s,\s | \s(x3) | a,\s | a,\s | a,\s,b |
| 28 -w,+s | nop | \s | \s,\s | \s,\s | \s,\s | \s(x3) | a,\s | a,\s | a,\s,b |
|-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------|
| 29 +w,-s* | err | err | err | err | err | err | err | err | err |
| 29 -w,-s | nop | nop | nop | nop | nop | nop | nop | nop | nop |
| 29 +w,+s | err | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b |
| 29 -w,+s | nop | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b |
|-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------|
| 30 +w,-s* | err | err | err | err | err | err | err | err | err |
| 30 -w,-s | fbe | fbe | fbe | fbe | fbe | fbe | fbe | fbe | fbe |
| 30 +w,+s | nop | \s | clr | \s,\s | \s | clr | a | a,\s | a,\s,b |
| 30 -w,+s | nop | \s | clr | \s,\s | \s | clr | a | a,\s | a,\s,b |
Desired output:
| 30 +w,-s* | err | *er | *er | *er | *er | *er | *er | *er | *er |
| 30 -w,-s | nop | nop | nop | nop | nop | nop | nop | nop | nop |
| 30 +w,+s | err | *\s | *\s | *\s,\s | *\s | *\s | *a | *a,\s | *a,\s,b |
| 30 -w,+s | nop | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b |
- w: `erc-warn-about-blank-lines'
- s: `erc-send-whitespace-lines'
- +w,-s*: default configuration as seen with Emacs -Q
- err: signal `user-error' but leave input area untouched
- nop: No-op; leave input untouched
- fbe: fallback error (likely a bug [4]), otherwise like err
- clr: clear entire prompt area and don't send anything
- e/c: signal a `user-error' and clear the prompt area
- *er: detailed error with null/white tallies and other context
- <char...>: outgoing message (\s is a space), implies clearing
- *<char...>: same, but with detailed feedback in echo area
For examples of the improved feedback wording, see the attached test
called `erc--check-prompt-input-for-multiline-blanks/explanations'. The
basic idea is to report on the number of lines padded and/or stripped
when `erc-send-whitespace-lines' is enabled and the number of blanks
and/or trailing lines detected when that option is nil (as long as
`erc-warn-about-blank-lines' is still enabled).
One idea discussed recently on Libera was to enable implicit trimming of
trailing blanks by default, at least for the common "a\n" case. While
certainly possible, doing so would make for some complicated explaining
in the doc strings of both options. And adding yet another knob to
achieve this effect would only further complicate an already unruly mix.
Hopefully, the proposed solution of richer feedback will prove
sufficient enough to fill this void.
Lastly, this bug also addresses some design mishaps in this same general
area. For example, the functions `erc--blank-in-multiline-input-p' and
`erc--discard-trailing-multiline-nulls' really shouldn't concern
themselves with user options. Rather, they should just report on or
process data as requested by their options-aware caller (the function
`erc--check-prompt-input-for-excess-lines'), which should be the sole
arbiter of what gets sent and warned about (and how).
As always, if anyone has any better ideas, please say so. I'd like to
solve this before the next release, which is hopefully right around the
corner. Thanks.
[1] Related bugs:
bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
bug#62947: 30.0.50; ERC 5.6: Improve partitioning of outgoing messages
[2] Here, "blank" refers to empty lines as well as those consisting
entirely of whitespace. However, ERC at times also uses "whitespace"
to refer to empty lines.
[3] Plenty of user code relies on simulating user interaction, for
example, by inserting hunks of text at the prompt and calling
`erc-send-current-line' instead of using lower level library
functions. Such code would surely suffer were it to be interrupted
by a dialog asking for confirmation before sending. For an example
of saner options values that could one day become defaults (e.g.,
in ERC 6.0) see "(erc) Sample Configuration" in the manual.
[4] A second, comparatively minor issue also addressed by this bug is
more or less a clear-cut regression, shown as "30 -w,-s" in the
table (note all the fbe's). Basically, in all recent releases,
disabling `erc-warn-about-blank-lines' resulted in a `ding'
(accompanied by a clearing of input in 27 and 28). Unfortunately,
the version on HEAD just prints a rather useless error message
instead: "Input error: invalid".
[5] Baseline behavior identical across all versions, regardless of
options:
| | a | "a\nb" |
|----------------------+---+--------|
| all versions/options | a | a,b |
In GNU Emacs 30.0.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version
3.24.38, cairo version 1.17.6) of 2023-09-17 built on localhost
Repository revision: a0ed463babaa6301dfe2fecc27e2a6c92eb0d90c
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 37 (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 XINPUT2 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
minibuffer-regexp-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 puny dired
dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config gnus-util
text-property-search time-date mm-decode mm-bodies mm-encode mail-parse
rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045
ietf-drums mm-util mail-prsvr mail-utils erc derived auth-source eieio
eieio-core password-cache json map format-spec erc-backend erc-networks
easy-mmode byte-opt bytecomp byte-compile erc-common inline erc-compat
cl-seq cl-macs gv pcase rx subr-x cl-loaddefs cl-lib erc-loaddefs rmc
iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook
vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win
term/common-win x-dnd touch-screen 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 seq simple cl-generic indonesian philippine
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 oclosure
cl-preloaded button loaddefs theme-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 gtk x-toolkit xinput2 x multi-tty move-toolbar
make-network-process emacs)
Memory information:
((conses 16 120902 9231) (symbols 48 10034 0) (strings 32 24640 2237)
(string-bytes 1 824086) (vectors 16 14496)
(vector-slots 8 204135 15157) (floats 8 24 45) (intervals 56 242 0)
(buffers 984 10))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-5.6-Improve-erc-warn-about-blank-lines-behavior.patch --]
[-- Type: text/x-patch, Size: 21779 bytes --]
From e65ce41a8418591a026525dea53d1b950c74ec12 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 15 Sep 2023 06:08:55 -0700
Subject: [PATCH] [5.6] Improve erc-warn-about-blank-lines behavior
* lisp/erc/erc-common.el (erc--input-split): Add `abortp' slot. Its
purpose is to allow for making a premature exit while validating
prompt input without having to trap or signaling `user-error' with an
empty string.
* lisp/erc/erc.el (erc-warn-about-blank-lines): Clarify meaning of
"blank lines" and mention interaction with
`erc-send-whitespace-lines'.
(erc--input-review-functions): Move
`erc--discard-trailing-multiline-nulls' after
`erc--run-input-validation-checks'.
(erc--blank-in-multiline-input-p): Remove function.
(erc--check-prompt-input-for-something): New trivial validation
function to check if the input is empty.
(erc--count-blank-lines): New function that tallies up the number of
blank lines and whitespace lines in the current input.
(erc--check-prompt-input-for-multiline-blanks): Rework to provide more
informative messages and more sensible behavior for common cases with
respect to relevant option values.
(erc--check-prompt-input-functions): Add new validation function
`erc--check-prompt-for-something'.
(erc--run-input-validation-checks): Set `abortp' slot of
`erc--input-split' when returned object is a symbol, rather than
printing a fallback error. Also accept a list of `message' arguments
as another new return type.
(erc-send-current-line): When the `abortp' slot of the current
`erc--input-split' object is non-nil, forgo normal input processing.
This fixes a regression in 5.6-git, which emits an error message when
it should instead just exit the command.
(erc--discard-trailing-multiline-nulls): Always run, regardless of
`erc-send-whitespace-lines', and leave a blank line behind when
stripping a message consisting of only blank lines.
(erc--run-send-hooks): Always run hooks and adjacent logic rather than
only when hooks are populated.
* test/lisp/erc/erc-tests.el
(erc--blank-in-multiline-input-p): Remove test.
(erc--check-prompt-input-functions): Update expected message.
(erc--discard-trailing-multiline-nulls, erc--count-blank-lines): New
tests.
(erc-tests--check-prompt-input--expect,
erc-tests--check-prompt-input-messages): New helper variables.
(erc--check-prompt-input-for-multiline-blanks,
erc--check-prompt-input-for-multiline-blanks/explanations): New tests.
---
lisp/erc/erc-common.el | 1 +
lisp/erc/erc.el | 119 +++++++++++++++++++-------
test/lisp/erc/erc-tests.el | 171 ++++++++++++++++++++++++++++---------
3 files changed, 220 insertions(+), 71 deletions(-)
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 67c2cf8535b..8d896e663b5 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -60,6 +60,7 @@ erc-input
((obsolete erc-send-this))
erc-send-this))))
(lines nil :type (list-of string))
+ (abortp nil :type (list-of symbol))
(cmdp nil :type boolean))
(cl-defstruct (erc-server-user (:type vector) :named)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..7165f38189e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -249,7 +249,14 @@ erc-prompt-for-password
:type 'boolean)
(defcustom erc-warn-about-blank-lines t
- "Warn the user if they attempt to send a blank line."
+ "Warn the user if they attempt to send a blank line.
+When non-nil, ERC signals a `user-error' upon encountering prompt
+input containing empty or whitespace-only lines. When nil, ERC
+still inhibits sending but does so silently. With the companion
+option `erc-send-whitespace-lines' enabled, ERC sends pending
+input and prints a message in the echo area indicating the amount
+of padding and/or stripping applied, if any. Setting this option
+to nil suppresses such reporting."
:group 'erc
:type 'boolean)
@@ -1092,9 +1099,9 @@ erc-pre-send-functions
(define-obsolete-variable-alias 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
-(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls
- erc--split-lines
- erc--run-input-validation-checks)
+(defvar erc--input-review-functions '(erc--split-lines
+ erc--run-input-validation-checks
+ erc--discard-trailing-multiline-nulls)
"Special hook for reviewing and modifying prompt input.
ERC runs this before clearing the prompt and before running any
send-related hooks, such as `erc-pre-send-functions'. Thus, it's
@@ -6421,20 +6428,6 @@ erc--input-line-delim-regexp
(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
"Regular expression used for matching commands in ERC.")
-(defun erc--blank-in-multiline-input-p (lines)
- "Detect whether LINES contains a blank line.
-When `erc-send-whitespace-lines' is in effect, return nil if
-LINES is multiline or the first 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 ((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-excess-lines (_ lines)
"Return non-nil when trying to send too many LINES."
(when erc-inhibit-multiline-input
@@ -6454,13 +6447,72 @@ erc--check-prompt-input-for-excess-lines
(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)
+(defun erc--check-prompt-input-for-something (string _)
+ (when (string-empty-p string)
(if erc-warn-about-blank-lines
"Blank line - ignoring..."
'invalid)))
+(defun erc--count-blank-lines (lines)
+ "Report on the number of whitespace-only and empty LINES.
+Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know
+that BLANKS includes non-empty whitespace-only lines and that no
+padding or stripping has yet occurred."
+ (let ((real 0) (total 0) (pad 0) (strip 0))
+ (dolist (line lines)
+ (if (string-match (rx bot (* (in " \t\f")) eot) line)
+ (progn
+ (cl-incf total)
+ (if (zerop (match-end 0))
+ (cl-incf strip)
+ (cl-incf pad strip)
+ (setq strip 0)))
+ (cl-incf real)
+ (unless (zerop strip)
+ (cl-incf pad strip)
+ (setq strip 0))))
+ (when (and (zerop real) (not (zerop total)) (= total (+ pad strip)))
+ (cl-incf strip (1- pad))
+ (setq pad 1))
+ (list total pad strip)))
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+ "Return non-nil when multiline prompt input has blank LINES.
+Consider newlines to be intervening delimiters, meaning the
+zero-width logical line between a trailing newline and `eob'
+constitutes a separate message."
+ (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines)))
+ (cond ((zerop total) nil)
+ ((and erc-warn-about-blank-lines erc-send-whitespace-lines)
+ (let (msg args)
+ (unless (zerop strip)
+ (push "stripping (%d)" msg)
+ (push strip args))
+ (unless (zerop pad)
+ (when msg
+ (push "and" msg))
+ (push "padding (%d)" msg)
+ (push pad args))
+ (when msg
+ (push "blank" msg)
+ (push (if (> (apply #'+ args) 1) "lines" "line") msg))
+ (when msg
+ (setf msg (nreverse msg)
+ (car msg) (capitalize (car msg))))
+ (and msg `(message ,(string-join msg " ") ,@(nreverse args)))))
+ (erc-warn-about-blank-lines
+ (concat (if (= total 1)
+ (if (zerop strip) "Blank" "Trailing")
+ (if (= total strip)
+ (format "%d trailing" strip)
+ (format "%d blank" total)))
+ (and (> total 1) (/= total strip) (not (zerop strip))
+ (format " (%d trailing)" strip))
+ (if (= total 1) " line" " lines")
+ " detected (see `erc-send-whitespace-lines')"))
+ (erc-send-whitespace-lines nil)
+ (t '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))
@@ -6481,6 +6533,7 @@ erc--check-prompt-input-for-multiline-command
(defvar erc--check-prompt-input-functions
'(erc--check-prompt-input-for-point-in-bounds
+ erc--check-prompt-input-for-something
erc--check-prompt-input-for-multiline-blanks
erc--check-prompt-input-for-running-process
erc--check-prompt-input-for-excess-lines
@@ -6497,9 +6550,11 @@ erc--run-input-validation-checks
'erc--check-prompt-input-functions
(erc--input-split-string state)
(erc--input-split-lines state))))
- (unless (stringp msg)
- (setq msg (format "Input error: %S" msg)))
- (user-error msg)))
+ (cond ((eq (car-safe msg) 'message)
+ (apply 'message (cdr msg)))
+ ((stringp msg)
+ (user-error msg))
+ (t (push msg (erc--input-split-abortp state))))))
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
@@ -6523,8 +6578,9 @@ erc-send-current-line
str erc--input-line-delim-regexp)
:cmdp (string-match erc-command-regexp str))))
(run-hook-with-args 'erc--input-review-functions state)
- (let ((inhibit-read-only t)
- (old-buf (current-buffer)))
+ (when-let (((not (erc--input-split-abortp state)))
+ (inhibit-read-only t)
+ (old-buf (current-buffer)))
(progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
@@ -6553,12 +6609,11 @@ erc-user-input
(erc-end-of-input-line)))
(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))
+ "Remove trailing empty lines from STATE, an `erc--input-split' object.
+When all lines are empty, remove all but the first."
+ (when (erc--input-split-lines state)
(let ((reversed (nreverse (erc--input-split-lines state))))
- (while (and reversed (string-empty-p (car reversed)))
+ (while (and (cdr reversed) (string-empty-p (car reversed)))
(setq reversed (cdr reversed)))
(setf (erc--input-split-lines state) (nreverse reversed)))))
@@ -6578,7 +6633,7 @@ erc--run-send-hooks
limits and pad empty ones, knowing full well that additional
processing may still corrupt messages before they reach the send
queue. Expect LINES-OBJ to be an `erc--input-split' object."
- (when (or erc-send-pre-hook erc-pre-send-functions)
+ (progn ; FIXME remove `progn' after code review.
(with-suppressed-warnings ((lexical str) (obsolete erc-send-this))
(defvar str) ; see note in string `erc-send-input'.
(let* ((str (string-join (erc--input-split-lines lines-obj) "\n"))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..bb7e3259608 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1056,43 +1056,6 @@ erc--input-line-delim-regexp
(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--input-review-functions
@@ -1138,7 +1101,7 @@ erc--check-prompt-input-functions
(delete-region (point) (point-max))
(insert "one\n")
(let ((e (should-error (erc-send-current-line))))
- (should (equal "Blank line - ignoring..." (cadr e))))
+ (should (string-prefix-p "Trailing line detected" (cadr e))))
(goto-char (point-max))
(ert-info ("Input remains untouched")
(should (save-excursion (goto-char erc-input-marker)
@@ -1180,6 +1143,136 @@ erc-send-current-line
(should (consp erc-last-input-time)))))
+(ert-deftest erc--discard-trailing-multiline-nulls ()
+ (pcase-dolist (`(,input ,want) '((("") (""))
+ (("" "") (""))
+ (("a") ("a"))
+ (("a" "") ("a"))
+ (("" "a") ("" "a"))
+ (("" "a" "") ("" "a"))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (let ((s (make-erc--input-split :lines input)))
+ (erc--discard-trailing-multiline-nulls s)
+ (should (equal (erc--input-split-lines s) want))))))
+
+(ert-deftest erc--count-blank-lines ()
+ (pcase-dolist (`(,input ,want) '((() (0 0 0))
+ (("") (1 1 0))
+ (("" "") (2 1 1))
+ (("" "" "") (3 1 2))
+ ((" " "") (2 0 1))
+ ((" " "" "") (3 0 2))
+ (("" " " "") (3 1 1))
+ (("" "" " ") (3 2 0))
+ (("a") (0 0 0))
+ (("a" "") (1 0 1))
+ (("a" " " "") (2 0 1))
+ (("a" "" "") (2 0 2))
+ (("a" "b") (0 0 0))
+ (("a" "" "b") (1 1 0))
+ (("a" " " "b") (1 0 0))
+ (("" "a") (1 1 0))
+ ((" " "a") (1 0 0))
+ (("" "a" "") (2 1 1))
+ (("" " " "a" "" " ") (4 2 0))
+ (("" " " "a" "" " " "") (5 2 1))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (should (equal (erc--count-blank-lines input) want)))))
+
+;; Opt `wb': `erc-warn-about-blank-lines'
+;; Opt `sw': `erc-send-whitespace-lines'
+;; `s': " \n",`a': "a\n",`b': "b\n"
+(defvar erc-tests--check-prompt-input--expect
+ ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb"
+ '(((+wb -sw) err err err err err err err err err)
+ ((-wb -sw) nop nop nop nop nop nop nop nop nop)
+ ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b))
+ ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b))))
+
+;; Help messages echoed (not IRC message) was emitted
+(defvar erc-tests--check-prompt-input-messages
+ '("Stripping" "Padding"))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (should-not erc-send-whitespace-lines)
+ (should erc-warn-about-blank-lines)
+
+ (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect)
+ (let ((print-escape-newlines t)
+ (erc-warn-about-blank-lines (eq wb '+wb))
+ (erc-send-whitespace-lines (eq sw '+sw))
+ (samples '("" " " "\n" "\n " " \n" "\n\n"
+ "a\n" "a\n " "a\n \nb")))
+ (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos
+ samples `(,@samples "a" "a\nb"))
+ (dolist (input samples)
+ (insert input)
+ (ert-info ((format "Opts: %S, Input: %S, want: %S"
+ (list wb sw) input (car ex)))
+ (ert-with-message-capture messages
+ (pcase-exhaustive (pop ex)
+ ('err (let ((e (should-error (erc-send-current-line))))
+ (should (string-match (rx (| "trailing" "blank"))
+ (cadr e))))
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('nop (erc-send-current-line)
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('clr (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (should-not (funcall next)))
+ ((and (pred consp) v)
+ (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (setq v (reverse v)) ; don't use `nreverse' here
+ (while v
+ (pcase (pop v)
+ ((and (pred integerp) n)
+ (should (string-search
+ (nth n erc-tests--check-prompt-input-messages)
+ messages)))
+ ('s (should (equal " \n" (car (funcall next)))))
+ ('a (should (equal "a\n" (car (funcall next)))))
+ ('b (should (equal "b\n" (car (funcall next)))))))
+ (should-not (funcall next))))))
+ (delete-region erc-input-marker (point-max))))))))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations ()
+ (should erc-warn-about-blank-lines)
+ (should-not erc-send-whitespace-lines)
+
+ (let ((erc-send-whitespace-lines t))
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Padding (1) blank line")
+ (("" " ") "Padding (1) blank line")
+ ((" " "") "Stripping (1) blank line")
+ (("a" "") "Stripping (1) blank line")
+ (("" "") "Stripping (1) and padding (1) blank lines")
+ (("" "" "") "Stripping (2) and padding (1) blank lines")
+ (("" "a" "" "b" "" "c" "" "")
+ "Stripping (2) and padding (3) blank lines")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
+ (should (equal (apply #'format (cdr rv)) msg))))))
+
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Blank line detected")
+ (("" " ") "2 blank lines detected")
+ ((" " "") "2 blank (1 trailing) lines detected")
+ (("a" "") "Trailing line detected")
+ (("" "") "2 blank (1 trailing) lines detected")
+ (("a" "" "") "2 trailing lines detected")
+ (("" "a" "" "b" "" "c" "" "")
+ "5 blank (2 trailing) lines detected")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
+ (should (equal (concat msg " (see `erc-send-whitespace-lines')")
+ rv ))))))
+
(ert-deftest erc-send-whitespace-lines ()
(erc-tests--with-process-input-spy
(lambda (next)
@@ -1196,7 +1289,7 @@ erc-send-whitespace-lines
(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) '(" \n" nil t)))
(should (equal (funcall next) '("one\n" nil t))))
(ert-info ("Multiline hunk with trailing newline filtered")
--
2.41.0
^ permalink raw reply related [flat|nested] 4+ messages in thread
* bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt
2023-09-18 14:25 bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt J.P.
@ 2023-09-22 14:20 ` J.P.
[not found] ` <871qeq47ct.fsf@neverwas.me>
2023-12-07 7:24 ` J.P.
2 siblings, 0 replies; 4+ messages in thread
From: J.P. @ 2023-09-22 14:20 UTC (permalink / raw)
To: 66073; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 115 bytes --]
v2. Fix faulty interaction with `erc-inhibit-multiline-input'. Move
slash-command detection to input-review hook.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v1-v2.diff --]
[-- Type: text/x-patch, Size: 17726 bytes --]
From eeedb524c2686245da10aa827a6a9bfcbc54d046 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 22 Sep 2023 07:15:18 -0700
Subject: [PATCH 0/4] *** NOT A PATCH ***
*** BLURB HERE ***
F. Jason Park (4):
; Increase ERC test server queue size
Exempt text-scale-mode from erc-scrolltobottom-all
[5.6] Improve erc-warn-about-blank-lines behavior
Detect slash commands in erc--input-review-functions
etc/ERC-NEWS | 8 +-
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-goodies.el | 8 +-
lisp/erc/erc.el | 166 ++++++++++-----
test/lisp/erc/erc-scenarios-scrolltobottom.el | 4 +-
test/lisp/erc/erc-tests.el | 189 +++++++++++++-----
test/lisp/erc/resources/erc-d/erc-d.el | 50 ++---
.../erc/resources/erc-scenarios-common.el | 3 +-
8 files changed, 301 insertions(+), 128 deletions(-)
Interdiff:
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..fadd97b65df 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -221,6 +221,12 @@ atop any message. The new companion option 'erc-echo-timestamp-zone'
determines the default timezone when not specified with a prefix
argument.
+** Option 'erc-warn-about-blank-lines' is more informative.
+Enabled by default, this option now produces more useful feedback
+whenever ERC rejects prompt input containing whitespace-only lines.
+When paired with option 'erc-send-whitespace-lines', ERC echoes a
+tally of blank lines padded and trailing blanks culled.
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, fool visibility has become togglable with the new
@@ -281,7 +287,7 @@ For starters, the 'cursor-sensor-functions' property no longer
contains unique closures and thus no longer proves effective for
traversing messages. To compensate, a new property, 'erc-timestamp',
now spans message bodies but not the newlines delimiting them. Also
-affecting the `stamp' module is the deprecation of the function
+affecting the 'stamp' module is the deprecation of the function
'erc-insert-aligned' and its removal from client code. Additionally,
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 6eb015fdd64..431264ec8b4 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -128,6 +128,11 @@ erc--scrolltobottom-post-force-commands
That is, ERC recalculates the window's start instead of blindly
restoring it.")
+;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed'
+;; is enabled (scaling up still moves the prompt).
+(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust)
+ "Commands to skip instead of force-scroll on `post-command-hook'.")
+
(defvar erc--scrolltobottom-relaxed-skip-commands
'(recenter-top-bottom scroll-down-command)
"Commands exempt from triggering a stash and restore of `window-start'.
@@ -158,7 +163,8 @@ erc--scrolltobottom-on-post-command
((= (nth 2 found)
(count-screen-lines (window-start) (point-max)))))
(set-window-start (selected-window) (nth 1 found))
- (erc--scrolltobottom-confirm))
+ (unless (memq this-command erc--scrolltobottom-post-ignore-commands)
+ (erc--scrolltobottom-confirm)))
(setq erc--scrolltobottom-window-info nil)))
(defun erc--scrolltobottom-on-pre-command-relaxed ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 7165f38189e..b9ce6b8e53a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -268,8 +268,8 @@ erc-send-whitespace-lines
(defcustom erc-inhibit-multiline-input nil
"When non-nil, conditionally disallow input consisting of multiple lines.
Issue an error when the number of input lines submitted for
-sending exceeds this value. The value t means disallow more
-than 1 line of input."
+sending meets or exceeds this value. The value t is synonymous
+with a value of 2 and means disallow more than 1 line of input."
:package-version '(ERC . "5.5")
:group 'erc
:type '(choice integer boolean))
@@ -1101,7 +1101,8 @@ 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
(defvar erc--input-review-functions '(erc--split-lines
erc--run-input-validation-checks
- erc--discard-trailing-multiline-nulls)
+ erc--discard-trailing-multiline-nulls
+ erc--inhibit-slash-cmd-insertion)
"Special hook for reviewing and modifying prompt input.
ERC runs this before clearing the prompt and before running any
send-related hooks, such as `erc-pre-send-functions'. Thus, it's
@@ -6476,6 +6477,9 @@ erc--count-blank-lines
(setq pad 1))
(list total pad strip)))
+(defvar erc--check-prompt-explanation nil
+ "List of strings to print if no validator returns non-nil.")
+
(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
"Return non-nil when multiline prompt input has blank LINES.
Consider newlines to be intervening delimiters, meaning the
@@ -6499,7 +6503,10 @@ erc--check-prompt-input-for-multiline-blanks
(when msg
(setf msg (nreverse msg)
(car msg) (capitalize (car msg))))
- (and msg `(message ,(string-join msg " ") ,@(nreverse args)))))
+ (when msg
+ (push (apply #'format (string-join msg " ") (nreverse args))
+ erc--check-prompt-explanation)
+ nil)))
(erc-warn-about-blank-lines
(concat (if (= total 1)
(if (zerop strip) "Blank" "Trailing")
@@ -6534,27 +6541,38 @@ erc--check-prompt-input-for-multiline-command
(defvar erc--check-prompt-input-functions
'(erc--check-prompt-input-for-point-in-bounds
erc--check-prompt-input-for-something
+ erc--check-prompt-input-for-multiline-command
erc--check-prompt-input-for-multiline-blanks
erc--check-prompt-input-for-running-process
- erc--check-prompt-input-for-excess-lines
- erc--check-prompt-input-for-multiline-command)
+ 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, processing is abandoned and input is left untouched.
-When the returned value is a string, ERC passes it to `erc-error'.")
+Called with two arguments: the current input submitted by the
+user, as a string, along with the same input as a list of
+strings. If any member function returns non-nil, ERC abandons
+processing and leaves pending input untouched in the prompt area.
+When the returned value is a string, ERC passes it to
+`user-error'. Any other non-nil value tells ERC to abort
+silently. If all members return nil, and the variable
+`erc--check-prompt-explanation' is a nonempty list of strings,
+ERC prints them as a single message joined by newlines.")
(defun erc--run-input-validation-checks (state)
"Run input checkers from STATE, an `erc--input-split' object."
- (when-let ((msg (run-hook-with-args-until-success
- 'erc--check-prompt-input-functions
- (erc--input-split-string state)
- (erc--input-split-lines state))))
- (cond ((eq (car-safe msg) 'message)
- (apply 'message (cdr msg)))
- ((stringp msg)
- (user-error msg))
- (t (push msg (erc--input-split-abortp state))))))
+ (let* ((erc--check-prompt-explanation nil)
+ (msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions
+ (erc--input-split-string state)
+ (erc--input-split-lines state))))
+ (cond ((stringp msg) (user-error msg))
+ (msg (push msg (erc--input-split-abortp state)))
+ (erc--check-prompt-explanation
+ (message "%s" (string-join (nreverse erc--check-prompt-explanation)
+ "\n"))))))
+
+(defun erc--inhibit-slash-cmd-insertion (state)
+ "Don't insert STATE object's message if it's a \"slash\" command."
+ (when (erc--input-split-cmdp state)
+ (setf (erc--input-split-insertp state) nil)))
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
@@ -6664,9 +6682,8 @@ erc--send-input-lines
"Send lines in `erc--input-split-lines' object LINES-OBJ."
(when (erc--input-split-sendp lines-obj)
(dolist (line (erc--input-split-lines lines-obj))
- (unless (erc--input-split-cmdp lines-obj)
- (when (erc--input-split-insertp lines-obj)
- (erc-display-msg line)))
+ (when (erc--input-split-insertp lines-obj)
+ (erc-display-msg line))
(erc-process-input-line (concat line "\n")
(null erc-flood-protect)
(not (erc--input-split-cmdp lines-obj))))))
diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el
index dd0a8612388..206687ccab5 100644
--- a/test/lisp/erc/erc-scenarios-scrolltobottom.el
+++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el
@@ -35,7 +35,7 @@ erc-scenarios-scrolltobottom--normal
(should-not erc-scrolltobottom-all)
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion doesn't anchor prompt in other window")
(let ((w (next-window)))
@@ -52,7 +52,7 @@ erc-scenarios-scrolltobottom--all
(let ((erc-scrolltobottom-all t))
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion anchors prompt in other window")
(let ((w (next-window)))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index bb7e3259608..8a68eca6196 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -292,7 +292,7 @@ erc--refresh-prompt
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
- erc--input-review-functions
+ (erc--input-review-functions erc--input-review-functions)
erc-send-completed-hook)
(ert-info ("Server buffer")
@@ -357,6 +357,9 @@ erc--refresh-prompt
(should (= (point) erc-input-marker))
(insert "/query bob")
(erc-send-current-line)
+ ;; Last command not inserted
+ (save-excursion (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
;; Query does not redraw (nor /help, only message input)
(should (looking-back "#chan@ServNet 11> "))
;; No sign of old prompts
@@ -877,11 +880,12 @@ erc-ring-previous-command
(with-current-buffer (get-buffer-create "*#fake*")
(erc-mode)
(erc-tests--send-prep)
+ (setq erc-server-current-nick "tester")
(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)
;; Just in case erc-ring-mode is already on
- (setq-local erc--input-review-functions nil)
+ (setq-local erc--input-review-functions erc--input-review-functions)
(add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
;;
(cl-letf (((symbol-function 'erc-process-input-line)
@@ -1256,8 +1260,9 @@ erc--check-prompt-input-for-multiline-blanks/explanations
(("" "a" "" "b" "" "c" "" "")
"Stripping (2) and padding (3) blank lines")))
(ert-info ((format "Input: %S, Msg: %S" input msg))
- (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
- (should (equal (apply #'format (cdr rv)) msg))))))
+ (let (erc--check-prompt-explanation)
+ (should-not (erc--check-prompt-input-for-multiline-blanks nil input))
+ (should (equal (list msg) erc--check-prompt-explanation))))))
(pcase-dolist (`(,input ,msg)
'((("") "Blank line detected")
@@ -1311,17 +1316,12 @@ erc-send-whitespace-lines
(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\n\n\n" "/a b\n")))
+ (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n"))
(insert p)
(erc-send-current-line)
(erc-bol)
(should (eq (point) (point-max)))
- (while q
- (should (pcase (funcall next)
- (`(,cmd ,_ nil) (equal cmd (pop q))))))
+ (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n"))))
(should-not (funcall next))))
(ert-info ("Multiline command with non-blanks errors")
diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el
index b86769220dd..f072c6b93b2 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -254,7 +254,7 @@ erc-d--initialize-client
(ending (process-get process :dialog-ending))
(dialog (make-erc-d-dialog :name name
:process process
- :queue (make-ring 5)
+ :queue (make-ring 10)
:exchanges (make-ring 10)
:match-handlers mat-h
:server-fqdn fqdn)))
@@ -292,33 +292,27 @@ erc-d-load-replacement-dialog
(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
-(defmacro erc-d--m (process format-string &rest args)
- "Output ARGS using FORMAT-STRING somewhere depending on context.
-PROCESS should be a client connection or a server network process."
- `(let ((format-string (if erc-d--m-debug
- (concat (format-time-string "%s.%N: ")
- ,format-string)
- ,format-string))
- (want-insert (and ,process erc-d--in-process))
- (buffer (process-buffer (process-get ,process :server))))
- (when (and want-insert (buffer-live-p buffer))
- (with-current-buffer buffer
- (goto-char (point-max))
- (insert (concat (format ,format-string ,@args) "\n"))))
- (when (or erc-d--m-debug (not want-insert))
- (message format-string ,@args))))
-
-(defmacro erc-d--log (process string &optional outbound)
- "Log STRING sent to (OUTBOUND) or received from PROCESS peer."
- `(let ((id (or (process-get ,process :log-id)
- (let ((port (erc-d-u--get-remote-port ,process)))
- (process-put ,process :log-id port)
- port)))
- (name (erc-d-dialog-name (process-get ,process :dialog))))
- (if ,outbound
- (erc-d--m process "-> %s:%s %s" name id ,string)
- (dolist (line (split-string ,string (process-get process :ending)))
- (erc-d--m process "<- %s:%s %s" name id line)))))
+(defun erc-d--m (process format-string &rest args)
+ "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere."
+ (when erc-d--m-debug
+ (setq format-string (concat (format-time-string "%s.%N: ") format-string)))
+ (let ((insertp (and process erc-d--in-process))
+ (buffer (process-buffer (process-get process :server))))
+ (when (and insertp (buffer-live-p buffer))
+ (princ (concat (apply #'format format-string args) "\n") buffer))
+ (when (or erc-d--m-debug (not insertp))
+ (apply #'message format-string args))))
+
+(defun erc-d--log (process string &optional outbound)
+ "Log STRING received from or OUTBOUND to PROCESS peer."
+ (let ((id (or (process-get process :log-id)
+ (let ((port (erc-d-u--get-remote-port process)))
+ (process-put process :log-id port) port)))
+ (name (erc-d-dialog-name (process-get process :dialog))))
+ (if outbound
+ (erc-d--m process "-> %s:%s %s" name id string)
+ (dolist (line (split-string string (process-get process :ending)))
+ (erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log-process-event (server process msg)
(erc-d--m server "%s: %s" process (string-trim-right msg)))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 19f26bf08bd..5354b300b47 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -341,7 +341,7 @@ erc-scenarios-common--recenter-top-bottom
;;;; Fixtures
-(defun erc-scenarios-scrolltobottom--normal (test)
+(defun erc-scenarios-common-scrolltobottom--normal (test)
(erc-scenarios-common-with-noninteractive-in-term
((erc-scenarios-common-dialog "scrolltobottom")
(dumb-server (erc-d-run "localhost" t 'help))
@@ -402,6 +402,7 @@ erc-scenarios-scrolltobottom--normal
(erc-cmd-MSG "NickServ help register")
(save-excursion (erc-d-t-search-for 10 "End of NickServ"))
(should (= 1 (point)))
+ (redisplay)
(should (zerop (count-screen-lines (window-start) (window-point))))
(should (erc-scenarios-common--prompt-past-win-end-p)))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-Increase-ERC-test-server-queue-size.patch --]
[-- Type: text/x-patch, Size: 6487 bytes --]
From 86ee2386d8474384e38c5023163098572f05d3fa Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 18 Sep 2023 22:50:28 -0700
Subject: [PATCH 1/4] ; Increase ERC test server queue size
* test/lisp/erc/erc-scenarios-scrolltobottom.el
(erc-scenarios-scrolltobottom--normal,
erc-scenarios-scrolltobottom--all): Use update name for test fixture.
* test/lisp/erc/resources/erc-d/erc-d.el
(erc-d--initialize-client): For lengthy batches, `erc-d--filter' may
run multiple times before `erc-d--on-request' can pull from the queue,
which results in discarded incoming messages and match failures.
(erc-d--m, erc-d--log): Convert to ordinary functions.
* test/lisp/erc/resources/erc-scenarios-common.el
(erc-scenarios-scrolltobottom--normal,
erc-scenarios-common-scrolltobottom--normal): Rename test fixture from
former to latter and attempt to fix intermittent failure re
`count-screen-lines'.
---
test/lisp/erc/erc-scenarios-scrolltobottom.el | 4 +-
test/lisp/erc/resources/erc-d/erc-d.el | 50 ++++++++-----------
.../erc/resources/erc-scenarios-common.el | 3 +-
3 files changed, 26 insertions(+), 31 deletions(-)
diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el
index dd0a8612388..206687ccab5 100644
--- a/test/lisp/erc/erc-scenarios-scrolltobottom.el
+++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el
@@ -35,7 +35,7 @@ erc-scenarios-scrolltobottom--normal
(should-not erc-scrolltobottom-all)
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion doesn't anchor prompt in other window")
(let ((w (next-window)))
@@ -52,7 +52,7 @@ erc-scenarios-scrolltobottom--all
(let ((erc-scrolltobottom-all t))
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion anchors prompt in other window")
(let ((w (next-window)))
diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el
index b86769220dd..f072c6b93b2 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -254,7 +254,7 @@ erc-d--initialize-client
(ending (process-get process :dialog-ending))
(dialog (make-erc-d-dialog :name name
:process process
- :queue (make-ring 5)
+ :queue (make-ring 10)
:exchanges (make-ring 10)
:match-handlers mat-h
:server-fqdn fqdn)))
@@ -292,33 +292,27 @@ erc-d-load-replacement-dialog
(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
-(defmacro erc-d--m (process format-string &rest args)
- "Output ARGS using FORMAT-STRING somewhere depending on context.
-PROCESS should be a client connection or a server network process."
- `(let ((format-string (if erc-d--m-debug
- (concat (format-time-string "%s.%N: ")
- ,format-string)
- ,format-string))
- (want-insert (and ,process erc-d--in-process))
- (buffer (process-buffer (process-get ,process :server))))
- (when (and want-insert (buffer-live-p buffer))
- (with-current-buffer buffer
- (goto-char (point-max))
- (insert (concat (format ,format-string ,@args) "\n"))))
- (when (or erc-d--m-debug (not want-insert))
- (message format-string ,@args))))
-
-(defmacro erc-d--log (process string &optional outbound)
- "Log STRING sent to (OUTBOUND) or received from PROCESS peer."
- `(let ((id (or (process-get ,process :log-id)
- (let ((port (erc-d-u--get-remote-port ,process)))
- (process-put ,process :log-id port)
- port)))
- (name (erc-d-dialog-name (process-get ,process :dialog))))
- (if ,outbound
- (erc-d--m process "-> %s:%s %s" name id ,string)
- (dolist (line (split-string ,string (process-get process :ending)))
- (erc-d--m process "<- %s:%s %s" name id line)))))
+(defun erc-d--m (process format-string &rest args)
+ "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere."
+ (when erc-d--m-debug
+ (setq format-string (concat (format-time-string "%s.%N: ") format-string)))
+ (let ((insertp (and process erc-d--in-process))
+ (buffer (process-buffer (process-get process :server))))
+ (when (and insertp (buffer-live-p buffer))
+ (princ (concat (apply #'format format-string args) "\n") buffer))
+ (when (or erc-d--m-debug (not insertp))
+ (apply #'message format-string args))))
+
+(defun erc-d--log (process string &optional outbound)
+ "Log STRING received from or OUTBOUND to PROCESS peer."
+ (let ((id (or (process-get process :log-id)
+ (let ((port (erc-d-u--get-remote-port process)))
+ (process-put process :log-id port) port)))
+ (name (erc-d-dialog-name (process-get process :dialog))))
+ (if outbound
+ (erc-d--m process "-> %s:%s %s" name id string)
+ (dolist (line (split-string string (process-get process :ending)))
+ (erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log-process-event (server process msg)
(erc-d--m server "%s: %s" process (string-trim-right msg)))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el
index 19f26bf08bd..5354b300b47 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -341,7 +341,7 @@ erc-scenarios-common--recenter-top-bottom
;;;; Fixtures
-(defun erc-scenarios-scrolltobottom--normal (test)
+(defun erc-scenarios-common-scrolltobottom--normal (test)
(erc-scenarios-common-with-noninteractive-in-term
((erc-scenarios-common-dialog "scrolltobottom")
(dumb-server (erc-d-run "localhost" t 'help))
@@ -402,6 +402,7 @@ erc-scenarios-scrolltobottom--normal
(erc-cmd-MSG "NickServ help register")
(save-excursion (erc-d-t-search-for 10 "End of NickServ"))
(should (= 1 (point)))
+ (redisplay)
(should (zerop (count-screen-lines (window-start) (window-point))))
(should (erc-scenarios-common--prompt-past-win-end-p)))
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-Exempt-text-scale-mode-from-erc-scrolltobottom-all.patch --]
[-- Type: text/x-patch, Size: 1823 bytes --]
From 9abdac639b0037fcb11bd39df97a59c534b21fb6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 20 Sep 2023 21:40:36 -0700
Subject: [PATCH 2/4] Exempt text-scale-mode from erc-scrolltobottom-all
* lisp/erc/erc-goodies.el (erc--scrolltobottom-post-ignore-commands):
New variable, a list of commands that should not trigger a re-scroll.
(erc--scrolltobottom-on-post-command): Don't `recenter' when the
current command appears in `erc--scrolltobottom-post-ignore-commands'.
---
lisp/erc/erc-goodies.el | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 6eb015fdd64..431264ec8b4 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -128,6 +128,11 @@ erc--scrolltobottom-post-force-commands
That is, ERC recalculates the window's start instead of blindly
restoring it.")
+;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed'
+;; is enabled (scaling up still moves the prompt).
+(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust)
+ "Commands to skip instead of force-scroll on `post-command-hook'.")
+
(defvar erc--scrolltobottom-relaxed-skip-commands
'(recenter-top-bottom scroll-down-command)
"Commands exempt from triggering a stash and restore of `window-start'.
@@ -158,7 +163,8 @@ erc--scrolltobottom-on-post-command
((= (nth 2 found)
(count-screen-lines (window-start) (point-max)))))
(set-window-start (selected-window) (nth 1 found))
- (erc--scrolltobottom-confirm))
+ (unless (memq this-command erc--scrolltobottom-post-ignore-commands)
+ (erc--scrolltobottom-confirm)))
(setq erc--scrolltobottom-window-info nil)))
(defun erc--scrolltobottom-on-pre-command-relaxed ()
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Improve-erc-warn-about-blank-lines-behavior.patch --]
[-- Type: text/x-patch, Size: 27385 bytes --]
From 4241661eb4cf568196cf11f77ccbf56a8f23c1d6 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 15 Sep 2023 06:08:55 -0700
Subject: [PATCH 3/4] [5.6] Improve erc-warn-about-blank-lines behavior
* etc/ERC-NEWS: Mention more detailed feedback when option
`erc-warn-about-blank-lines' is non-nil.
* lisp/erc/erc-common.el (erc--input-split): Add `abortp' slot to
allow a premature exit while validating prompt input.
* lisp/erc/erc.el (erc-warn-about-blank-lines): Clarify meaning of
"blank lines" and mention interaction with
`erc-send-whitespace-lines'.
(erc-inhibit-multiline-input): Fix inaccurate description in doc
string.
(erc--input-review-functions): Move
`erc--discard-trailing-multiline-nulls' to end of list, after
`erc--run-input-validation-checks'.
(erc--blank-in-multiline-input-p): Remove unused internal function.
(erc--check-prompt-input-for-something): New trivial validation
function to check if the input is empty.
(erc--count-blank-lines): New function that tallies up the number of
blank and whitespace-only lines in the current input.
(erc--check-prompt-explanation): New variable.
(erc--check-prompt-input-for-multiline-blanks): Rework significantly
to provide more informative messages and more sensible behavior for
common cases with respect to relevant option values.
(erc--check-prompt-input-functions): Add new validation function
`erc--check-prompt-for-something'.
(erc--run-input-validation-checks): Set `abortp' slot of
`erc--input-split' when hooks return a non-string, rather than
generate an unhelpful fallback message. Also print a message when
the variable `erc--check-prompt-explanation' is non-nil.
(erc-send-current-line): When the `abortp' slot of the current
`erc--input-split' object is non-nil, forgo normal input processing.
This fixes a regression in 5.6-git, which emits an error message when
it should instead just exit the command.
(erc--discard-trailing-multiline-nulls): Always run, regardless of
`erc-send-whitespace-lines', and leave a blank line behind when
stripping a message consisting of only blank lines.
(erc--run-send-hooks): Always run hooks and surrounding logic rather
than only when hooks are populated.
* test/lisp/erc/erc-tests.el (erc--refresh-prompt): Add assertion and
use default value for `erc--input-review-functions'.
(erc-ring-previous-command): Use default value for
`erc--input-review-functions'.
(erc--blank-in-multiline-input-p): Remove irrelevant test.
(erc--check-prompt-input-functions): Update expected message.
(erc--discard-trailing-multiline-nulls, erc--count-blank-lines): New
tests.
(erc-tests--check-prompt-input--expect,
erc-tests--check-prompt-input-messages): New helper variables.
(erc--check-prompt-input-for-multiline-blanks,
erc--check-prompt-input-for-multiline-blanks/explanations): New tests.
(erc-send-whitespace-lines): Expect hook-processing logic to pad empty
lines instead of deferring to `erc-send-input-line-function'.
(Bug#66073)
---
etc/ERC-NEWS | 8 +-
lisp/erc/erc-common.el | 1 +
lisp/erc/erc.el | 151 ++++++++++++++++++++++---------
test/lisp/erc/erc-tests.el | 180 ++++++++++++++++++++++++++++---------
4 files changed, 256 insertions(+), 84 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..fadd97b65df 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -221,6 +221,12 @@ atop any message. The new companion option 'erc-echo-timestamp-zone'
determines the default timezone when not specified with a prefix
argument.
+** Option 'erc-warn-about-blank-lines' is more informative.
+Enabled by default, this option now produces more useful feedback
+whenever ERC rejects prompt input containing whitespace-only lines.
+When paired with option 'erc-send-whitespace-lines', ERC echoes a
+tally of blank lines padded and trailing blanks culled.
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, fool visibility has become togglable with the new
@@ -281,7 +287,7 @@ For starters, the 'cursor-sensor-functions' property no longer
contains unique closures and thus no longer proves effective for
traversing messages. To compensate, a new property, 'erc-timestamp',
now spans message bodies but not the newlines delimiting them. Also
-affecting the `stamp' module is the deprecation of the function
+affecting the 'stamp' module is the deprecation of the function
'erc-insert-aligned' and its removal from client code. Additionally,
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 67c2cf8535b..8d896e663b5 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -60,6 +60,7 @@ erc-input
((obsolete erc-send-this))
erc-send-this))))
(lines nil :type (list-of string))
+ (abortp nil :type (list-of symbol))
(cmdp nil :type boolean))
(cl-defstruct (erc-server-user (:type vector) :named)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..76af17583da 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -249,7 +249,14 @@ erc-prompt-for-password
:type 'boolean)
(defcustom erc-warn-about-blank-lines t
- "Warn the user if they attempt to send a blank line."
+ "Warn the user if they attempt to send a blank line.
+When non-nil, ERC signals a `user-error' upon encountering prompt
+input containing empty or whitespace-only lines. When nil, ERC
+still inhibits sending but does so silently. With the companion
+option `erc-send-whitespace-lines' enabled, ERC sends pending
+input and prints a message in the echo area indicating the amount
+of padding and/or stripping applied, if any. Setting this option
+to nil suppresses such reporting."
:group 'erc
:type 'boolean)
@@ -261,8 +268,8 @@ erc-send-whitespace-lines
(defcustom erc-inhibit-multiline-input nil
"When non-nil, conditionally disallow input consisting of multiple lines.
Issue an error when the number of input lines submitted for
-sending exceeds this value. The value t means disallow more
-than 1 line of input."
+sending meets or exceeds this value. The value t is synonymous
+with a value of 2 and means disallow more than 1 line of input."
:package-version '(ERC . "5.5")
:group 'erc
:type '(choice integer boolean))
@@ -1092,9 +1099,9 @@ erc-pre-send-functions
(define-obsolete-variable-alias 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
-(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls
- erc--split-lines
- erc--run-input-validation-checks)
+(defvar erc--input-review-functions '(erc--split-lines
+ erc--run-input-validation-checks
+ erc--discard-trailing-multiline-nulls)
"Special hook for reviewing and modifying prompt input.
ERC runs this before clearing the prompt and before running any
send-related hooks, such as `erc-pre-send-functions'. Thus, it's
@@ -6421,20 +6428,6 @@ erc--input-line-delim-regexp
(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
"Regular expression used for matching commands in ERC.")
-(defun erc--blank-in-multiline-input-p (lines)
- "Detect whether LINES contains a blank line.
-When `erc-send-whitespace-lines' is in effect, return nil if
-LINES is multiline or the first 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 ((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-excess-lines (_ lines)
"Return non-nil when trying to send too many LINES."
(when erc-inhibit-multiline-input
@@ -6454,13 +6447,78 @@ erc--check-prompt-input-for-excess-lines
(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)
+(defun erc--check-prompt-input-for-something (string _)
+ (when (string-empty-p string)
(if erc-warn-about-blank-lines
"Blank line - ignoring..."
'invalid)))
+(defun erc--count-blank-lines (lines)
+ "Report on the number of whitespace-only and empty LINES.
+Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know
+that BLANKS includes non-empty whitespace-only lines and that no
+padding or stripping has yet occurred."
+ (let ((real 0) (total 0) (pad 0) (strip 0))
+ (dolist (line lines)
+ (if (string-match (rx bot (* (in " \t\f")) eot) line)
+ (progn
+ (cl-incf total)
+ (if (zerop (match-end 0))
+ (cl-incf strip)
+ (cl-incf pad strip)
+ (setq strip 0)))
+ (cl-incf real)
+ (unless (zerop strip)
+ (cl-incf pad strip)
+ (setq strip 0))))
+ (when (and (zerop real) (not (zerop total)) (= total (+ pad strip)))
+ (cl-incf strip (1- pad))
+ (setq pad 1))
+ (list total pad strip)))
+
+(defvar erc--check-prompt-explanation nil
+ "List of strings to print if no validator returns non-nil.")
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+ "Return non-nil when multiline prompt input has blank LINES.
+Consider newlines to be intervening delimiters, meaning the
+zero-width logical line between a trailing newline and `eob'
+constitutes a separate message."
+ (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines)))
+ (cond ((zerop total) nil)
+ ((and erc-warn-about-blank-lines erc-send-whitespace-lines)
+ (let (msg args)
+ (unless (zerop strip)
+ (push "stripping (%d)" msg)
+ (push strip args))
+ (unless (zerop pad)
+ (when msg
+ (push "and" msg))
+ (push "padding (%d)" msg)
+ (push pad args))
+ (when msg
+ (push "blank" msg)
+ (push (if (> (apply #'+ args) 1) "lines" "line") msg))
+ (when msg
+ (setf msg (nreverse msg)
+ (car msg) (capitalize (car msg))))
+ (when msg
+ (push (apply #'format (string-join msg " ") (nreverse args))
+ erc--check-prompt-explanation)
+ nil)))
+ (erc-warn-about-blank-lines
+ (concat (if (= total 1)
+ (if (zerop strip) "Blank" "Trailing")
+ (if (= total strip)
+ (format "%d trailing" strip)
+ (format "%d blank" total)))
+ (and (> total 1) (/= total strip) (not (zerop strip))
+ (format " (%d trailing)" strip))
+ (if (= total 1) " line" " lines")
+ " detected (see `erc-send-whitespace-lines')"))
+ (erc-send-whitespace-lines nil)
+ (t '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))
@@ -6481,25 +6539,34 @@ erc--check-prompt-input-for-multiline-command
(defvar erc--check-prompt-input-functions
'(erc--check-prompt-input-for-point-in-bounds
+ erc--check-prompt-input-for-something
erc--check-prompt-input-for-multiline-blanks
erc--check-prompt-input-for-running-process
erc--check-prompt-input-for-excess-lines
erc--check-prompt-input-for-multiline-command)
"Validators for user input typed at prompt.
-Called with latest input string submitted by user and the list of
-lines produced by splitting it. If any member function returns
-non-nil, processing is abandoned and input is left untouched.
-When the returned value is a string, ERC passes it to `erc-error'.")
+Called with two arguments: the current input submitted by the
+user, as a string, along with the same input as a list of
+strings. If any member function returns non-nil, ERC abandons
+processing and leaves pending input untouched in the prompt area.
+When the returned value is a string, ERC passes it to
+`user-error'. Any other non-nil value tells ERC to abort
+silently. If all members return nil, and the variable
+`erc--check-prompt-explanation' is a nonempty list of strings,
+ERC prints them as a single message joined by newlines.")
(defun erc--run-input-validation-checks (state)
"Run input checkers from STATE, an `erc--input-split' object."
- (when-let ((msg (run-hook-with-args-until-success
- 'erc--check-prompt-input-functions
- (erc--input-split-string state)
- (erc--input-split-lines state))))
- (unless (stringp msg)
- (setq msg (format "Input error: %S" msg)))
- (user-error msg)))
+ (let* ((erc--check-prompt-explanation nil)
+ (msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions
+ (erc--input-split-string state)
+ (erc--input-split-lines state))))
+ (cond ((stringp msg) (user-error msg))
+ (msg (push msg (erc--input-split-abortp state)))
+ (erc--check-prompt-explanation
+ (message "%s" (string-join (nreverse erc--check-prompt-explanation)
+ "\n"))))))
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
@@ -6523,8 +6590,9 @@ erc-send-current-line
str erc--input-line-delim-regexp)
:cmdp (string-match erc-command-regexp str))))
(run-hook-with-args 'erc--input-review-functions state)
- (let ((inhibit-read-only t)
- (old-buf (current-buffer)))
+ (when-let (((not (erc--input-split-abortp state)))
+ (inhibit-read-only t)
+ (old-buf (current-buffer)))
(progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
@@ -6553,12 +6621,11 @@ erc-user-input
(erc-end-of-input-line)))
(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))
+ "Remove trailing empty lines from STATE, an `erc--input-split' object.
+When all lines are empty, remove all but the first."
+ (when (erc--input-split-lines state)
(let ((reversed (nreverse (erc--input-split-lines state))))
- (while (and reversed (string-empty-p (car reversed)))
+ (while (and (cdr reversed) (string-empty-p (car reversed)))
(setq reversed (cdr reversed)))
(setf (erc--input-split-lines state) (nreverse reversed)))))
@@ -6578,7 +6645,7 @@ erc--run-send-hooks
limits and pad empty ones, knowing full well that additional
processing may still corrupt messages before they reach the send
queue. Expect LINES-OBJ to be an `erc--input-split' object."
- (when (or erc-send-pre-hook erc-pre-send-functions)
+ (progn ; FIXME remove `progn' after code review.
(with-suppressed-warnings ((lexical str) (obsolete erc-send-this))
(defvar str) ; see note in string `erc-send-input'.
(let* ((str (string-join (erc--input-split-lines lines-obj) "\n"))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..2da1f7b29c1 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -292,7 +292,7 @@ erc--refresh-prompt
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
- erc--input-review-functions
+ (erc--input-review-functions erc--input-review-functions)
erc-send-completed-hook)
(ert-info ("Server buffer")
@@ -357,6 +357,9 @@ erc--refresh-prompt
(should (= (point) erc-input-marker))
(insert "/query bob")
(erc-send-current-line)
+ ;; Last command not inserted
+ (save-excursion (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
;; Query does not redraw (nor /help, only message input)
(should (looking-back "#chan@ServNet 11> "))
;; No sign of old prompts
@@ -877,11 +880,12 @@ erc-ring-previous-command
(with-current-buffer (get-buffer-create "*#fake*")
(erc-mode)
(erc-tests--send-prep)
+ (setq erc-server-current-nick "tester")
(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)
;; Just in case erc-ring-mode is already on
- (setq-local erc--input-review-functions nil)
+ (setq-local erc--input-review-functions erc--input-review-functions)
(add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
;;
(cl-letf (((symbol-function 'erc-process-input-line)
@@ -1056,43 +1060,6 @@ erc--input-line-delim-regexp
(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--input-review-functions
@@ -1138,7 +1105,7 @@ erc--check-prompt-input-functions
(delete-region (point) (point-max))
(insert "one\n")
(let ((e (should-error (erc-send-current-line))))
- (should (equal "Blank line - ignoring..." (cadr e))))
+ (should (string-prefix-p "Trailing line detected" (cadr e))))
(goto-char (point-max))
(ert-info ("Input remains untouched")
(should (save-excursion (goto-char erc-input-marker)
@@ -1180,6 +1147,137 @@ erc-send-current-line
(should (consp erc-last-input-time)))))
+(ert-deftest erc--discard-trailing-multiline-nulls ()
+ (pcase-dolist (`(,input ,want) '((("") (""))
+ (("" "") (""))
+ (("a") ("a"))
+ (("a" "") ("a"))
+ (("" "a") ("" "a"))
+ (("" "a" "") ("" "a"))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (let ((s (make-erc--input-split :lines input)))
+ (erc--discard-trailing-multiline-nulls s)
+ (should (equal (erc--input-split-lines s) want))))))
+
+(ert-deftest erc--count-blank-lines ()
+ (pcase-dolist (`(,input ,want) '((() (0 0 0))
+ (("") (1 1 0))
+ (("" "") (2 1 1))
+ (("" "" "") (3 1 2))
+ ((" " "") (2 0 1))
+ ((" " "" "") (3 0 2))
+ (("" " " "") (3 1 1))
+ (("" "" " ") (3 2 0))
+ (("a") (0 0 0))
+ (("a" "") (1 0 1))
+ (("a" " " "") (2 0 1))
+ (("a" "" "") (2 0 2))
+ (("a" "b") (0 0 0))
+ (("a" "" "b") (1 1 0))
+ (("a" " " "b") (1 0 0))
+ (("" "a") (1 1 0))
+ ((" " "a") (1 0 0))
+ (("" "a" "") (2 1 1))
+ (("" " " "a" "" " ") (4 2 0))
+ (("" " " "a" "" " " "") (5 2 1))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (should (equal (erc--count-blank-lines input) want)))))
+
+;; Opt `wb': `erc-warn-about-blank-lines'
+;; Opt `sw': `erc-send-whitespace-lines'
+;; `s': " \n",`a': "a\n",`b': "b\n"
+(defvar erc-tests--check-prompt-input--expect
+ ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb"
+ '(((+wb -sw) err err err err err err err err err)
+ ((-wb -sw) nop nop nop nop nop nop nop nop nop)
+ ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b))
+ ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b))))
+
+;; Help messages echoed (not IRC message) was emitted
+(defvar erc-tests--check-prompt-input-messages
+ '("Stripping" "Padding"))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (should-not erc-send-whitespace-lines)
+ (should erc-warn-about-blank-lines)
+
+ (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect)
+ (let ((print-escape-newlines t)
+ (erc-warn-about-blank-lines (eq wb '+wb))
+ (erc-send-whitespace-lines (eq sw '+sw))
+ (samples '("" " " "\n" "\n " " \n" "\n\n"
+ "a\n" "a\n " "a\n \nb")))
+ (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos
+ samples `(,@samples "a" "a\nb"))
+ (dolist (input samples)
+ (insert input)
+ (ert-info ((format "Opts: %S, Input: %S, want: %S"
+ (list wb sw) input (car ex)))
+ (ert-with-message-capture messages
+ (pcase-exhaustive (pop ex)
+ ('err (let ((e (should-error (erc-send-current-line))))
+ (should (string-match (rx (| "trailing" "blank"))
+ (cadr e))))
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('nop (erc-send-current-line)
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('clr (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (should-not (funcall next)))
+ ((and (pred consp) v)
+ (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (setq v (reverse v)) ; don't use `nreverse' here
+ (while v
+ (pcase (pop v)
+ ((and (pred integerp) n)
+ (should (string-search
+ (nth n erc-tests--check-prompt-input-messages)
+ messages)))
+ ('s (should (equal " \n" (car (funcall next)))))
+ ('a (should (equal "a\n" (car (funcall next)))))
+ ('b (should (equal "b\n" (car (funcall next)))))))
+ (should-not (funcall next))))))
+ (delete-region erc-input-marker (point-max))))))))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations ()
+ (should erc-warn-about-blank-lines)
+ (should-not erc-send-whitespace-lines)
+
+ (let ((erc-send-whitespace-lines t))
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Padding (1) blank line")
+ (("" " ") "Padding (1) blank line")
+ ((" " "") "Stripping (1) blank line")
+ (("a" "") "Stripping (1) blank line")
+ (("" "") "Stripping (1) and padding (1) blank lines")
+ (("" "" "") "Stripping (2) and padding (1) blank lines")
+ (("" "a" "" "b" "" "c" "" "")
+ "Stripping (2) and padding (3) blank lines")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let (erc--check-prompt-explanation)
+ (should-not (erc--check-prompt-input-for-multiline-blanks nil input))
+ (should (equal (list msg) erc--check-prompt-explanation))))))
+
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Blank line detected")
+ (("" " ") "2 blank lines detected")
+ ((" " "") "2 blank (1 trailing) lines detected")
+ (("a" "") "Trailing line detected")
+ (("" "") "2 blank (1 trailing) lines detected")
+ (("a" "" "") "2 trailing lines detected")
+ (("" "a" "" "b" "" "c" "" "")
+ "5 blank (2 trailing) lines detected")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
+ (should (equal (concat msg " (see `erc-send-whitespace-lines')")
+ rv ))))))
+
(ert-deftest erc-send-whitespace-lines ()
(erc-tests--with-process-input-spy
(lambda (next)
@@ -1196,7 +1294,7 @@ erc-send-whitespace-lines
(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) '(" \n" nil t)))
(should (equal (funcall next) '("one\n" nil t))))
(ert-info ("Multiline hunk with trailing newline filtered")
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-Detect-slash-commands-in-erc-input-review-functions.patch --]
[-- Type: text/x-patch, Size: 4734 bytes --]
From eeedb524c2686245da10aa827a6a9bfcbc54d046 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 9 Jun 2023 21:00:03 -0700
Subject: [PATCH 4/4] Detect slash commands in erc--input-review-functions
* lisp/erc/erc.el (erc--input-review-functions): Add
`erc--inhibit-slash-cmd-insertion'.
(erc--check-prompt-input-functions): Move
`erc--check-prompt-input-for-multiline-command' above
`erc--check-prompt-input-for-multiline-blanks'.
(erc--inhibit-slash-cmd-insertion): New function to suppress insertion
of prompt input for slash commands. Doesn't affect "meta" slash
commands like /SAY.
(erc--send-input-lines): Don't bother checking whether message is a
command. Instead, trust verdict handed down by message-prep
functions. This opens the door to optional insertion for debugging
purposes or when echoing command lines in a shell-like fashion.
* test/lisp/erc/erc-tests.el (erc-send-whitespace-lines): clean up
portion dealing with trimming slash commands. (Bug#66073)
---
lisp/erc/erc.el | 17 +++++++++++------
test/lisp/erc/erc-tests.el | 9 ++-------
2 files changed, 13 insertions(+), 13 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 76af17583da..b9ce6b8e53a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1101,7 +1101,8 @@ 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
(defvar erc--input-review-functions '(erc--split-lines
erc--run-input-validation-checks
- erc--discard-trailing-multiline-nulls)
+ erc--discard-trailing-multiline-nulls
+ erc--inhibit-slash-cmd-insertion)
"Special hook for reviewing and modifying prompt input.
ERC runs this before clearing the prompt and before running any
send-related hooks, such as `erc-pre-send-functions'. Thus, it's
@@ -6540,10 +6541,10 @@ erc--check-prompt-input-for-multiline-command
(defvar erc--check-prompt-input-functions
'(erc--check-prompt-input-for-point-in-bounds
erc--check-prompt-input-for-something
+ erc--check-prompt-input-for-multiline-command
erc--check-prompt-input-for-multiline-blanks
erc--check-prompt-input-for-running-process
- erc--check-prompt-input-for-excess-lines
- erc--check-prompt-input-for-multiline-command)
+ erc--check-prompt-input-for-excess-lines)
"Validators for user input typed at prompt.
Called with two arguments: the current input submitted by the
user, as a string, along with the same input as a list of
@@ -6568,6 +6569,11 @@ erc--run-input-validation-checks
(message "%s" (string-join (nreverse erc--check-prompt-explanation)
"\n"))))))
+(defun erc--inhibit-slash-cmd-insertion (state)
+ "Don't insert STATE object's message if it's a \"slash\" command."
+ (when (erc--input-split-cmdp state)
+ (setf (erc--input-split-insertp state) nil)))
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
@@ -6676,9 +6682,8 @@ erc--send-input-lines
"Send lines in `erc--input-split-lines' object LINES-OBJ."
(when (erc--input-split-sendp lines-obj)
(dolist (line (erc--input-split-lines lines-obj))
- (unless (erc--input-split-cmdp lines-obj)
- (when (erc--input-split-insertp lines-obj)
- (erc-display-msg line)))
+ (when (erc--input-split-insertp lines-obj)
+ (erc-display-msg line))
(erc-process-input-line (concat line "\n")
(null erc-flood-protect)
(not (erc--input-split-cmdp lines-obj))))))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 2da1f7b29c1..8a68eca6196 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1316,17 +1316,12 @@ erc-send-whitespace-lines
(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\n\n\n" "/a b\n")))
+ (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n"))
(insert p)
(erc-send-current-line)
(erc-bol)
(should (eq (point) (point-max)))
- (while q
- (should (pcase (funcall next)
- (`(,cmd ,_ nil) (equal cmd (pop q))))))
+ (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n"))))
(should-not (funcall next))))
(ert-info ("Multiline command with non-blanks errors")
--
2.41.0
^ permalink raw reply related [flat|nested] 4+ messages in thread
* bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt
[not found] ` <871qeq47ct.fsf@neverwas.me>
@ 2023-10-03 1:21 ` J.P.
0 siblings, 0 replies; 4+ messages in thread
From: J.P. @ 2023-10-03 1:21 UTC (permalink / raw)
To: 66073-done; +Cc: emacs-erc
"J.P." <jp@neverwas.me> writes:
> v2. Fix faulty interaction with `erc-inhibit-multiline-input'. Move
> slash-command detection to input-review hook.
I've installed an updated version of this as
https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=a3c6ed0e
Closing for now, though I do anticipate some (hopefully light) followup
work in this area. Thanks.
^ permalink raw reply [flat|nested] 4+ messages in thread
* bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt
2023-09-18 14:25 bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt J.P.
2023-09-22 14:20 ` J.P.
[not found] ` <871qeq47ct.fsf@neverwas.me>
@ 2023-12-07 7:24 ` J.P.
2 siblings, 0 replies; 4+ messages in thread
From: J.P. @ 2023-12-07 7:24 UTC (permalink / raw)
To: 66073; +Cc: emacs-erc
[-- Attachment #1: Type: text/plain, Size: 707 bytes --]
Changes from this bug attempted to fix a number of historical behavioral
quirks related to intercepting and validating prompt input preflight.
One thing they glossed over was not dealing with the confusing "No
process running" warning issued when a user submits input in an orphaned
target buffer. This unfortunate behavior has been with ERC for ages and
might well be cemented into the wider user "ecosystem" such that fixing
it interferes with things like a `condition-case' handler matching
against the exact wording, etc. However, given the annoying nature of
this style of input feedback, I think it makes sense to bite the bullet
here and just chance a minimally churn-inducing change. See attached.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0008-5.6-Clarify-warning-for-process-dependent-input-in-E.patch --]
[-- Type: text/x-patch, Size: 3117 bytes --]
From 62797d2b97fd8aa00dd45f778555f3c78ea1a6c1 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 27 Nov 2023 19:41:09 -0800
Subject: [PATCH 08/11] [5.6] Clarify warning for process-dependent input in
ERC
* lisp/erc/erc.el (erc--check-prompt-input-for-running-process):
Resolve dissonance between content of ancient `user-error' message and
condition that triggered it by favoring the former because it's
supported by the underlying mechanism, which revolves around the
`process-not-needed' symbol property.
* test/lisp/erc/erc-tests.el (erc--check-prompt-input-functions):
Revise expected output for error assertion. (Bug#66073, originally
from bug#54536)
---
lisp/erc/erc.el | 17 +++++++++++++----
test/lisp/erc/erc-tests.el | 4 ++--
2 files changed, 15 insertions(+), 6 deletions(-)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3e45949688d..98621302abd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -7318,11 +7318,20 @@ erc--check-prompt-input-for-point-in-bounds
(when (< (point) (erc-beg-of-input-line))
"Point is not in the input area"))
+;; Originally, `erc-send-current-line' inhibited sends whenever a
+;; server buffer was missing. In 2007, this was narrowed to
+;; occurrences involving process-dependent commands. However, the
+;; accompanying error message, which was identical to that emitted by
+;; `erc-server-send', "ERC: No process running", was always inaccurate
+;; because a server buffer can be alive and its process dead.
(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"))
+ "Return non-nil if STRING is a slash command missing a process.
+Also do so when the server buffer has been killed."
+ ;; Even if the server buffer has been killed, the user should still
+ ;; be able /reconnect and recall previous commands.
+ (and (not (erc-command-no-process-p string))
+ (or (and (not (erc-server-buffer-live-p)) "Server buffer missing")
+ (and (not (erc-server-process-alive)) "Process not running"))))
(defun erc--check-prompt-input-for-multiline-command (line lines)
"Return non-nil when non-blank lines follow a command line."
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index ac6eb6b5e3c..eb954112ce8 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1414,9 +1414,9 @@ erc--check-prompt-input-functions
(ert-info ("Input remains untouched")
(should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
- (ert-info ("Errors when no process running")
+ (ert-info ("Errors when server buffer absent")
(let ((e (should-error (erc-send-current-line))))
- (should (equal "ERC: No process running" (cadr e))))
+ (should (equal "Server buffer missing" (cadr e))))
(ert-info ("Input remains untouched")
(should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
--
2.42.0
^ permalink raw reply related [flat|nested] 4+ messages in thread
end of thread, other threads:[~2023-12-07 7:24 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-18 14:25 bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt J.P.
2023-09-22 14:20 ` J.P.
[not found] ` <871qeq47ct.fsf@neverwas.me>
2023-10-03 1:21 ` J.P.
2023-12-07 7:24 ` J.P.
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).