From: F. Jason Park Date: Sun, 30 Apr 2023 14:12:56 +0000 (-0700) Subject: Preprocess prompt input linewise in ERC X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=35dd1ade7f1e583f736e6f707343402fe868daec;p=emacs.git 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) --- 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 ()