>From 8a921612bdafdc5720fe12b49d215c1a42f9c0d0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 21 Mar 2022 05:40:16 -0700 Subject: [PATCH 2/2] 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 | 103 ++++++++++++++----- test/lisp/erc/erc-tests.el | 200 +++++++++++++++++++++++++++++++++++-- 2 files changed, 273 insertions(+), 30 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d8ef62cf93..cbb30bab5b 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. @@ -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,66 @@ 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 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." + (catch 'return + (let ((lines (split-string string erc--input-line-delim-regexp)) + (cmdp '--?--)) + (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))) + (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'." + :group 'erc + :version "29.1" + :type 'hook) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -5565,20 +5625,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 +5653,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 +5671,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 +5718,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 10e3c16dfc..6a9d291f8a 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -197,14 +197,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) @@ -285,6 +281,198 @@ 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 (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 "a\n\nb")) ; "" allowed + (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--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)) + +(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 + (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)))) + +(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))) + +;; 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)))) + +(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))))) ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1