* 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