[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 35dd1ade7f1 11/14: Preprocess prompt input linewise in ERC
From: |
F. Jason Park |
Subject: |
master 35dd1ade7f1 11/14: Preprocess prompt input linewise in ERC |
Date: |
Fri, 5 May 2023 20:30:51 -0400 (EDT) |
branch: master
commit 35dd1ade7f1e583f736e6f707343402fe868daec
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>
Preprocess prompt input linewise in ERC
* etc/ERC-NEWS: Mention revised role of `erc-pre-send-functions'
relative to line splitting.
* lisp/erc/erc-common.el (erc-input): Add new slot `refoldp' to allow
`erc-pre-send-functions' members to indicate that splitting should
occur a second time after all members have had their say.
(erc--input-split): Specify some defaults for overridden slots and
explicitly declare some types for good measure.
* lisp/erc/erc-goodies.el (erc-noncommands-mode,
erc-noncommands-enable, erc-noncommands-disable): Replace
`erc-pre-send-functions' with `erc--input-review-functions'.
* lisp/erc/erc-ring.el (erc-ring-enable, erc-ring-disable,
erc-ring-mode): Subscribe to `erc--input-review-functions' instead of
`erc-pre-send-functions' for `erc--add-to-input-ring'.
* lisp/erc/erc.el (erc-pre-send-functions): Note some nuances
regarding line splitting in doc string and note that a new slot is
available.
(erc--pre-send-split-functions, erc--input-review-functions): Rename
former to latter, while also obsoleting. Remove large comment. Add
new default member `erc--run-input-validation-checks'.
(erc-send-modify-hook): Replace the obsolete `erc-send-pre-hook' and
`erc-send-this' with `erc-pre-send-functions' in doc string.
(erc--check-prompt-input-for-excess-lines): Don't trim trailing
blanks. Rework to also report overages in characters as well as
lines.
(erc--run-input-validation-hooks): New function to adapt an
`erc--input-split' object to `erc--check-prompt-input-functions'.
(erc-send-current-line): Run `erc--input-review-functions' in place of
the validation hooks they've subsumed. Call `erc--send-input-lines'
instead of the now retired but not deprecated `erc-send-input'.
(erc--run-send-hooks, erc--send-input-lines): New functions that
together form an alternate version of `erc-send-input'. They operate
on input linewise but make accommodations for older interfaces.
* test/lisp/erc/erc-tests.el (erc-ring-previous-command): Replace
`erc-pre-send-functions' with `erc--input-review-functions'.
(erc-tests--with-process-input-spy): Shadow
`erc--input-review-functions'.
(erc-check-prompt-input-for-excess-lines): Don't expect trailing
blanks to be trimmed.
(erc--run-send-hooks): New test. (Bug#62947)
---
etc/ERC-NEWS | 6 ++
lisp/erc/erc-common.el | 14 +++--
lisp/erc/erc-goodies.el | 5 +-
lisp/erc/erc-ring.el | 4 +-
lisp/erc/erc.el | 135 +++++++++++++++++++++++++++++++++------------
test/lisp/erc/erc-tests.el | 101 +++++++++++++++++++++++++++++++--
6 files changed, 218 insertions(+), 47 deletions(-)
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 2cf2743701a..3907b7bc5f2 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -187,6 +187,12 @@ The 'fill' module is now defined by 'define-erc-module'.
The same
goes for ERC's imenu integration, which has 'imenu' now appearing in
the default value of 'erc-modules'.
+*** Prompt input is split before 'erc-pre-send-functions' has a say.
+Hook members are now treated to input whose lines have already been
+adjusted to fall within the allowed length limit. For convenience,
+third-party code can request that the final input be "re-filled" prior
+to being sent. See doc string for details.
+
*** ERC's prompt survives the insertion of user input and messages.
Previously, ERC's prompt and its input marker disappeared while
running hooks during message insertion, and the position of its
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 708cdb0c422..86d78768374 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -30,8 +30,10 @@
(defvar erc--casemapping-rfc1459-strict)
(defvar erc-channel-users)
(defvar erc-dbuf)
+(defvar erc-insert-this)
(defvar erc-log-p)
(defvar erc-modules)
+(defvar erc-send-this)
(defvar erc-server-process)
(defvar erc-server-users)
(defvar erc-session-server)
@@ -49,10 +51,14 @@
(declare-function widget-type "wid-edit" (widget))
(cl-defstruct erc-input
- string insertp sendp)
-
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
+ string insertp sendp refoldp)
+
+(cl-defstruct (erc--input-split (:include erc-input
+ (string :read-only)
+ (insertp erc-insert-this)
+ (sendp erc-send-this)))
+ (lines nil :type (list-of string))
+ (cmdp nil :type boolean))
(cl-defstruct (erc-server-user (:type vector) :named)
;; User data
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 6235de5f1c0..cc60ba0018b 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -338,8 +338,9 @@ does not appear in the ERC buffer after the user presses
ENTER.")
"This mode distinguishes non-commands.
Commands listed in `erc-insert-this' know how to display
themselves."
- ((add-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands))
- ((remove-hook 'erc-pre-send-functions #'erc-send-distinguish-noncommands)))
+ ((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands))
+ ((remove-hook 'erc--input-review-functions
+ #'erc-send-distinguish-noncommands)))
(defun erc-send-distinguish-noncommands (state)
"If STR is an ERC non-command, set `insertp' in STATE to nil."
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 2451ac56f6f..4534e913204 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -46,10 +46,10 @@
(define-erc-module ring nil
"Stores input in a ring so that previous commands and messages can
be recalled using M-p and M-n."
- ((add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
+ ((add-hook 'erc--input-review-functions #'erc-add-to-input-ring 90)
(define-key erc-mode-map "\M-p" #'erc-previous-command)
(define-key erc-mode-map "\M-n" #'erc-next-command))
- ((remove-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
+ ((remove-hook 'erc--input-review-functions #'erc-add-to-input-ring)
(define-key erc-mode-map "\M-p" #'undefined)
(define-key erc-mode-map "\M-n" #'undefined)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index bc2285a5560..72ec8134eab 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1094,34 +1094,40 @@ The struct has three slots:
`string': The current input string.
`insertp': Whether the string should be inserted into the erc buffer.
- `sendp': Whether the string should be sent to the irc server."
+ `sendp': Whether the string should be sent to the irc server.
+ `refoldp': Whether the string should be re-split per protocol limits.
+
+This hook runs after protocol line splitting has taken place, so
+the value of `string' is originally \"pre-filled\". If you need
+ERC to refill the entire payload before sending it, set the
+`refoldp' slot to a non-nil value. Preformatted text and encoded
+subprotocols should probably be handled manually."
:group 'erc
:type 'hook
:version "27.1")
-;; This is being auditioned for possible exporting (as a custom hook
-;; option). Likewise for (public versions of) `erc--input-split' and
-;; `erc--discard-trailing-multiline-nulls'. If unneeded, we'll just
-;; run the latter on the input after `erc-pre-send-functions', and
-;; remove this hook and the struct completely. IOW, if you need this,
-;; please say so.
-
-(defvar erc--pre-send-split-functions '(erc--discard-trailing-multiline-nulls
- erc--split-lines)
- "Special hook for modifying individual lines in multiline prompt input.
-The functions are called with one argument, an `erc--input-split'
-struct, which they can optionally modify.
+(define-obsolete-variable-alias 'erc--pre-send-split-functions
+ 'erc--input-review-functions "30.1")
+(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls
+ erc--split-lines
+ erc--run-input-validation-checks)
+ "Special hook for reviewing and modifying prompt input.
+ERC runs this before clearing the prompt and before running any
+send-related hooks, such as `erc-pre-send-functions'. Thus, it's
+quite \"safe\" to bail out of this hook with a `user-error', if
+necessary. The hook's members are called with one argument, an
+`erc--input-split' struct, which they can optionally modify.
The struct has five slots:
- `string': the input string delivered by `erc-pre-send-functions'
- `insertp': whether to insert the lines into the buffer
- `sendp': whether the lines should be sent to the IRC server
+ `string': the original input as a read-only reference
+ `insertp': same as in `erc-pre-send-functions'
+ `sendp': same as in `erc-pre-send-functions'
+ `refoldp': same as in `erc-pre-send-functions'
`lines': a list of lines to be sent, each one a `string'
`cmdp': whether to interpret input as a command, like /ignore
-The `string' field is effectively read-only. When `cmdp' is
-non-nil, all but the first line will be discarded.")
+When `cmdp' is non-nil, all but the first line will be discarded.")
(defvar erc-insert-this t
"Insert the text into the target buffer or not.
@@ -1163,8 +1169,8 @@ preserve point if needed."
(defcustom erc-send-modify-hook nil
"Sending hook for functions that will change the text's appearance.
-This hook is called just after `erc-send-pre-hook' when the values
-of `erc-send-this' and `erc-insert-this' are both t.
+ERC runs this just after `erc-pre-send-functions' if its shared
+`erc-input' object's `sendp' and `insertp' slots remain non-nil.
While this hook is run, narrowing is in effect and `current-buffer' is
the buffer where the text got inserted.
@@ -6106,16 +6112,18 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
(defun erc--check-prompt-input-for-excess-lines (_ lines)
"Return non-nil when trying to send too many LINES."
(when erc-inhibit-multiline-input
- ;; Assume `erc--discard-trailing-multiline-nulls' is set to run
- (let ((reversed (seq-drop-while #'string-empty-p (reverse lines)))
- (max (if (eq erc-inhibit-multiline-input t)
+ (let ((max (if (eq erc-inhibit-multiline-input t)
2
erc-inhibit-multiline-input))
(seen 0)
- msg)
- (while (and (pop reversed) (< (cl-incf seen) max)))
+ last msg)
+ (while (and lines (setq last (pop lines)) (< (cl-incf seen) max)))
(when (= seen max)
- (setq msg (format "(exceeded by %d)" (1+ (length reversed))))
+ (push last lines)
+ (setq msg
+ (format "-- exceeded by %d (%d chars)"
+ (length lines)
+ (apply #'+ (mapcar #'length lines))))
(unless (and erc-ask-about-multiline-input
(y-or-n-p (concat "Send input " msg "?")))
(concat "Too many lines " msg))))))
@@ -6155,7 +6163,17 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
Called with latest input string submitted by user and the list of
lines produced by splitting it. If any member function returns
non-nil, processing is abandoned and input is left untouched.
-When the returned value is a string, pass it to `erc-error'.")
+When the returned value is a string, ERC passes it to `erc-error'.")
+
+(defun erc--run-input-validation-checks (state)
+ "Run input checkers from STATE, an `erc--input-split' object."
+ (when-let ((msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions
+ (erc--input-split-string state)
+ (erc--input-split-lines state))))
+ (unless (stringp msg)
+ (setq msg (format "Input error: %S" msg)))
+ (user-error msg)))
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
@@ -6170,12 +6188,15 @@ When the returned value is a string, pass it to
`erc-error'.")
(eolp))
(expand-abbrev))
(widen)
- (if-let* ((str (erc-user-input))
- (msg (run-hook-with-args-until-success
- 'erc--check-prompt-input-functions str
- (split-string str erc--input-line-delim-regexp))))
- (when (stringp msg)
- (erc-error msg))
+ (let* ((str (erc-user-input))
+ (state (make-erc--input-split
+ :string str
+ :insertp erc-insert-this
+ :sendp erc-send-this
+ :lines (split-string
+ str erc--input-line-delim-regexp)
+ :cmdp (string-match erc-command-regexp str))))
+ (run-hook-with-args 'erc--input-review-functions state)
(let ((inhibit-read-only t)
(old-buf (current-buffer)))
(progn ; unprogn this during next major surgery
@@ -6183,7 +6204,7 @@ When the returned value is a string, pass it to
`erc-error'.")
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
(unwind-protect
- (erc-send-input str 'skip-ws-chk)
+ (erc--send-input-lines (erc--run-send-hooks state))
;; Fix the buffer if the command didn't kill it
(when (buffer-live-p old-buf)
(with-current-buffer old-buf
@@ -6223,6 +6244,52 @@ an `erc--input-split' object."
(setf (erc--input-split-lines state)
(mapcan #'erc--split-line (erc--input-split-lines state)))))
+(defun erc--run-send-hooks (lines-obj)
+ "Run send-related hooks that operate on the entire prompt input.
+Sequester some of the back and forth involved in honoring old
+interfaces, such as the reconstituting and re-splitting of
+multiline input. Optionally readjust lines to protocol length
+limits and pad empty ones, knowing full well that additional
+processing may still corrupt messages before they reach the send
+queue. Expect LINES-OBJ to be an `erc--input-split' object."
+ (when (or erc-send-pre-hook erc-pre-send-functions)
+ (with-suppressed-warnings ((lexical str) (obsolete erc-send-this))
+ (defvar str) ; see note in string `erc-send-input'.
+ (let* ((str (string-join (erc--input-split-lines lines-obj) "\n"))
+ (erc-send-this (erc--input-split-sendp lines-obj))
+ (erc-insert-this (erc--input-split-insertp lines-obj))
+ (state (progn
+ ;; This may change `str' and `erc-*-this'.
+ (run-hook-with-args 'erc-send-pre-hook str)
+ (make-erc-input :string str
+ :insertp erc-insert-this
+ :sendp erc-send-this))))
+ (run-hook-with-args 'erc-pre-send-functions state)
+ (setf (erc--input-split-sendp lines-obj) (erc-input-sendp state)
+ (erc--input-split-insertp lines-obj) (erc-input-insertp state)
+ ;; See note in test of same name re trailing newlines.
+ (erc--input-split-lines lines-obj)
+ (cl-nsubst " " "" (split-string (erc-input-string state)
+ erc--input-line-delim-regexp)
+ :test #'equal))
+ (when (erc-input-refoldp state)
+ (erc--split-lines lines-obj)))))
+ (when (and (erc--input-split-cmdp lines-obj)
+ (cdr (erc--input-split-lines lines-obj)))
+ (user-error "Multiline command detected" ))
+ lines-obj)
+
+(defun erc--send-input-lines (lines-obj)
+ "Send lines in `erc--input-split-lines' object LINES-OBJ."
+ (when (erc--input-split-sendp lines-obj)
+ (dolist (line (erc--input-split-lines lines-obj))
+ (unless (erc--input-split-cmdp lines-obj)
+ (when (erc--input-split-insertp lines-obj)
+ (erc-display-msg line)))
+ (erc-process-input-line (concat line "\n")
+ (null erc-flood-protect)
+ (not (erc--input-split-cmdp lines-obj))))))
+
(defun erc-send-input (input &optional skip-ws-chk)
"Treat INPUT as typed in by the user.
It is assumed that the input and the prompt is already deleted.
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b6702617aeb..be5a566a268 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -942,8 +942,8 @@
(should-not (local-variable-if-set-p 'erc-send-completed-hook))
(set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
;; Just in case erc-ring-mode is already on
- (setq-local erc-pre-send-functions nil)
- (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
+ (setq-local erc--input-review-functions nil)
+ (add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
;;
(cl-letf (((symbol-function 'erc-process-input-line)
(lambda (&rest _)
@@ -1156,7 +1156,9 @@
(defun erc-tests--with-process-input-spy (test)
(with-current-buffer (get-buffer-create "FakeNet")
- (let* ((erc-pre-send-functions
+ (let* ((erc--input-review-functions
+ (remove #'erc-add-to-input-ring erc--input-review-functions))
+ (erc-pre-send-functions
(remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now
(inhibit-message noninteractive)
(erc-server-current-nick "tester")
@@ -1314,13 +1316,14 @@
(ert-info ("With `erc-inhibit-multiline-input' as t (2)")
(let ((erc-inhibit-multiline-input t))
(should-not (erc--check-prompt-input-for-excess-lines "" '("a")))
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "")))
+ ;; Does not trim trailing blanks.
+ (should (erc--check-prompt-input-for-excess-lines "" '("a" "")))
(should (erc--check-prompt-input-for-excess-lines "" '("a" "b")))))
(ert-info ("With `erc-inhibit-multiline-input' as 3")
(let ((erc-inhibit-multiline-input 3))
(should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))
- (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b" "")))
+ (should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "")))
(should (erc--check-prompt-input-for-excess-lines "" '("a" "b" "c")))))
(ert-info ("With `erc-ask-about-multiline-input'")
@@ -1399,6 +1402,94 @@
(should-not calls))))))
+
+;; The behavior of `erc-pre-send-functions' differs between versions
+;; in how hook members see and influence a trailing newline that's
+;; part of the original prompt submission:
+;;
+;; 5.4: both seen and sent
+;; 5.5: seen but not sent*
+;; 5.6: neither seen nor sent*
+;;
+;; * requires `erc-send-whitespace-lines' for hook to run
+;;
+;; Two aspects that have remained consistent are
+;;
+;; - a final nonempty line in any submission is always sent
+;; - a trailing newline appended by a hook member is always sent
+;;
+;; The last bullet would seem to contradict the "not sent" behavior of
+;; 5.5 and 5.6, but what's actually happening is that exactly one
+;; trailing newline is culled, so anything added always goes through.
+;; Also, in ERC 5.6, all empty lines are actually padded, but this is
+;; merely incidental WRT the above.
+;;
+;; Note that this test doesn't run any input-prep hooks and thus can't
+;; account for the "seen" dimension noted above.
+
+(ert-deftest erc--run-send-hooks ()
+ (with-suppressed-warnings ((obsolete erc-send-this)
+ (obsolete erc-send-pre-hook))
+ (should erc-insert-this)
+ (should erc-send-this) ; populates `erc--input-split-sendp'
+
+ (let (erc-pre-send-functions erc-send-pre-hook)
+
+ (ert-info ("String preserved, lines rewritten, empties padded")
+ (setq erc-pre-send-functions
+ (lambda (o) (setf (erc-input-string o) "bar\n\nbaz\n")))
+ (should (pcase (erc--run-send-hooks (make-erc--input-split
+ :string "foo" :lines '("foo")))
+ ((cl-struct erc--input-split
+ (string "foo") (sendp 't) (insertp 't)
+ (lines '("bar" " " "baz" " ")) (cmdp 'nil))
+ t))))
+
+ (ert-info ("Multiline commands rejected")
+ (should-error (erc--run-send-hooks (make-erc--input-split
+ :string "/mycmd foo"
+ :lines '("/mycmd foo")
+ :cmdp t))))
+
+ (ert-info ("Single-line commands pass")
+ (setq erc-pre-send-functions
+ (lambda (o) (setf (erc-input-sendp o) nil
+ (erc-input-string o) "/mycmd bar")))
+ (should (pcase (erc--run-send-hooks (make-erc--input-split
+ :string "/mycmd foo"
+ :lines '("/mycmd foo")
+ :cmdp t))
+ ((cl-struct erc--input-split
+ (string "/mycmd foo") (sendp 'nil) (insertp 't)
+ (lines '("/mycmd bar")) (cmdp 't))
+ t))))
+
+ (ert-info ("Legacy hook respected, special vars confined")
+ (setq erc-send-pre-hook (lambda (_) (setq erc-send-this nil))
+ erc-pre-send-functions (lambda (o) ; propagates
+ (should-not (erc-input-sendp o))))
+ (should (pcase (erc--run-send-hooks (make-erc--input-split
+ :string "foo" :lines '("foo")))
+ ((cl-struct erc--input-split
+ (string "foo") (sendp 'nil) (insertp 't)
+ (lines '("foo")) (cmdp 'nil))
+ t)))
+ (should erc-send-this))
+
+ (ert-info ("Request to resplit honored")
+ (setq erc-send-pre-hook nil
+ erc-pre-send-functions
+ (lambda (o) (setf (erc-input-string o) "foo bar baz"
+ (erc-input-refoldp o) t)))
+ (let ((erc-split-line-length 8))
+ (should
+ (pcase (erc--run-send-hooks (make-erc--input-split
+ :string "foo" :lines '("foo")))
+ ((cl-struct erc--input-split
+ (string "foo") (sendp 't) (insertp 't)
+ (lines '("foo bar " "baz")) (cmdp 'nil))
+ t))))))))
+
;; Note: if adding an erc-backend-tests.el, please relocate this there.
(ert-deftest erc-message ()
- master updated (1ef219e220c -> ba44b481844), F. Jason Park, 2023/05/05
- master c9f1ad2a870 01/14: Revive option erc-query-on-unjoined-chan-privmsg, F. Jason Park, 2023/05/05
- master 8654cea5843 02/14: Move ERC's buffer-display tests to separate file, F. Jason Park, 2023/05/05
- master 5de90fa9611 03/14: Extend erc-interactive-display to cover /JOINs, F. Jason Park, 2023/05/05
- master 9e1a5a389ed 04/14: Ignore erc-reconnect-display after a timeout, F. Jason Park, 2023/05/05
- master 90a9c7b7b59 05/14: Actually define erc-default-server-functions, F. Jason Park, 2023/05/05
- master b0d761be0f9 08/14: Restore module var toggles in ERC's Custom buffers, F. Jason Park, 2023/05/05
- master 2e18ba6302f 07/14: Simplify erc-button movement commands, F. Jason Park, 2023/05/05
- master 2641dfd4b43 06/14: Add erc-timestamp property to invisible messages, F. Jason Park, 2023/05/05
- master 16306567706 09/14: Don't send multiline commands as messages in ERC, F. Jason Park, 2023/05/05
- master 35dd1ade7f1 11/14: Preprocess prompt input linewise in ERC,
F. Jason Park <=
- master ba44b481844 14/14: Add interface for finding users in erc-server-PRIVMSG, F. Jason Park, 2023/05/05
- master 3a5a6fce957 10/14: Redo line splitting for outgoing messages in ERC, F. Jason Park, 2023/05/05
- master 5adda2f4683 12/14: Revise FORM-as-function interface in erc-button-alist, F. Jason Park, 2023/05/05
- master d141f7149b6 13/14: Improve erc-button--modify-nick-function interface, F. Jason Park, 2023/05/05