From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs,gmane.emacs.erc.general Subject: bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input Date: Fri, 29 Apr 2022 06:05:26 -0700 Message-ID: <87bkwk2g6h.fsf@neverwas.me> References: <87k0ckg5pn.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="31374"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: emacs-erc@gnu.org To: 54536@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Apr 29 15:06:44 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nkQKZ-0007on-3g for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 29 Apr 2022 15:06:43 +0200 Original-Received: from localhost ([::1]:59626 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nkQKX-0007tV-LC for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 29 Apr 2022 09:06:41 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:40764) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nkQJv-0007q3-13 for bug-gnu-emacs@gnu.org; Fri, 29 Apr 2022 09:06:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:57311) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nkQJu-0000gi-JV for bug-gnu-emacs@gnu.org; Fri, 29 Apr 2022 09:06:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nkQJu-0000j1-EG for bug-gnu-emacs@gnu.org; Fri, 29 Apr 2022 09:06:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 29 Apr 2022 13:06:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54536 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 54536-submit@debbugs.gnu.org id=B54536.16512375422758 (code B ref 54536); Fri, 29 Apr 2022 13:06:02 +0000 Original-Received: (at 54536) by debbugs.gnu.org; 29 Apr 2022 13:05:42 +0000 Original-Received: from localhost ([127.0.0.1]:51208 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nkQJX-0000iO-O5 for submit@debbugs.gnu.org; Fri, 29 Apr 2022 09:05:42 -0400 Original-Received: from mail-108-mta173.mxroute.com ([136.175.108.173]:36263) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nkQJT-0000i6-OJ for 54536@debbugs.gnu.org; Fri, 29 Apr 2022 09:05:38 -0400 Original-Received: from filter006.mxroute.com ([140.82.40.27] 140.82.40.27.vultrusercontent.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta173.mxroute.com (ZoneMTA) with ESMTPSA id 180756d291b000fe85.001 for <54536@debbugs.gnu.org> (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Fri, 29 Apr 2022 13:05:29 +0000 X-Zone-Loop: 24c3a5babbcb6f265efacedbacbbeafb7c8e60a56999 X-Originating-IP: [140.82.40.27] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:In-Reply-To:Date:References: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=f6zD8XfzRuaNEyme0QlZf039wB4DFtaXK7CT4tGNW9E=; b=jZe2XKva9Gel2rB37pFUh8bRiC 6kOc+0fYwicsTvKX0NQ5nLL1bBfSyrpy6TL+rx1kLf2MASkOyat6xnaGwRm4wwMpeur/mK1pZrfiY 8TX5pWndZFpkx2o2SpK7TGisLCslIYJ1+lW2Osq1Gl09KynY5mB+Z1FifUCfueaBxk7ODWhtux940 wydc0l3yObt1JKg0XL8RfzQr7JLer5XQptWALvs0CVACNruvwbXrmEX1Kzf7QGndinwOMDrRx5F2h ZylI5R5G7danrbtwcvLdP4zCNtnH3Srb8ANRuvKvtKw+nROiFkyxKLcYu/toaYUOK6dOIeQcn2lwp yx+1+/zQ==; In-Reply-To: <87k0ckg5pn.fsf@neverwas.me> (J. P.'s message of "Wed, 23 Mar 2022 06:26:44 -0700") X-AuthUser: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:230956 gmane.emacs.erc.general:1829 Archived-At: --=-=-= Content-Type: text/plain v4. I've decided it's probably better to abstain from exporting the input validation hooks or their members without good reason. Likewise for the hook involving split-lines and command-detection. So they've all been renamed as internal, for now. This version also brings with it some out-of-scope feature creep in response to recent clamoring for a way to prevent all multiline input. I've therefore added two options and wired them into the pre-send validation mechanism introduced earlier in this series. The first is called `erc-inhibit-multiline-input', which must be either a positive integer or t. As an int, it indicates the maximum number of lines allowed to be submitted for sending (above which a beep and a scolding result). The second is called `erc-ask-about-multiline-input'. When non-nil, instead of getting scolded, the user is asked whether to go ahead and send anyway (just this once). A few (arguably surprising) idiosyncrasies surround the interaction between `erc-send-whitespace-lines' and these newly proposed options, but nothing too radical or inconsistent (IMO). For example, during the reckoning of `erc-inhibit-multiline-input', trailing blanks are always trimmed, but when `erc-send-whitespace-lines' is nil, this becomes irrelevant because the send is preempted beforehand, which is in line with the behavior described in the initial bug report. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v3-v4.diff >From bb190883389de0bdcdfa39bfdbb5d8953bf115fd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 27 Apr 2022 04:33:06 -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 Optionally prevent sending multiline input in ERC lisp/erc/erc.el | 195 ++++++++++++++++++++++------ test/lisp/erc/erc-tests.el | 259 +++++++++++++++++++++++++++++++++++-- 2 files changed, 402 insertions(+), 52 deletions(-) Interdiff: diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 472c103ee4..8e96dd30c4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -224,6 +224,20 @@ erc-send-whitespace-lines :group 'erc :type 'boolean) +(defcustom erc-inhibit-multiline-input nil + "Conditionally disallow input consisting of multiple lines. +Issue an error when the number of input lines submitted for sending +exceeds this value." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type '(choice integer boolean)) + +(defcustom erc-ask-about-multiline-input nil + "Ask to ignore `erc-inhibit-multiline-input' when tripped." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type 'boolean) + (defcustom erc-hide-prompt nil "If non-nil, do not display the prompt for commands. @@ -1054,10 +1068,16 @@ erc-pre-send-functions :type 'hook :version "27.1") -(defcustom erc-pre-send-split-functions '(erc-discard-trailing-multiline-nulls) +;; This is being auditioned for possible exporting (as a custom +;; 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. + +(defvar 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 functions are called with one argument, an `erc--input-split' +struct, which they can optionally modify. The struct has five slots: @@ -1068,10 +1088,7 @@ erc-pre-send-split-functions `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")) +all but the first line will be discarded.") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -5573,61 +5590,77 @@ erc-accidental-paste-threshold-seconds (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 +(defun erc--blank-in-multiline-input-p (lines) + "Detect whether LINES contains a blank line. +When `erc-send-whitespace-lines' is in effect, return nil if LINES is +multiline or the first 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))) + (let ((multilinep (cdr lines))) (dolist (line lines) (when (if erc-send-whitespace-lines - (and (string= line "") (null (cdr lines))) + (and (string-empty-p line) (not multilinep)) (string-match (rx bot (* (in " \t\f")) eot) line)) (throw 'return t)))))) -(defun erc-discard-trailing-multiline-nulls (state) +(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 (when (string-match "[\r\n]+\\'" (erc-input-string state)) - (setf (erc-input-split-lines 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." - (when (erc--blank-in-multiline-input-p string) + (erc--input-split-cmdp state) nil)))) + +(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) + 2 + erc-inhibit-multiline-input)) + (seen 0) + msg) + (while (and (pop reversed) (< (cl-incf seen) max))) + (when (= seen max) + (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (unless (and erc-ask-about-multiline-input + (y-or-n-p (concat "Send input " msg "?"))) + (concat "Too many lines " msg)))))) + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES." + (when (erc--blank-in-multiline-input-p lines) (if erc-warn-about-blank-lines "Blank line - ignoring..." 'invalid))) -(defun erc-check-prompt-input-for-point-in-bounds (_) +(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) +(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) +(defvar 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 + erc--check-prompt-input-for-excess-lines) "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) +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'.") (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -5644,7 +5677,8 @@ erc-send-current-line (widen) (if-let* ((str (erc-user-input)) (msg (run-hook-with-args-until-success - 'erc-check-prompt-input-functions str))) + 'erc--check-prompt-input-functions str + (split-string str erc--input-line-delim-regexp)))) (when (stringp msg) (erc-error msg)) (let ((inhibit-read-only t) @@ -5688,7 +5722,7 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) -(cl-defstruct (erc-input-split (:include erc-input)) +(cl-defstruct (erc--input-split (:include erc-input)) lines cmdp) (defun erc-send-input (input &optional skip-ws-chk) @@ -5697,7 +5731,8 @@ erc-send-input Return non-nil only if we actually send anything." ;; Handle different kinds of inputs (if (and (not skip-ws-chk) - (erc-check-prompt-input-for-multiline-blanks input)) + (erc--check-prompt-input-for-multiline-blanks + input (split-string input erc--input-line-delim-regexp))) (when erc-warn-about-blank-lines (message "Blank line - ignoring...") ; compat (beep)) @@ -5720,7 +5755,7 @@ 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 + (setq state (make-erc--input-split :string (erc-input-string state) :insertp (erc-input-insertp state) :sendp (erc-input-sendp state) @@ -5728,11 +5763,11 @@ erc-send-input 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) + (run-hook-with-args 'erc--pre-send-split-functions state) (when (and (erc-input-sendp state) erc-send-this) - (let ((lines (erc-input-split-lines state))) - (if (and (erc-input-split-cmdp state) (not (cdr lines))) + (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)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 3746f4862e..fa39f4fcc6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -327,36 +327,41 @@ erc--input-line-delim-regexp (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"))) + (let ((check (lambda (s) + (erc--blank-in-multiline-input-p + (split-string s erc--input-line-delim-regexp))))) + + (ert-info ("With `erc-send-whitespace-lines'") + (let ((erc-send-whitespace-lines t)) + (should (funcall check "")) + (should-not (funcall check "\na")) + (should-not (funcall check "/msg a\n")) ; real /cmd + (should-not (funcall check "a\n\nb")) ; "" allowed + (should-not (funcall check "/msg a\n\nb")) ; non-/cmd + (should-not (funcall check " ")) + (should-not (funcall check "\t")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "a\n ")) + (should-not (funcall check "a\n \t")) + (should-not (funcall check "a\n \f")) + (should-not (funcall check "a\n \nb")) + (should-not (funcall check "a\n \t\nb")) + (should-not (funcall check "a\n \f\nb")))) + + (should (funcall check "")) + (should (funcall check " ")) + (should (funcall check "\t")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n ")) + (should (funcall check "a\n \t")) + (should (funcall check "a\n \f")) + (should (funcall check "a\n \nb")) + (should (funcall check "a\n \t\nb")) + + (should-not (funcall check "a\rb")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "a\r\nb")))) (defun erc-tests--with-process-input-spy (test) (with-current-buffer (get-buffer-create "FakeNet") @@ -376,7 +381,7 @@ erc-tests--with-process-input-spy (funcall test (lambda () (pop calls))))) (when noninteractive (kill-buffer)))) -(ert-deftest erc-check-prompt-input-functions () +(ert-deftest erc--check-prompt-input-functions () (erc-tests--with-process-input-spy (lambda (next) @@ -493,6 +498,31 @@ erc-send-whitespace-lines (should (equal (funcall next) '("there\n" nil t))) (should-not (funcall next)))))) +(ert-deftest erc--check-prompt-input-for-excess-lines () + (ert-info ("Without `erc-inhibit-multiline-input'") + (should-not erc-inhibit-multiline-input) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))) + + (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" ""))) + (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" "c"))))) + + (ert-info ("With `erc-ask-about-multiline-input'") + (let ((erc-inhibit-multiline-input t) + (erc-ask-about-multiline-input t)) + (ert-simulate-keys '(?n ?\r ?y ?\r) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) + (should-not erc-ask-about-multiline-input))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Fix-regression-in-erc-send-input-line.patch >From bdfb502f7f0e6b1fbc0ea8cfb0336757bf813ab5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 06381c5ebe..29a465a759 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Add-some-ERC-test-helpers.patch >From 97f18350d52791c57e325e828997e4440119b7ff Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-Improve-ERC-s-handling-of-multiline-prompt-input.patch >From 0898d4eb0b37e3faae8cd8c37c756a2cfde1873d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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-split-functions): Add new internal hook allowing members to revise individual lines before sending. This was created with an eye toward possibly exporting it publicly as a customizable option. (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--discard-trailing-multiline-nulls): Conditionally truncate list of lines to be sent, skipping trailing blanks. This constitutes a behavioral change, but considering the nature of the bug being fixed, is thought to be justified. (erc--input-split): Add new internal struct containing split input lines and flag for command detection. (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. Keep it internal for now. (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. Call hook `erc--pre-send-split-functions'. * 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. (Bug#54536) --- lisp/erc/erc.el | 161 +++++++++++++++++++++-------- test/lisp/erc/erc-tests.el | 202 +++++++++++++++++++++++++++++++++++++ 2 files changed, 322 insertions(+), 41 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 29a465a759..d4ca8665a4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1054,6 +1054,28 @@ erc-pre-send-functions :type 'hook :version "27.1") +;; This is being auditioned for possible exporting (as a custom +;; 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. + +(defvar 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.") + (defvar erc-insert-this t "Insert the text into the target buffer or not. Functions on `erc-insert-pre-hook' can set this variable to nil @@ -5536,7 +5558,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 +5574,62 @@ 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 (lines) + "Detect whether LINES contains a blank line. +When `erc-send-whitespace-lines' is in effect, return nil if LINES is +multiline or the first 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 ((multilinep (cdr lines))) + (dolist (line lines) + (when (if erc-send-whitespace-lines + (and (string-empty-p line) (not multilinep)) + (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 + (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 (_ lines) + "Return non-nil when multiline prompt input has blank LINES." + (when (erc--blank-in-multiline-input-p lines) + (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")) + +(defvar 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 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'.") + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -5565,20 +5643,21 @@ 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 + (split-string str erc--input-line-delim-regexp)))) + (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 +5672,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 +5690,20 @@ erc-command-regexp (cl-defstruct erc-input string insertp sendp) -(defun erc-send-input (input) +(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. 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 (split-string input erc--input-line-delim-regexp))) + (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. @@ -5645,27 +5723,28 @@ 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 "\n")) - (erc-process-input-line (concat string "\n") t nil)) - t)))))) + 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) ;; (when erc-insert-this diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c9254e6d42..c076503933 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -295,6 +295,208 @@ 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 () + (let ((check (lambda (s) + (erc--blank-in-multiline-input-p + (split-string s erc--input-line-delim-regexp))))) + + (ert-info ("With `erc-send-whitespace-lines'") + (let ((erc-send-whitespace-lines t)) + (should (funcall check "")) + (should-not (funcall check "\na")) + (should-not (funcall check "/msg a\n")) ; real /cmd + (should-not (funcall check "a\n\nb")) ; "" allowed + (should-not (funcall check "/msg a\n\nb")) ; non-/cmd + (should-not (funcall check " ")) + (should-not (funcall check "\t")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "a\n ")) + (should-not (funcall check "a\n \t")) + (should-not (funcall check "a\n \f")) + (should-not (funcall check "a\n \nb")) + (should-not (funcall check "a\n \t\nb")) + (should-not (funcall check "a\n \f\nb")))) + + (should (funcall check "")) + (should (funcall check " ")) + (should (funcall check "\t")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n\nb")) + (should (funcall check "a\n ")) + (should (funcall check "a\n \t")) + (should (funcall check "a\n \f")) + (should (funcall check "a\n \nb")) + (should (funcall check "a\n \t\nb")) + + (should-not (funcall check "a\rb")) + (should-not (funcall check "a\nb")) + (should-not (funcall check "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 " 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Optionally-prevent-sending-multiline-input-in-ERC.patch >From cb445bf2b95737df7fdcb47be3e9937c983cd705 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 27 Apr 2022 02:27:32 -0700 Subject: [PATCH 4/4] Optionally prevent sending multiline input in ERC * lisp/erc/erc.el (erc-inhibit-multiline-input): Add option to cap the number of lines to be sent before admonishing the user. (erc-ask-about-multiline-input): Add option to ask instead of warning user when `erc-inhibit-multiline-input' is reached. (erc--check-prompt-input-for-excess-lines): Add validator to check to possibly warn when too many lines are submitted for transmission. * test/lisp/erc/erc-tests.el (erc--check-prompt-input-for-excess-lines): Add test. (Bug#54536) --- lisp/erc/erc.el | 34 +++++++++++++++++++++++++++++++++- test/lisp/erc/erc-tests.el | 25 +++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d4ca8665a4..8e96dd30c4 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -224,6 +224,20 @@ erc-send-whitespace-lines :group 'erc :type 'boolean) +(defcustom erc-inhibit-multiline-input nil + "Conditionally disallow input consisting of multiple lines. +Issue an error when the number of input lines submitted for sending +exceeds this value." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type '(choice integer boolean)) + +(defcustom erc-ask-about-multiline-input nil + "Ask to ignore `erc-inhibit-multiline-input' when tripped." + :package-version '(ERC . "5.4.1") ; FIXME match to next release + :group 'erc + :type 'boolean) + (defcustom erc-hide-prompt nil "If non-nil, do not display the prompt for commands. @@ -5602,6 +5616,23 @@ erc--discard-trailing-multiline-nulls erc--input-line-delim-regexp) (erc--input-split-cmdp state) nil)))) +(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) + 2 + erc-inhibit-multiline-input)) + (seen 0) + msg) + (while (and (pop reversed) (< (cl-incf seen) max))) + (when (= seen max) + (setq msg (format "(exceeded by %d)" (1+ (length reversed)))) + (unless (and erc-ask-about-multiline-input + (y-or-n-p (concat "Send input " msg "?"))) + (concat "Too many lines " msg)))))) + (defun erc--check-prompt-input-for-multiline-blanks (_ lines) "Return non-nil when multiline prompt input has blank LINES." (when (erc--blank-in-multiline-input-p lines) @@ -5623,7 +5654,8 @@ erc--check-prompt-input-for-running-process (defvar 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) + erc--check-prompt-input-for-running-process + erc--check-prompt-input-for-excess-lines) "Validators for user input typed at prompt. Called with latest input string submitted by user and the list of lines produced by splitting it. If any member function returns non-nil, diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c076503933..fa39f4fcc6 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -498,6 +498,31 @@ erc-send-whitespace-lines (should (equal (funcall next) '("there\n" nil t))) (should-not (funcall next)))))) +(ert-deftest erc--check-prompt-input-for-excess-lines () + (ert-info ("Without `erc-inhibit-multiline-input'") + (should-not erc-inhibit-multiline-input) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b")))) + + (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" ""))) + (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" "c"))))) + + (ert-info ("With `erc-ask-about-multiline-input'") + (let ((erc-inhibit-multiline-input t) + (erc-ask-about-multiline-input t)) + (ert-simulate-keys '(?n ?\r ?y ?\r) + (should (erc--check-prompt-input-for-excess-lines "" '("a" "b"))) + (should-not (erc--check-prompt-input-for-excess-lines "" '("a" "b"))))) + (should-not erc-ask-about-multiline-input))) + ;; The point of this test is to ensure output is handled identically ;; regardless of whether a command handler is summoned. -- 2.35.1 --=-=-=--