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)
This commit is contained in:
F. Jason Park
parent
3a5a6fce95
commit
35dd1ade7f
6 changed files with 217 additions and 46 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
string insertp sendp refoldp)
|
||||
|
||||
(cl-defstruct (erc--input-split (:include erc-input))
|
||||
lines cmdp)
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
135
lisp/erc/erc.el
135
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.
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue