emacs-diffs
[Top][All Lists]
Advanced

[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 ()



reply via email to

[Prev in Thread] Current Thread [Next in Thread]