Re: bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v3. Except for a subtle change involving compatibility, there aren't any real differences in behavior. "J.P." <[email protected]> writes: > 4. Should slash commands, like /MSG be allowed to lead a multiline > submission? > > This patch says no, still choosing to interpret commands as always > consisting of a single line. This description is rather sloppy and ambiguous, so I have attempted to clarify things below (underscores are spaces). The subtle compat change happens between the first two examples. Basically, when the option `erc-send-whitespace-lines' is active and trailing blank lines are present, the new (v3) iteration of this patch no longer interprets slash commands but instead just sends lines as text. This more closely mirrors traditional ERC behavior. (I suppose we could also have an option to go the other, v2 route, if people want.) Patch v2 (previous) ~~~~~~~~~~~~~~~~~~~ - `erc-send-whitespace-lines' ON - All trailing blanks stripped - Command interpreted - Nothing inserted (unless echo-message cap negotiated, coming in #49860) input: . ERC> /msg #chan hi . . [RET] I/O: -> PRIVMSG #chan :hi shown: (nothing) Patch v3 (this) ~~~~~~~~~~~~~~~ - `erc-send-whitespace-lines' ON - Trailing blanks stripped - Command not interpreted input: . ERC> /msg #chan hi . . [RET] I/O: -> PRIVMSG #chan :/msg #chan hi shown: <me> /msg #chan hi The rest are just included for good measure, but none has changed: HEAD ~~~~ - `erc-send-whitespace-lines' ON or OFF - Trailing blanks not stripped or padded - Command not interpreted - Protocol violation (my fault from #50008, not in 5.4.1 or 28) input: . ERC> /msg #chan hi . [RET] I/O: -> PRIVMSG #chan :/msg #chan hi -> PRIVMSG #chan : <- :irc.foonet.org 412 me :No text to send shown: . <me> /msg #chan hi . <me> . *** No text to send Patch v2 and v3 ~~~~~~~~~~~~~~~ - `erc-send-whitespace-lines' OFF - ding, input remains, echo area says "Blank line - ignoring ..." input: . ERC> /msg #chan hi . _* [RET] I/O: (nothing) shown: (nothing) All (HEAD, v2, v3) ~~~~~~~~~~~~~~~~~~ - `erc-send-whitespace-lines' ON (or OFF when old) - Command not interpreted - User-padded trailing blank preserved input: . ERC > /msg #chan hi . _ [RET] I/O: -> PRIVMSG #chan :/msg #chan hi -> PRIVMSG #chan :_ shown: <me> /msg #chan hi <me> - `erc-send-whitespace-lines' ON (or OFF when old) - Command not interpreted - Intervening blank padded input: . ERC> /msg #chan hi . . again [RET] I/O: -> PRIVMSG #chan :/msg #chan hi -> PRIVMSG #chan :_ -> PRIVMSG #chan :again shown: <me> /msg #chan hi <me> <me> again
0000-v2-v3.diff
(text/x-patch, 17.3 KB)
From b58ad0d7c08d0002276f261d508cfca4056cc9ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 22 Apr 2022 17:35:46 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): Fix regression in erc-send-input-line Add some ERC test helpers Improve ERC's handling of multiline prompt input [SQUASH-ME] Add hook for splitting multiline input in ERC lisp/erc/erc.el | 160 +++++++++++++++++++------- test/lisp/erc/erc-tests.el | 229 +++++++++++++++++++++++++++++++++++-- 2 files changed, 337 insertions(+), 52 deletions(-) Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ab786c1989..e2fe5c6476 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1040,7 +1040,7 @@ erc-send-pre-hook :type 'hook) (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") -(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls) +(defcustom erc-pre-send-functions nil "Special hook run to possibly alter the string that is sent. The functions are called with one argument, an `erc-input' struct, and should alter that struct. @@ -1052,7 +1052,26 @@ erc-pre-send-functions `sendp': Whether the string should be sent to the irc server." :group 'erc :type 'hook - :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA + :version "27.1") + +(defcustom erc-pre-send-split-functions '(erc-discard-trailing-multiline-nulls) + "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. + +The struct has five slots: + + `string': The input string delivered by `erc-pre-send-functions'. + `insertp': Whether the lines should be inserted into the ERC buffer. + `sendp': Whether the lines should be sent to the IRC server. + `lines': A list of lines to be sent, each one a `string'. + `cmdp': Whether to interpret the 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." + :group 'erc + :type 'hook + :package-version '(ERC . "5.4.1")) (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -5556,22 +5575,15 @@ erc--input-line-delim-regexp (defun erc--blank-in-multiline-input-p (string) "Detect whether STRING contains any blank lines. -When `erc-send-whitespace-lines' is in effect and the input is not a -\"command\", like /msg, return nil if the input is multiline or the 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." +When `erc-send-whitespace-lines' is in effect, return nil if the input +is multiline or the 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 ((lines (split-string string erc--input-line-delim-regexp)) - (cmdp '--?--)) + (let ((lines (split-string string erc--input-line-delim-regexp))) (dolist (line lines) (when (if erc-send-whitespace-lines - (and (string= line "") - (or (null (cdr lines)) ; string is one line - (if (eq cmdp '--?--) ; string is /cmd - (setq cmdp (string-match erc-command-regexp - (car lines))) - cmdp))) + (and (string= line "") (null (cdr lines))) (string-match (rx bot (* (in " \t\f")) eot) line)) (throw 'return t)))))) @@ -5579,8 +5591,13 @@ erc-discard-trailing-multiline-nulls "Ensure last line of `erc-input' STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil." (when erc-send-whitespace-lines - (cl-callf (lambda (s) (string-trim-right s "[\r\n]+")) - (erc-input-string state)))) + (when (string-match "[\r\n]+\\'" (erc-input-string state)) + (setf (erc-input-split-lines state) + (split-string (substring (erc-input-string state) + 0 + (match-beginning 0)) + erc--input-line-delim-regexp) + (erc-input-split-cmdp state) nil)))) (defun erc-check-prompt-input-for-multiline-blanks (string) "Return non-nil when multiline prompt input has blank lines." @@ -5671,6 +5688,9 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) +(cl-defstruct (erc-input-split (:include erc-input)) + lines cmdp) + (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. @@ -5700,26 +5720,27 @@ erc-send-input :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) + (setq state (make-erc-input-split + :string (erc-input-string state) + :insertp (erc-input-insertp state) + :sendp (erc-input-sendp state) + :lines (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp + (erc-input-string state)))) + (run-hook-with-args 'erc-pre-send-split-functions state) (when (and (erc-input-sendp state) - erc-send-this) - (let ((string (erc-input-string state))) - (if (or (if (>= emacs-major-version 28) - (string-search "\n" string) - (string-match "\n" string)) - (not (string-match erc-command-regexp string))) - (mapc - (lambda (line) - (mapc - (lambda (line) - ;; Insert what has to be inserted for this. - (when (erc-input-insertp state) - (erc-display-msg line)) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) t)) - (or (and erc-flood-protect (erc-split-line line)) - (list line)))) - (split-string string erc--input-line-delim-regexp)) - (erc-process-input-line (concat string "\n") t nil)) + erc-send-this) + (let ((lines (erc-input-split-lines state))) + (if (and (erc-input-split-cmdp state) (not (cdr lines))) + (erc-process-input-line (concat (car lines) "\n") t nil) + (dolist (line lines) + (dolist (line (or (and erc-flood-protect (erc-split-line line)) + (list line))) + (when (erc-input-insertp state) + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)))) t))))) ;; (defun erc-display-command (line) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 53461accbc..3746f4862e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -330,9 +330,9 @@ erc--blank-in-multiline-input-p (ert-info ("With `erc-send-whitespace-lines'") (let ((erc-send-whitespace-lines t)) (should (erc--blank-in-multiline-input-p "")) - (should (erc--blank-in-multiline-input-p "/msg a\n")) ; likely oops - (should (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; "" not allowed + (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed + (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd (should-not (erc--blank-in-multiline-input-p " ")) (should-not (erc--blank-in-multiline-input-p "\t")) (should-not (erc--blank-in-multiline-input-p "a\nb")) @@ -358,121 +358,140 @@ erc--blank-in-multiline-input-p (should-not (erc--blank-in-multiline-input-p "a\nb")) (should-not (erc--blank-in-multiline-input-p "a\r\nb"))) -(defmacro erc-tests--with-process-input-spy (calls-var &rest body) - (declare (indent 1)) - `(with-current-buffer (get-buffer-create "FakeNet") - (let ((erc-pre-send-functions +(defun erc-tests--with-process-input-spy (test) + (with-current-buffer (get-buffer-create "FakeNet") + (let* ((erc-pre-send-functions (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now (inhibit-message noninteractive) (erc-server-current-nick "tester") (erc-last-input-time 0) erc-accidental-paste-threshold-seconds - ,calls-var) - (cl-letf (((symbol-function 'erc-process-input-line) - (lambda (&rest r) (push r ,calls-var))) - ((symbol-function 'erc-server-buffer) - (lambda () (current-buffer)))) - (erc-tests--send-prep) - ,@body)) - (when noninteractive (kill-buffer)))) + ;; + calls) + (cl-letf (((symbol-function 'erc-process-input-line) + (lambda (&rest r) (push r calls))) + ((symbol-function 'erc-server-buffer) + (lambda () (current-buffer)))) + (erc-tests--send-prep) + (funcall test (lambda () (pop calls))))) + (when noninteractive (kill-buffer)))) (ert-deftest erc-check-prompt-input-functions () - (erc-tests--with-process-input-spy calls - - (ert-info ("Errors when point not in prompt area") ; actually just dings - (insert "/msg #chan hi") - (forward-line -1) - (let ((e (should-error (erc-send-current-line)))) - (should (equal "Point is not in the input area" (cadr e)))) - (goto-char (point-max)) - (ert-info ("Input remains untouched") - (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) - - (ert-info ("Errors when no process running") - (let ((e (should-error (erc-send-current-line)))) - (should (equal "ERC: No process running" (cadr e)))) - (ert-info ("Input remains untouched") - (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) - - (ert-info ("Errors when line contains empty newline") - (erc-bol) - (delete-region (point) (point-max)) - (insert "one\n") - (let ((e (should-error (erc-send-current-line)))) - (should (equal "Blank line - ignoring..." (cadr e)))) - (goto-char (point-max)) - (ert-info ("Input remains untouched") - (should (save-excursion (goto-char erc-input-marker) - (looking-at "one\n"))))) - - (should (= 0 erc-last-input-time)) - (should-not calls))) + (erc-tests--with-process-input-spy + (lambda (next) + + (ert-info ("Errors when point not in prompt area") ; actually just dings + (insert "/msg #chan hi") + (forward-line -1) + (let ((e (should-error (erc-send-current-line)))) + (should (equal "Point is not in the input area" (cadr e)))) + (goto-char (point-max)) + (ert-info ("Input remains untouched") + (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) + + (ert-info ("Errors when no process running") + (let ((e (should-error (erc-send-current-line)))) + (should (equal "ERC: No process running" (cadr e)))) + (ert-info ("Input remains untouched") + (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) + + (ert-info ("Errors when line contains empty newline") + (erc-bol) + (delete-region (point) (point-max)) + (insert "one\n") + (let ((e (should-error (erc-send-current-line)))) + (should (equal "Blank line - ignoring..." (cadr e)))) + (goto-char (point-max)) + (ert-info ("Input remains untouched") + (should (save-excursion (goto-char erc-input-marker) + (looking-at "one\n"))))) + + (should (= 0 erc-last-input-time)) + (should-not (funcall next))))) ;; These also indirectly tests `erc-send-input' (ert-deftest erc-send-current-line () - (erc-tests--with-process-input-spy calls - - (erc-tests--set-fake-server-process "sleep" "1") - (should (= 0 erc-last-input-time)) - - (ert-info ("Simple command") - (insert "/msg #chan hi") - (erc-send-current-line) - (ert-info ("Prompt restored") - (forward-line 0) - (should (looking-at-p erc-prompt))) - (ert-info ("Input cleared") - (erc-bol) - (should (eq (point) (point-max)))) - ;; Commands are forced (no flood protection) - (should (equal (pop calls) '("/msg #chan hi\n" t nil)))) - - (ert-info ("Simple non-command") - (insert "hi") - (erc-send-current-line) - (should (eq (point) (point-max))) - (should (save-excursion (forward-line -1) - (search-forward "<tester> hi"))) - ;; Non-ommands are forced only when `erc-flood-protect' is nil - (should (equal (pop calls) '("hi\n" nil t)))) - - (should (consp erc-last-input-time)))) + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (should (= 0 erc-last-input-time)) + + (ert-info ("Simple command") + (insert "/msg #chan hi") + (erc-send-current-line) + (ert-info ("Prompt restored") + (forward-line 0) + (should (looking-at-p erc-prompt))) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + ;; Commands are forced (no flood protection) + (should (equal (funcall next) '("/msg #chan hi\n" t nil)))) + + (ert-info ("Simple non-command") + (insert "hi") + (erc-send-current-line) + (should (eq (point) (point-max))) + (should (save-excursion (forward-line -1) + (search-forward "<tester> hi"))) + ;; Non-ommands are forced only when `erc-flood-protect' is nil + (should (equal (funcall next) '("hi\n" nil t)))) + + (should (consp erc-last-input-time))))) (ert-deftest erc-send-whitespace-lines () - (erc-tests--with-process-input-spy calls - - (erc-tests--set-fake-server-process "sleep" "1") - (setq-local erc-send-whitespace-lines t) - - (ert-info ("Multiline hunk with blank line correctly split") - (insert "one\n\ntwo") - (erc-send-current-line) - (ert-info ("Prompt restored") - (forward-line 0) - (should (looking-at-p erc-prompt))) - (ert-info ("Input cleared") - (erc-bol) - (should (eq (point) (point-max)))) - (should (equal (pop calls) '("two\n" nil t))) - (should (equal (pop calls) '("\n" nil t))) - (should (equal (pop calls) '("one\n" nil t)))) - - (ert-info ("Multiline hunk with trailing blank filtered") - (insert "hi\n") - (erc-send-current-line) - (ert-info ("Input cleared") - (erc-bol) - (should (eq (point) (point-max)))) - (should (equal (pop calls) '("hi\n" nil t))) - (should-not (pop calls))) - - (ert-info ("Multiline hunk with trailing whitespace not filtered") - (insert "there\n ") - (erc-send-current-line) - (should (equal (pop calls) '(" \n" nil t))) - (should (equal (pop calls) '("there\n" nil t))) - (should-not (pop calls))))) + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (setq-local erc-send-whitespace-lines t) + + (ert-info ("Multiline hunk with blank line correctly split") + (insert "one\n\ntwo") + (erc-send-current-line) + (ert-info ("Prompt restored") + (forward-line 0) + (should (looking-at-p erc-prompt))) + (ert-info ("Input cleared") + (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) '("one\n" nil t)))) + + (ert-info ("Multiline hunk with trailing newline filtered") + (insert "hi\n") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline hunk with trailing carriage filtered") + (insert "hi\r") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline command with trailing blank filtered") + (insert "/msg #chan hi\r") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("/msg #chan hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline hunk with trailing whitespace not filtered") + (insert "there\n ") + (erc-send-current-line) + (should (equal (funcall next) '(" \n" nil t))) + (should (equal (funcall next) '("there\n" nil t))) + (should-not (funcall next)))))) ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1
0001-Fix-regression-in-erc-send-input-line.patch
(text/x-patch, 2.4 KB)
From aa381598d4ab452bf1a40269cd7c728e3c113a1b Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 21 Mar 2022 19:21:57 -0700 Subject: [PATCH 1/4] Fix regression in erc-send-input-line * lisp/erc/erc.el (erc-send-input-line): Restore remedial single-space padding to ensure empty messages typed at the prompt without an explicit /msg aren't rejected by the server. This behavior is only noticeable when `erc-send-whitespace-lines' is active. * test/lisp/erc/erc-tests.el (erc-process-input-line): Add trailing newline to more correctly simulate how it's actually called by `erc-send-input'. (Bug#50008) --- lisp/erc/erc.el | 2 ++ test/lisp/erc/erc-tests.el | 10 +++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 52fe106f2d..d8ef62cf93 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2817,6 +2817,8 @@ erc-send-input-line-function (defun erc-send-input-line (target line &optional force) "Send LINE to TARGET." + (when (string= line "\n") + (setq line " \n")) (erc-message "PRIVMSG" (concat target " " line) force)) (defun erc-get-arglist (fun) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 520f10dd4e..10e3c16dfc 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -340,19 +340,19 @@ erc-process-input-line (ert-info ("Implicit cmd via `erc-send-input-line-function'") (ert-info ("Baseline") - (erc-process-input-line "hi") + (erc-process-input-line "hi\n") (should (equal (pop erc-server-flood-queue) '("PRIVMSG #chan :hi\r\n" . utf-8)))) (ert-info ("Spaces preserved") - (erc-process-input-line "hi you") + (erc-process-input-line "hi you\n") (should (equal (pop erc-server-flood-queue) '("PRIVMSG #chan :hi you\r\n" . utf-8)))) - (ert-info ("Empty line transmitted without injected-space kludge") - (erc-process-input-line "") + (ert-info ("Empty line transmitted with injected-space kludge") + (erc-process-input-line "\n") (should (equal (pop erc-server-flood-queue) - '("PRIVMSG #chan :\r\n" . utf-8)))) + '("PRIVMSG #chan : \r\n" . utf-8)))) (should-not calls)))))) -- 2.35.1
0002-Add-some-ERC-test-helpers.patch
(text/x-patch, 2.1 KB)
From 914a58579c6efcdc6746763e382004b1f4e2a2fb Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Tue, 5 Apr 2022 17:45:00 -0700 Subject: [PATCH 2/4] Add some ERC test helpers * test/lisp/erc/erc-tests.el (erc-tests--test-prep, erc-tests--set-fake-server-process): Factor out some common buffer-prep boilerplate involving user input and the server process. Shared with bug#54536. --- test/lisp/erc/erc-tests.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 10e3c16dfc..c9254e6d42 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -114,6 +114,20 @@ erc-with-all-buffers-of-server (should (get-buffer "#spam")) (kill-buffer "#spam"))) +(defun erc-tests--send-prep () + (erc-mode) + (insert "\n\n") + (setq erc-input-marker (make-marker) + erc-insert-marker (make-marker)) + (set-marker erc-insert-marker (point-max)) + (erc-display-prompt) + (should (= (point) erc-input-marker))) + +(defun erc-tests--set-fake-server-process (&rest args) + (setq erc-server-process + (apply #'start-process (car args) (current-buffer) args)) + (set-process-query-on-exit-flag erc-server-process nil)) + (ert-deftest erc--switch-to-buffer () (defvar erc-modified-channels-alist) ; lisp/erc/erc-track.el @@ -197,14 +211,10 @@ erc-ring-previous-command-base-case (ert-deftest erc-ring-previous-command () (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) - (insert "\n\n") + (erc-tests--send-prep) + (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) - (setq erc-input-marker (make-marker) - erc-insert-marker (make-marker)) - (set-marker erc-insert-marker (point-max)) - (erc-display-prompt) - (should (= (point) erc-input-marker)) ;; 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) -- 2.35.1
0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch
(text/x-patch, 17.3 KB)
From 6f084d00e7776527b58bf9ed3c4356b85c1dadd7 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Mon, 21 Mar 2022 05:40:16 -0700 Subject: [PATCH 3/4] Improve ERC's handling of multiline prompt input * lisp/erc/erc.el (erc-pre-send-functions, erc-discard-trailing-multiline-nulls): Add the latter, a new function, that drops any trailing null lines from a multiline sequence submitted for processing. Add it to `erc-pre-send-functions' as the lone new default. (erc-last-input-time): Tweak meaning of variable to match likely original intent, which is that it's only updated on successful calls to `erc-send-current-line'. (erc--input-line-delim-regexp): Add regex var for splitting multiline prompt input. (erc--blank-in-multiline-p): Add helper for detecting blank lines. (erc-check-prompt-input-for-multiline-blanks, erc-check-prompt-input-for-point-in-bounds, erc-check-prompt-input-for-running-process): New functions to encapsulate logic for various pre-flight idiot checks. (erc-check-prompt-input-functions): Add new hook for validating prompt input prior to clearing it. (erc-send-current-line): pre-screen for blank lines and bail out if necessary. (erc-send-input): Add optional param to skip checking for blank lines. * test/lisp/erc/erc-tests.el (erc-ring-previous-command): Use new test helper. (erc--input-line-delim-regexp, erc--blank-in-multiline-input-p): Add tests. (erc-tests--send-prep, erc-tests--set-fake-server-process, erc-tests--with-process-input-spy): Add test helpers. (erc-check-prompt-input-functions, erc-send-current-line, erc-send-whitespace-lines): Add tests. --- lisp/erc/erc.el | 98 +++++++++++++----- test/lisp/erc/erc-tests.el | 197 +++++++++++++++++++++++++++++++++++++ 2 files changed, 270 insertions(+), 25 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d8ef62cf93..f3685dd2a7 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1040,7 +1040,7 @@ erc-send-pre-hook :type 'hook) (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") -(defcustom erc-pre-send-functions nil +(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls) "Special hook run to possibly alter the string that is sent. The functions are called with one argument, an `erc-input' struct, and should alter that struct. @@ -1052,7 +1052,7 @@ erc-pre-send-functions `sendp': Whether the string should be sent to the irc server." :group 'erc :type 'hook - :version "27.1") + :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -5536,7 +5536,7 @@ erc-end-of-input-line (point-max)) (defvar erc-last-input-time 0 - "Time of last call to `erc-send-current-line'. + "Time of last successful call to `erc-send-current-line'. If that function has never been called, the value is 0.") (defcustom erc-accidental-paste-threshold-seconds 0.2 @@ -5552,6 +5552,59 @@ erc-accidental-paste-threshold-seconds :version "26.1" :type '(choice number (other :tag "disabled" nil))) +(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r))) + +(defun erc--blank-in-multiline-input-p (string) + "Detect whether STRING contains any blank lines. +When `erc-send-whitespace-lines' is in effect, return nil if the input +is multiline or the 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 ((lines (split-string string erc--input-line-delim-regexp))) + (dolist (line lines) + (when (if erc-send-whitespace-lines + (and (string= line "") (null (cdr lines))) + (string-match (rx bot (* (in " \t\f")) eot) line)) + (throw 'return t)))))) + +(defun erc-discard-trailing-multiline-nulls (state) + "Ensure last line of `erc-input' STATE's string is non-null. +But only when `erc-send-whitespace-lines' is non-nil." + (when erc-send-whitespace-lines + (cl-callf (lambda (s) (string-trim-right s "[\r\n]+")) + (erc-input-string state)))) + +(defun erc-check-prompt-input-for-multiline-blanks (string) + "Return non-nil when multiline prompt input has blank lines." + (when (erc--blank-in-multiline-input-p string) + (if erc-warn-about-blank-lines + "Blank line - ignoring..." + '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)) + "Point is not in the input area")) + +(defun erc-check-prompt-input-for-running-process (string) + "Return non-nil unless in an active ERC server buffer." + (unless (or (erc-server-buffer-live-p) + (erc-command-no-process-p string)) + "ERC: No process running")) + +(defcustom erc-check-prompt-input-functions + '(erc-check-prompt-input-for-point-in-bounds + erc-check-prompt-input-for-multiline-blanks + erc-check-prompt-input-for-running-process) + "Validators for user input typed at prompt. +Called with latest input string submitted by user. If any member +returns non-nil, processing is abandoned and input is left untouched. +When the returned value is a string, pass it to `erc-error'." + :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA + :group 'erc + :type 'hook) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -5565,20 +5618,20 @@ erc-send-current-line (eolp)) (expand-abbrev)) (widen) - (if (< (point) (erc-beg-of-input-line)) - (erc-error "Point is not in the input area") + (if-let* ((str (erc-user-input)) + (msg (run-hook-with-args-until-success + 'erc-check-prompt-input-functions str))) + (when (stringp msg) + (erc-error msg)) (let ((inhibit-read-only t) - (str (erc-user-input)) (old-buf (current-buffer))) - (if (and (not (erc-server-buffer-live-p)) - (not (erc-command-no-process-p str))) - (erc-error "ERC: No process running") + (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt (delete-region (erc-beg-of-input-line) (erc-end-of-input-line)) (unwind-protect - (erc-send-input str) + (erc-send-input str 'skip-ws-chk) ;; Fix the buffer if the command didn't kill it (when (buffer-live-p old-buf) (with-current-buffer old-buf @@ -5593,8 +5646,8 @@ erc-send-current-line (set-buffer-modified-p buffer-modified)))))) ;; Only when last hook has been run... - (run-hook-with-args 'erc-send-completed-hook str)))) - (setq erc-last-input-time now)) + (run-hook-with-args 'erc-send-completed-hook str))) + (setq erc-last-input-time now))) (switch-to-buffer "*ERC Accidental Paste Overflow*") (lwarn 'erc :warning "You seem to have accidentally pasted some text!")))) @@ -5611,21 +5664,16 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) -(defun erc-send-input (input) +(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. Return non-nil only if we actually send anything." ;; Handle different kinds of inputs - (cond - ;; Ignore empty input - ((if erc-send-whitespace-lines - (string= input "") - (string-match "\\`[ \t\r\f\n]*\\'" input)) - (when erc-warn-about-blank-lines - (message "Blank line - ignoring...") - (beep)) - nil) - (t + (if (and (not skip-ws-chk) + (erc-check-prompt-input-for-multiline-blanks input)) + (when erc-warn-about-blank-lines + (message "Blank line - ignoring...") ; compat + (beep)) ;; This dynamic variable is used by `erc-send-pre-hook'. It's ;; obsolete, and when it's finally removed, this binding should ;; also be removed. @@ -5663,9 +5711,9 @@ erc-send-input (null erc-flood-protect) t)) (or (and erc-flood-protect (erc-split-line line)) (list line)))) - (split-string string "\n")) + (split-string string erc--input-line-delim-regexp)) (erc-process-input-line (concat string "\n") t nil)) - t)))))) + t))))) ;; (defun erc-display-command (line) ;; (when erc-insert-this diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c9254e6d42..3746f4862e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -295,6 +295,203 @@ erc-log-irc-protocol (kill-buffer "*erc-protocol*") (should-not erc-debug-irc-protocol))) +(ert-deftest erc--input-line-delim-regexp () + (let ((p erc--input-line-delim-regexp)) + ;; none + (should (equal '("a" "b") (split-string "a\r\nb" p))) + (should (equal '("a" "b") (split-string "a\nb" p))) + (should (equal '("a" "b") (split-string "a\rb" p))) + + ;; one + (should (equal '("") (split-string "" p))) + (should (equal '("a" "" "b") (split-string "a\r\rb" p))) + (should (equal '("a" "" "b") (split-string "a\n\rb" p))) + (should (equal '("a" "" "b") (split-string "a\n\nb" p))) + (should (equal '("a" "" "b") (split-string "a\r\r\nb" p))) + (should (equal '("a" "" "b") (split-string "a\n\r\nb" p))) + (should (equal '("a" "") (split-string "a\n" p))) + (should (equal '("a" "") (split-string "a\r" p))) + (should (equal '("a" "") (split-string "a\r\n" p))) + (should (equal '("" "b") (split-string "\nb" p))) + (should (equal '("" "b") (split-string "\rb" p))) + (should (equal '("" "b") (split-string "\r\nb" p))) + + ;; two + (should (equal '("" "") (split-string "\r" p))) + (should (equal '("" "") (split-string "\n" p))) + (should (equal '("" "") (split-string "\r\n" p))) + + ;; three + (should (equal '("" "" "") (split-string "\r\r" p))) + (should (equal '("" "" "") (split-string "\n\n" p))) + (should (equal '("" "" "") (split-string "\n\r" p))))) + +(ert-deftest erc--blank-in-multiline-input-p () + (ert-info ("With `erc-send-whitespace-lines'") + (let ((erc-send-whitespace-lines t)) + (should (erc--blank-in-multiline-input-p "")) + (should-not (erc--blank-in-multiline-input-p "/msg a\n")) ; real /cmd + (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed + (should-not (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; non-/cmd + (should-not (erc--blank-in-multiline-input-p " ")) + (should-not (erc--blank-in-multiline-input-p "\t")) + (should-not (erc--blank-in-multiline-input-p "a\nb")) + (should-not (erc--blank-in-multiline-input-p "a\n ")) + (should-not (erc--blank-in-multiline-input-p "a\n \t")) + (should-not (erc--blank-in-multiline-input-p "a\n \f")) + (should-not (erc--blank-in-multiline-input-p "a\n \nb")) + (should-not (erc--blank-in-multiline-input-p "a\n \t\nb")) + (should-not (erc--blank-in-multiline-input-p "a\n \f\nb")))) + + (should (erc--blank-in-multiline-input-p "")) + (should (erc--blank-in-multiline-input-p " ")) + (should (erc--blank-in-multiline-input-p "\t")) + (should (erc--blank-in-multiline-input-p "a\n\nb")) + (should (erc--blank-in-multiline-input-p "a\n\nb")) + (should (erc--blank-in-multiline-input-p "a\n ")) + (should (erc--blank-in-multiline-input-p "a\n \t")) + (should (erc--blank-in-multiline-input-p "a\n \f")) + (should (erc--blank-in-multiline-input-p "a\n \nb")) + (should (erc--blank-in-multiline-input-p "a\n \t\nb")) + + (should-not (erc--blank-in-multiline-input-p "a\rb")) + (should-not (erc--blank-in-multiline-input-p "a\nb")) + (should-not (erc--blank-in-multiline-input-p "a\r\nb"))) + +(defun erc-tests--with-process-input-spy (test) + (with-current-buffer (get-buffer-create "FakeNet") + (let* ((erc-pre-send-functions + (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now + (inhibit-message noninteractive) + (erc-server-current-nick "tester") + (erc-last-input-time 0) + erc-accidental-paste-threshold-seconds + ;; + calls) + (cl-letf (((symbol-function 'erc-process-input-line) + (lambda (&rest r) (push r calls))) + ((symbol-function 'erc-server-buffer) + (lambda () (current-buffer)))) + (erc-tests--send-prep) + (funcall test (lambda () (pop calls))))) + (when noninteractive (kill-buffer)))) + +(ert-deftest erc-check-prompt-input-functions () + (erc-tests--with-process-input-spy + (lambda (next) + + (ert-info ("Errors when point not in prompt area") ; actually just dings + (insert "/msg #chan hi") + (forward-line -1) + (let ((e (should-error (erc-send-current-line)))) + (should (equal "Point is not in the input area" (cadr e)))) + (goto-char (point-max)) + (ert-info ("Input remains untouched") + (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) + + (ert-info ("Errors when no process running") + (let ((e (should-error (erc-send-current-line)))) + (should (equal "ERC: No process running" (cadr e)))) + (ert-info ("Input remains untouched") + (should (save-excursion (erc-bol) (looking-at "/msg #chan hi"))))) + + (ert-info ("Errors when line contains empty newline") + (erc-bol) + (delete-region (point) (point-max)) + (insert "one\n") + (let ((e (should-error (erc-send-current-line)))) + (should (equal "Blank line - ignoring..." (cadr e)))) + (goto-char (point-max)) + (ert-info ("Input remains untouched") + (should (save-excursion (goto-char erc-input-marker) + (looking-at "one\n"))))) + + (should (= 0 erc-last-input-time)) + (should-not (funcall next))))) + +;; These also indirectly tests `erc-send-input' + +(ert-deftest erc-send-current-line () + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (should (= 0 erc-last-input-time)) + + (ert-info ("Simple command") + (insert "/msg #chan hi") + (erc-send-current-line) + (ert-info ("Prompt restored") + (forward-line 0) + (should (looking-at-p erc-prompt))) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + ;; Commands are forced (no flood protection) + (should (equal (funcall next) '("/msg #chan hi\n" t nil)))) + + (ert-info ("Simple non-command") + (insert "hi") + (erc-send-current-line) + (should (eq (point) (point-max))) + (should (save-excursion (forward-line -1) + (search-forward "<tester> hi"))) + ;; Non-ommands are forced only when `erc-flood-protect' is nil + (should (equal (funcall next) '("hi\n" nil t)))) + + (should (consp erc-last-input-time))))) + +(ert-deftest erc-send-whitespace-lines () + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (setq-local erc-send-whitespace-lines t) + + (ert-info ("Multiline hunk with blank line correctly split") + (insert "one\n\ntwo") + (erc-send-current-line) + (ert-info ("Prompt restored") + (forward-line 0) + (should (looking-at-p erc-prompt))) + (ert-info ("Input cleared") + (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) '("one\n" nil t)))) + + (ert-info ("Multiline hunk with trailing newline filtered") + (insert "hi\n") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline hunk with trailing carriage filtered") + (insert "hi\r") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline command with trailing blank filtered") + (insert "/msg #chan hi\r") + (erc-send-current-line) + (ert-info ("Input cleared") + (erc-bol) + (should (eq (point) (point-max)))) + (should (equal (funcall next) '("/msg #chan hi\n" nil t))) + (should-not (funcall next))) + + (ert-info ("Multiline hunk with trailing whitespace not filtered") + (insert "there\n ") + (erc-send-current-line) + (should (equal (funcall next) '(" \n" nil t))) + (should (equal (funcall next) '("there\n" nil t))) + (should-not (funcall next)))))) ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1
0004-SQUASH-ME-Add-hook-for-splitting-multiline-input-in-.patch
(text/x-patch, 5.7 KB)
From b58ad0d7c08d0002276f261d508cfca4056cc9ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Fri, 22 Apr 2022 03:56:25 -0700 Subject: [PATCH 4/4] [SQUASH-ME] Add hook for splitting multiline input in ERC * lisp/erc/erc.el (erc-pre-send-split-functions): Add new hook allowing members to revise individual lines before sending. (erc-discard-trailing-multiline-nulls): Conditionally truncate list of lines to be sent, skipping trailing blanks. (erc-input-split): Add new struct containing split input line. (erc-send-input): Call hook `erc-pre-send-split-functions'. --- lisp/erc/erc.el | 74 ++++++++++++++++++++++++++++++++++--------------- 1 file changed, 51 insertions(+), 23 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f3685dd2a7..e2fe5c6476 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1040,7 +1040,7 @@ erc-send-pre-hook :type 'hook) (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") -(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls) +(defcustom erc-pre-send-functions nil "Special hook run to possibly alter the string that is sent. The functions are called with one argument, an `erc-input' struct, and should alter that struct. @@ -1052,7 +1052,26 @@ erc-pre-send-functions `sendp': Whether the string should be sent to the irc server." :group 'erc :type 'hook - :package-version '(ERC . "5.4.1")) ; FIXME increment upon publishing to ELPA + :version "27.1") + +(defcustom erc-pre-send-split-functions '(erc-discard-trailing-multiline-nulls) + "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. + +The struct has five slots: + + `string': The input string delivered by `erc-pre-send-functions'. + `insertp': Whether the lines should be inserted into the ERC buffer. + `sendp': Whether the lines should be sent to the IRC server. + `lines': A list of lines to be sent, each one a `string'. + `cmdp': Whether to interpret the 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." + :group 'erc + :type 'hook + :package-version '(ERC . "5.4.1")) (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -5572,8 +5591,13 @@ erc-discard-trailing-multiline-nulls "Ensure last line of `erc-input' STATE's string is non-null. But only when `erc-send-whitespace-lines' is non-nil." (when erc-send-whitespace-lines - (cl-callf (lambda (s) (string-trim-right s "[\r\n]+")) - (erc-input-string state)))) + (when (string-match "[\r\n]+\\'" (erc-input-string state)) + (setf (erc-input-split-lines state) + (split-string (substring (erc-input-string state) + 0 + (match-beginning 0)) + erc--input-line-delim-regexp) + (erc-input-split-cmdp state) nil)))) (defun erc-check-prompt-input-for-multiline-blanks (string) "Return non-nil when multiline prompt input has blank lines." @@ -5664,6 +5688,9 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) +(cl-defstruct (erc-input-split (:include erc-input)) + lines cmdp) + (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. @@ -5693,26 +5720,27 @@ erc-send-input :insertp erc-insert-this :sendp erc-send-this)) (run-hook-with-args 'erc-pre-send-functions state) + (setq state (make-erc-input-split + :string (erc-input-string state) + :insertp (erc-input-insertp state) + :sendp (erc-input-sendp state) + :lines (split-string (erc-input-string state) + erc--input-line-delim-regexp) + :cmdp (string-match erc-command-regexp + (erc-input-string state)))) + (run-hook-with-args 'erc-pre-send-split-functions state) (when (and (erc-input-sendp state) - erc-send-this) - (let ((string (erc-input-string state))) - (if (or (if (>= emacs-major-version 28) - (string-search "\n" string) - (string-match "\n" string)) - (not (string-match erc-command-regexp string))) - (mapc - (lambda (line) - (mapc - (lambda (line) - ;; Insert what has to be inserted for this. - (when (erc-input-insertp state) - (erc-display-msg line)) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) t)) - (or (and erc-flood-protect (erc-split-line line)) - (list line)))) - (split-string string erc--input-line-delim-regexp)) - (erc-process-input-line (concat string "\n") t nil)) + erc-send-this) + (let ((lines (erc-input-split-lines state))) + (if (and (erc-input-split-cmdp state) (not (cdr lines))) + (erc-process-input-line (concat (car lines) "\n") t nil) + (dolist (line lines) + (dolist (line (or (and erc-flood-protect (erc-split-line line)) + (list line))) + (when (erc-input-insertp state) + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)))) t))))) ;; (defun erc-display-command (line) -- 2.35.1