>From b58ad0d7c08d0002276f261d508cfca4056cc9ac Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 " 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 " 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