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 Subject: bug#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt Date: Fri, 22 Sep 2023 07:20:50 -0700 Message-ID: <871qeq47ct.fsf__21650.7327555277$1695392553$gmane$org@neverwas.me> References: <87fs3bh835.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="31050"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: emacs-erc@gnu.org To: 66073@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Sep 22 16:22:25 2023 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 1qjh32-0007qD-QB for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 22 Sep 2023 16:22:25 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qjh2d-0000Ah-QA; Fri, 22 Sep 2023 10:21:59 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qjh2c-0008Su-1g for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 10:21:58 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qjh2V-0002gA-K2 for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 10:21:56 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qjh2f-0002Qy-TO for bug-gnu-emacs@gnu.org; Fri, 22 Sep 2023 10:22:01 -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, 22 Sep 2023 14:22:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 66073 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 66073-submit@debbugs.gnu.org id=B66073.16953924789307 (code B ref 66073); Fri, 22 Sep 2023 14:22:01 +0000 Original-Received: (at 66073) by debbugs.gnu.org; 22 Sep 2023 14:21:18 +0000 Original-Received: from localhost ([127.0.0.1]:37044 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qjh1v-0002Q0-9v for submit@debbugs.gnu.org; Fri, 22 Sep 2023 10:21:17 -0400 Original-Received: from mail-108-mta45.mxroute.com ([136.175.108.45]:40357) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qjh1q-0002PZ-1h for 66073@debbugs.gnu.org; Fri, 22 Sep 2023 10:21:13 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta45.mxroute.com (ZoneMTA) with ESMTPSA id 18abd43dbba000d7b6.001 for <66073@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Fri, 22 Sep 2023 14:20:55 +0000 X-Zone-Loop: 21bc4527eaba34908362ad2098b25a4c2ccd2c0f6ad0 X-Originating-IP: [136.175.111.2] 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:Date:References:In-Reply-To: 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=/PgN4ShbHJQv6PEzTyUWQZYizWV2IC1zEeuYVh4huOc=; b=Q7kRznNDQMVVf2UK5fKA9DhC+s 3JC2PH/BEcko0infOU7kb4ydNq692Z5GZBo9FqCz9Scb6qr1+I2mcNzYF+0YRdz1tJxts1B1lcgua 99rqr0BSJ3sAyCRHHOvUHhqsRbsPL8c89XBwDkKrG+uyq1u4PJTTeWONOc1f+9JufU/ARKunk47ip AORi9yEvBAppptXwjjXkBfr4v1EYnLWaU17jSHS2CNj68OLwutKojJkLJndEZbwGtti/rVzItKdfX AfVRPo0sNmG0SL1Trtl3LDkXgPY0muzPIRGqV2yfHl51Ow/hNU3i1z4AAcNPXqihBqi2akJaOaFDB CNIPVlXQ==; In-Reply-To: <87fs3bh835.fsf@neverwas.me> (J. P.'s message of "Mon, 18 Sep 2023 07:25:18 -0700") X-Authenticated-Id: 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-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:271102 Archived-At: --=-=-= Content-Type: text/plain v2. Fix faulty interaction with `erc-inhibit-multiline-input'. Move slash-command detection to input-review hook. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v1-v2.diff >From eeedb524c2686245da10aa827a6a9bfcbc54d046 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 22 Sep 2023 07:15:18 -0700 Subject: [PATCH 0/4] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (4): ; Increase ERC test server queue size Exempt text-scale-mode from erc-scrolltobottom-all [5.6] Improve erc-warn-about-blank-lines behavior Detect slash commands in erc--input-review-functions etc/ERC-NEWS | 8 +- lisp/erc/erc-common.el | 1 + lisp/erc/erc-goodies.el | 8 +- lisp/erc/erc.el | 166 ++++++++++----- test/lisp/erc/erc-scenarios-scrolltobottom.el | 4 +- test/lisp/erc/erc-tests.el | 189 +++++++++++++----- test/lisp/erc/resources/erc-d/erc-d.el | 50 ++--- .../erc/resources/erc-scenarios-common.el | 3 +- 8 files changed, 301 insertions(+), 128 deletions(-) Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 05e933930e2..fadd97b65df 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -221,6 +221,12 @@ atop any message. The new companion option 'erc-echo-timestamp-zone' determines the default timezone when not specified with a prefix argument. +** Option 'erc-warn-about-blank-lines' is more informative. +Enabled by default, this option now produces more useful feedback +whenever ERC rejects prompt input containing whitespace-only lines. +When paired with option 'erc-send-whitespace-lines', ERC echoes a +tally of blank lines padded and trailing blanks culled. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -281,7 +287,7 @@ For starters, the 'cursor-sensor-functions' property no longer contains unique closures and thus no longer proves effective for traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Also -affecting the `stamp' module is the deprecation of the function +affecting the 'stamp' module is the deprecation of the function 'erc-insert-aligned' and its removal from client code. Additionally, the module now merges its 'invisible' property with existing ones and includes all white space around stamps when doing so. diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6eb015fdd64..431264ec8b4 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -128,6 +128,11 @@ erc--scrolltobottom-post-force-commands That is, ERC recalculates the window's start instead of blindly restoring it.") +;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed' +;; is enabled (scaling up still moves the prompt). +(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust) + "Commands to skip instead of force-scroll on `post-command-hook'.") + (defvar erc--scrolltobottom-relaxed-skip-commands '(recenter-top-bottom scroll-down-command) "Commands exempt from triggering a stash and restore of `window-start'. @@ -158,7 +163,8 @@ erc--scrolltobottom-on-post-command ((= (nth 2 found) (count-screen-lines (window-start) (point-max))))) (set-window-start (selected-window) (nth 1 found)) - (erc--scrolltobottom-confirm)) + (unless (memq this-command erc--scrolltobottom-post-ignore-commands) + (erc--scrolltobottom-confirm))) (setq erc--scrolltobottom-window-info nil))) (defun erc--scrolltobottom-on-pre-command-relaxed () diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 7165f38189e..b9ce6b8e53a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -268,8 +268,8 @@ erc-send-whitespace-lines (defcustom erc-inhibit-multiline-input nil "When non-nil, conditionally disallow input consisting of multiple lines. Issue an error when the number of input lines submitted for -sending exceeds this value. The value t means disallow more -than 1 line of input." +sending meets or exceeds this value. The value t is synonymous +with a value of 2 and means disallow more than 1 line of input." :package-version '(ERC . "5.5") :group 'erc :type '(choice integer boolean)) @@ -1101,7 +1101,8 @@ 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") (defvar erc--input-review-functions '(erc--split-lines erc--run-input-validation-checks - erc--discard-trailing-multiline-nulls) + erc--discard-trailing-multiline-nulls + erc--inhibit-slash-cmd-insertion) "Special hook for reviewing and modifying prompt input. ERC runs this before clearing the prompt and before running any send-related hooks, such as `erc-pre-send-functions'. Thus, it's @@ -6476,6 +6477,9 @@ erc--count-blank-lines (setq pad 1)) (list total pad strip))) +(defvar erc--check-prompt-explanation nil + "List of strings to print if no validator returns non-nil.") + (defun erc--check-prompt-input-for-multiline-blanks (_ lines) "Return non-nil when multiline prompt input has blank LINES. Consider newlines to be intervening delimiters, meaning the @@ -6499,7 +6503,10 @@ erc--check-prompt-input-for-multiline-blanks (when msg (setf msg (nreverse msg) (car msg) (capitalize (car msg)))) - (and msg `(message ,(string-join msg " ") ,@(nreverse args))))) + (when msg + (push (apply #'format (string-join msg " ") (nreverse args)) + erc--check-prompt-explanation) + nil))) (erc-warn-about-blank-lines (concat (if (= total 1) (if (zerop strip) "Blank" "Trailing") @@ -6534,27 +6541,38 @@ erc--check-prompt-input-for-multiline-command (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds erc--check-prompt-input-for-something + erc--check-prompt-input-for-multiline-command erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process - erc--check-prompt-input-for-excess-lines - erc--check-prompt-input-for-multiline-command) + 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, processing is abandoned and input is left untouched. -When the returned value is a string, ERC passes it to `erc-error'.") +Called with two arguments: the current input submitted by the +user, as a string, along with the same input as a list of +strings. If any member function returns non-nil, ERC abandons +processing and leaves pending input untouched in the prompt area. +When the returned value is a string, ERC passes it to +`user-error'. Any other non-nil value tells ERC to abort +silently. If all members return nil, and the variable +`erc--check-prompt-explanation' is a nonempty list of strings, +ERC prints them as a single message joined by newlines.") (defun erc--run-input-validation-checks (state) "Run input checkers from STATE, an `erc--input-split' object." - (when-let ((msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions - (erc--input-split-string state) - (erc--input-split-lines state)))) - (cond ((eq (car-safe msg) 'message) - (apply 'message (cdr msg))) - ((stringp msg) - (user-error msg)) - (t (push msg (erc--input-split-abortp state)))))) + (let* ((erc--check-prompt-explanation nil) + (msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (cond ((stringp msg) (user-error msg)) + (msg (push msg (erc--input-split-abortp state))) + (erc--check-prompt-explanation + (message "%s" (string-join (nreverse erc--check-prompt-explanation) + "\n")))))) + +(defun erc--inhibit-slash-cmd-insertion (state) + "Don't insert STATE object's message if it's a \"slash\" command." + (when (erc--input-split-cmdp state) + (setf (erc--input-split-insertp state) nil))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6664,9 +6682,8 @@ erc--send-input-lines "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (dolist (line (erc--input-split-lines lines-obj)) - (unless (erc--input-split-cmdp lines-obj) - (when (erc--input-split-insertp lines-obj) - (erc-display-msg line))) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line)) (erc-process-input-line (concat line "\n") (null erc-flood-protect) (not (erc--input-split-cmdp lines-obj)))))) diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el index dd0a8612388..206687ccab5 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -35,7 +35,7 @@ erc-scenarios-scrolltobottom--normal (should-not erc-scrolltobottom-all) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion doesn't anchor prompt in other window") (let ((w (next-window))) @@ -52,7 +52,7 @@ erc-scenarios-scrolltobottom--all (let ((erc-scrolltobottom-all t)) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion anchors prompt in other window") (let ((w (next-window))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index bb7e3259608..8a68eca6196 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -292,7 +292,7 @@ erc--refresh-prompt (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook - erc--input-review-functions + (erc--input-review-functions erc--input-review-functions) erc-send-completed-hook) (ert-info ("Server buffer") @@ -357,6 +357,9 @@ erc--refresh-prompt (should (= (point) erc-input-marker)) (insert "/query bob") (erc-send-current-line) + ;; Last command not inserted + (save-excursion (forward-line -1) + (should (looking-at " Howdy"))) ;; Query does not redraw (nor /help, only message input) (should (looking-back "#chan@ServNet 11> ")) ;; No sign of old prompts @@ -877,11 +880,12 @@ erc-ring-previous-command (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) (erc-tests--send-prep) + (setq erc-server-current-nick "tester") (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) ;; Just in case erc-ring-mode is already on - (setq-local erc--input-review-functions nil) + (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) @@ -1256,8 +1260,9 @@ erc--check-prompt-input-for-multiline-blanks/explanations (("" "a" "" "b" "" "c" "" "") "Stripping (2) and padding (3) blank lines"))) (ert-info ((format "Input: %S, Msg: %S" input msg)) - (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input))) - (should (equal (apply #'format (cdr rv)) msg)))))) + (let (erc--check-prompt-explanation) + (should-not (erc--check-prompt-input-for-multiline-blanks nil input)) + (should (equal (list msg) erc--check-prompt-explanation)))))) (pcase-dolist (`(,input ,msg) '((("") "Blank line detected") @@ -1311,17 +1316,12 @@ erc-send-whitespace-lines (should-not (funcall next))) (ert-info ("Multiline command with trailing blank filtered") - (pcase-dolist (`(,p . ,q) - '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n") - ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n") - ("/a b\n\n\n" "/a b\n"))) + (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n")) (insert p) (erc-send-current-line) (erc-bol) (should (eq (point) (point-max))) - (while q - (should (pcase (funcall next) - (`(,cmd ,_ nil) (equal cmd (pop q)))))) + (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n")))) (should-not (funcall next)))) (ert-info ("Multiline command with non-blanks errors") diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index b86769220dd..f072c6b93b2 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -254,7 +254,7 @@ erc-d--initialize-client (ending (process-get process :dialog-ending)) (dialog (make-erc-d-dialog :name name :process process - :queue (make-ring 5) + :queue (make-ring 10) :exchanges (make-ring 10) :match-handlers mat-h :server-fqdn fqdn))) @@ -292,33 +292,27 @@ erc-d-load-replacement-dialog (defvar erc-d--m-debug (getenv "ERC_D_DEBUG")) -(defmacro erc-d--m (process format-string &rest args) - "Output ARGS using FORMAT-STRING somewhere depending on context. -PROCESS should be a client connection or a server network process." - `(let ((format-string (if erc-d--m-debug - (concat (format-time-string "%s.%N: ") - ,format-string) - ,format-string)) - (want-insert (and ,process erc-d--in-process)) - (buffer (process-buffer (process-get ,process :server)))) - (when (and want-insert (buffer-live-p buffer)) - (with-current-buffer buffer - (goto-char (point-max)) - (insert (concat (format ,format-string ,@args) "\n")))) - (when (or erc-d--m-debug (not want-insert)) - (message format-string ,@args)))) - -(defmacro erc-d--log (process string &optional outbound) - "Log STRING sent to (OUTBOUND) or received from PROCESS peer." - `(let ((id (or (process-get ,process :log-id) - (let ((port (erc-d-u--get-remote-port ,process))) - (process-put ,process :log-id port) - port))) - (name (erc-d-dialog-name (process-get ,process :dialog)))) - (if ,outbound - (erc-d--m process "-> %s:%s %s" name id ,string) - (dolist (line (split-string ,string (process-get process :ending))) - (erc-d--m process "<- %s:%s %s" name id line))))) +(defun erc-d--m (process format-string &rest args) + "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere." + (when erc-d--m-debug + (setq format-string (concat (format-time-string "%s.%N: ") format-string))) + (let ((insertp (and process erc-d--in-process)) + (buffer (process-buffer (process-get process :server)))) + (when (and insertp (buffer-live-p buffer)) + (princ (concat (apply #'format format-string args) "\n") buffer)) + (when (or erc-d--m-debug (not insertp)) + (apply #'message format-string args)))) + +(defun erc-d--log (process string &optional outbound) + "Log STRING received from or OUTBOUND to PROCESS peer." + (let ((id (or (process-get process :log-id) + (let ((port (erc-d-u--get-remote-port process))) + (process-put process :log-id port) port))) + (name (erc-d-dialog-name (process-get process :dialog)))) + (if outbound + (erc-d--m process "-> %s:%s %s" name id string) + (dolist (line (split-string string (process-get process :ending))) + (erc-d--m process "<- %s:%s %s" name id line))))) (defun erc-d--log-process-event (server process msg) (erc-d--m server "%s: %s" process (string-trim-right msg))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 19f26bf08bd..5354b300b47 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -341,7 +341,7 @@ erc-scenarios-common--recenter-top-bottom ;;;; Fixtures -(defun erc-scenarios-scrolltobottom--normal (test) +(defun erc-scenarios-common-scrolltobottom--normal (test) (erc-scenarios-common-with-noninteractive-in-term ((erc-scenarios-common-dialog "scrolltobottom") (dumb-server (erc-d-run "localhost" t 'help)) @@ -402,6 +402,7 @@ erc-scenarios-scrolltobottom--normal (erc-cmd-MSG "NickServ help register") (save-excursion (erc-d-t-search-for 10 "End of NickServ")) (should (= 1 (point))) + (redisplay) (should (zerop (count-screen-lines (window-start) (window-point)))) (should (erc-scenarios-common--prompt-past-win-end-p))) -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Increase-ERC-test-server-queue-size.patch >From 86ee2386d8474384e38c5023163098572f05d3fa Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 18 Sep 2023 22:50:28 -0700 Subject: [PATCH 1/4] ; Increase ERC test server queue size * test/lisp/erc/erc-scenarios-scrolltobottom.el (erc-scenarios-scrolltobottom--normal, erc-scenarios-scrolltobottom--all): Use update name for test fixture. * test/lisp/erc/resources/erc-d/erc-d.el (erc-d--initialize-client): For lengthy batches, `erc-d--filter' may run multiple times before `erc-d--on-request' can pull from the queue, which results in discarded incoming messages and match failures. (erc-d--m, erc-d--log): Convert to ordinary functions. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-scrolltobottom--normal, erc-scenarios-common-scrolltobottom--normal): Rename test fixture from former to latter and attempt to fix intermittent failure re `count-screen-lines'. --- test/lisp/erc/erc-scenarios-scrolltobottom.el | 4 +- test/lisp/erc/resources/erc-d/erc-d.el | 50 ++++++++----------- .../erc/resources/erc-scenarios-common.el | 3 +- 3 files changed, 26 insertions(+), 31 deletions(-) diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el index dd0a8612388..206687ccab5 100644 --- a/test/lisp/erc/erc-scenarios-scrolltobottom.el +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -35,7 +35,7 @@ erc-scenarios-scrolltobottom--normal (should-not erc-scrolltobottom-all) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion doesn't anchor prompt in other window") (let ((w (next-window))) @@ -52,7 +52,7 @@ erc-scenarios-scrolltobottom--all (let ((erc-scrolltobottom-all t)) - (erc-scenarios-scrolltobottom--normal + (erc-scenarios-common-scrolltobottom--normal (lambda () (ert-info ("New insertion anchors prompt in other window") (let ((w (next-window))) diff --git a/test/lisp/erc/resources/erc-d/erc-d.el b/test/lisp/erc/resources/erc-d/erc-d.el index b86769220dd..f072c6b93b2 100644 --- a/test/lisp/erc/resources/erc-d/erc-d.el +++ b/test/lisp/erc/resources/erc-d/erc-d.el @@ -254,7 +254,7 @@ erc-d--initialize-client (ending (process-get process :dialog-ending)) (dialog (make-erc-d-dialog :name name :process process - :queue (make-ring 5) + :queue (make-ring 10) :exchanges (make-ring 10) :match-handlers mat-h :server-fqdn fqdn))) @@ -292,33 +292,27 @@ erc-d-load-replacement-dialog (defvar erc-d--m-debug (getenv "ERC_D_DEBUG")) -(defmacro erc-d--m (process format-string &rest args) - "Output ARGS using FORMAT-STRING somewhere depending on context. -PROCESS should be a client connection or a server network process." - `(let ((format-string (if erc-d--m-debug - (concat (format-time-string "%s.%N: ") - ,format-string) - ,format-string)) - (want-insert (and ,process erc-d--in-process)) - (buffer (process-buffer (process-get ,process :server)))) - (when (and want-insert (buffer-live-p buffer)) - (with-current-buffer buffer - (goto-char (point-max)) - (insert (concat (format ,format-string ,@args) "\n")))) - (when (or erc-d--m-debug (not want-insert)) - (message format-string ,@args)))) - -(defmacro erc-d--log (process string &optional outbound) - "Log STRING sent to (OUTBOUND) or received from PROCESS peer." - `(let ((id (or (process-get ,process :log-id) - (let ((port (erc-d-u--get-remote-port ,process))) - (process-put ,process :log-id port) - port))) - (name (erc-d-dialog-name (process-get ,process :dialog)))) - (if ,outbound - (erc-d--m process "-> %s:%s %s" name id ,string) - (dolist (line (split-string ,string (process-get process :ending))) - (erc-d--m process "<- %s:%s %s" name id line))))) +(defun erc-d--m (process format-string &rest args) + "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere." + (when erc-d--m-debug + (setq format-string (concat (format-time-string "%s.%N: ") format-string))) + (let ((insertp (and process erc-d--in-process)) + (buffer (process-buffer (process-get process :server)))) + (when (and insertp (buffer-live-p buffer)) + (princ (concat (apply #'format format-string args) "\n") buffer)) + (when (or erc-d--m-debug (not insertp)) + (apply #'message format-string args)))) + +(defun erc-d--log (process string &optional outbound) + "Log STRING received from or OUTBOUND to PROCESS peer." + (let ((id (or (process-get process :log-id) + (let ((port (erc-d-u--get-remote-port process))) + (process-put process :log-id port) port))) + (name (erc-d-dialog-name (process-get process :dialog)))) + (if outbound + (erc-d--m process "-> %s:%s %s" name id string) + (dolist (line (split-string string (process-get process :ending))) + (erc-d--m process "<- %s:%s %s" name id line))))) (defun erc-d--log-process-event (server process msg) (erc-d--m server "%s: %s" process (string-trim-right msg))) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 19f26bf08bd..5354b300b47 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -341,7 +341,7 @@ erc-scenarios-common--recenter-top-bottom ;;;; Fixtures -(defun erc-scenarios-scrolltobottom--normal (test) +(defun erc-scenarios-common-scrolltobottom--normal (test) (erc-scenarios-common-with-noninteractive-in-term ((erc-scenarios-common-dialog "scrolltobottom") (dumb-server (erc-d-run "localhost" t 'help)) @@ -402,6 +402,7 @@ erc-scenarios-scrolltobottom--normal (erc-cmd-MSG "NickServ help register") (save-excursion (erc-d-t-search-for 10 "End of NickServ")) (should (= 1 (point))) + (redisplay) (should (zerop (count-screen-lines (window-start) (window-point)))) (should (erc-scenarios-common--prompt-past-win-end-p))) -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Exempt-text-scale-mode-from-erc-scrolltobottom-all.patch >From 9abdac639b0037fcb11bd39df97a59c534b21fb6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 20 Sep 2023 21:40:36 -0700 Subject: [PATCH 2/4] Exempt text-scale-mode from erc-scrolltobottom-all * lisp/erc/erc-goodies.el (erc--scrolltobottom-post-ignore-commands): New variable, a list of commands that should not trigger a re-scroll. (erc--scrolltobottom-on-post-command): Don't `recenter' when the current command appears in `erc--scrolltobottom-post-ignore-commands'. --- lisp/erc/erc-goodies.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 6eb015fdd64..431264ec8b4 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -128,6 +128,11 @@ erc--scrolltobottom-post-force-commands That is, ERC recalculates the window's start instead of blindly restoring it.") +;; Unfortunately, this doesn't work when `erc-scrolltobottom-relaxed' +;; is enabled (scaling up still moves the prompt). +(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust) + "Commands to skip instead of force-scroll on `post-command-hook'.") + (defvar erc--scrolltobottom-relaxed-skip-commands '(recenter-top-bottom scroll-down-command) "Commands exempt from triggering a stash and restore of `window-start'. @@ -158,7 +163,8 @@ erc--scrolltobottom-on-post-command ((= (nth 2 found) (count-screen-lines (window-start) (point-max))))) (set-window-start (selected-window) (nth 1 found)) - (erc--scrolltobottom-confirm)) + (unless (memq this-command erc--scrolltobottom-post-ignore-commands) + (erc--scrolltobottom-confirm))) (setq erc--scrolltobottom-window-info nil))) (defun erc--scrolltobottom-on-pre-command-relaxed () -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-5.6-Improve-erc-warn-about-blank-lines-behavior.patch >From 4241661eb4cf568196cf11f77ccbf56a8f23c1d6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 15 Sep 2023 06:08:55 -0700 Subject: [PATCH 3/4] [5.6] Improve erc-warn-about-blank-lines behavior * etc/ERC-NEWS: Mention more detailed feedback when option `erc-warn-about-blank-lines' is non-nil. * lisp/erc/erc-common.el (erc--input-split): Add `abortp' slot to allow a premature exit while validating prompt input. * lisp/erc/erc.el (erc-warn-about-blank-lines): Clarify meaning of "blank lines" and mention interaction with `erc-send-whitespace-lines'. (erc-inhibit-multiline-input): Fix inaccurate description in doc string. (erc--input-review-functions): Move `erc--discard-trailing-multiline-nulls' to end of list, after `erc--run-input-validation-checks'. (erc--blank-in-multiline-input-p): Remove unused internal function. (erc--check-prompt-input-for-something): New trivial validation function to check if the input is empty. (erc--count-blank-lines): New function that tallies up the number of blank and whitespace-only lines in the current input. (erc--check-prompt-explanation): New variable. (erc--check-prompt-input-for-multiline-blanks): Rework significantly to provide more informative messages and more sensible behavior for common cases with respect to relevant option values. (erc--check-prompt-input-functions): Add new validation function `erc--check-prompt-for-something'. (erc--run-input-validation-checks): Set `abortp' slot of `erc--input-split' when hooks return a non-string, rather than generate an unhelpful fallback message. Also print a message when the variable `erc--check-prompt-explanation' is non-nil. (erc-send-current-line): When the `abortp' slot of the current `erc--input-split' object is non-nil, forgo normal input processing. This fixes a regression in 5.6-git, which emits an error message when it should instead just exit the command. (erc--discard-trailing-multiline-nulls): Always run, regardless of `erc-send-whitespace-lines', and leave a blank line behind when stripping a message consisting of only blank lines. (erc--run-send-hooks): Always run hooks and surrounding logic rather than only when hooks are populated. * test/lisp/erc/erc-tests.el (erc--refresh-prompt): Add assertion and use default value for `erc--input-review-functions'. (erc-ring-previous-command): Use default value for `erc--input-review-functions'. (erc--blank-in-multiline-input-p): Remove irrelevant test. (erc--check-prompt-input-functions): Update expected message. (erc--discard-trailing-multiline-nulls, erc--count-blank-lines): New tests. (erc-tests--check-prompt-input--expect, erc-tests--check-prompt-input-messages): New helper variables. (erc--check-prompt-input-for-multiline-blanks, erc--check-prompt-input-for-multiline-blanks/explanations): New tests. (erc-send-whitespace-lines): Expect hook-processing logic to pad empty lines instead of deferring to `erc-send-input-line-function'. (Bug#66073) --- etc/ERC-NEWS | 8 +- lisp/erc/erc-common.el | 1 + lisp/erc/erc.el | 151 ++++++++++++++++++++++--------- test/lisp/erc/erc-tests.el | 180 ++++++++++++++++++++++++++++--------- 4 files changed, 256 insertions(+), 84 deletions(-) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 05e933930e2..fadd97b65df 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -221,6 +221,12 @@ atop any message. The new companion option 'erc-echo-timestamp-zone' determines the default timezone when not specified with a prefix argument. +** Option 'erc-warn-about-blank-lines' is more informative. +Enabled by default, this option now produces more useful feedback +whenever ERC rejects prompt input containing whitespace-only lines. +When paired with option 'erc-send-whitespace-lines', ERC echoes a +tally of blank lines padded and trailing blanks culled. + ** Miscellaneous UX changes. Some minor quality-of-life niceties have finally made their way to ERC. For example, fool visibility has become togglable with the new @@ -281,7 +287,7 @@ For starters, the 'cursor-sensor-functions' property no longer contains unique closures and thus no longer proves effective for traversing messages. To compensate, a new property, 'erc-timestamp', now spans message bodies but not the newlines delimiting them. Also -affecting the `stamp' module is the deprecation of the function +affecting the 'stamp' module is the deprecation of the function 'erc-insert-aligned' and its removal from client code. Additionally, the module now merges its 'invisible' property with existing ones and includes all white space around stamps when doing so. diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 67c2cf8535b..8d896e663b5 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -60,6 +60,7 @@ erc-input ((obsolete erc-send-this)) erc-send-this)))) (lines nil :type (list-of string)) + (abortp nil :type (list-of symbol)) (cmdp nil :type boolean)) (cl-defstruct (erc-server-user (:type vector) :named) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ec4fae548c7..76af17583da 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -249,7 +249,14 @@ erc-prompt-for-password :type 'boolean) (defcustom erc-warn-about-blank-lines t - "Warn the user if they attempt to send a blank line." + "Warn the user if they attempt to send a blank line. +When non-nil, ERC signals a `user-error' upon encountering prompt +input containing empty or whitespace-only lines. When nil, ERC +still inhibits sending but does so silently. With the companion +option `erc-send-whitespace-lines' enabled, ERC sends pending +input and prints a message in the echo area indicating the amount +of padding and/or stripping applied, if any. Setting this option +to nil suppresses such reporting." :group 'erc :type 'boolean) @@ -261,8 +268,8 @@ erc-send-whitespace-lines (defcustom erc-inhibit-multiline-input nil "When non-nil, conditionally disallow input consisting of multiple lines. Issue an error when the number of input lines submitted for -sending exceeds this value. The value t means disallow more -than 1 line of input." +sending meets or exceeds this value. The value t is synonymous +with a value of 2 and means disallow more than 1 line of input." :package-version '(ERC . "5.5") :group 'erc :type '(choice integer boolean)) @@ -1092,9 +1099,9 @@ erc-pre-send-functions (define-obsolete-variable-alias 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") -(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls - erc--split-lines - erc--run-input-validation-checks) +(defvar erc--input-review-functions '(erc--split-lines + erc--run-input-validation-checks + erc--discard-trailing-multiline-nulls) "Special hook for reviewing and modifying prompt input. ERC runs this before clearing the prompt and before running any send-related hooks, such as `erc-pre-send-functions'. Thus, it's @@ -6421,20 +6428,6 @@ erc--input-line-delim-regexp (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" "Regular expression used for matching commands in ERC.") -(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 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 ((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--check-prompt-input-for-excess-lines (_ lines) "Return non-nil when trying to send too many LINES." (when erc-inhibit-multiline-input @@ -6454,13 +6447,78 @@ erc--check-prompt-input-for-excess-lines (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) +(defun erc--check-prompt-input-for-something (string _) + (when (string-empty-p string) (if erc-warn-about-blank-lines "Blank line - ignoring..." 'invalid))) +(defun erc--count-blank-lines (lines) + "Report on the number of whitespace-only and empty LINES. +Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know +that BLANKS includes non-empty whitespace-only lines and that no +padding or stripping has yet occurred." + (let ((real 0) (total 0) (pad 0) (strip 0)) + (dolist (line lines) + (if (string-match (rx bot (* (in " \t\f")) eot) line) + (progn + (cl-incf total) + (if (zerop (match-end 0)) + (cl-incf strip) + (cl-incf pad strip) + (setq strip 0))) + (cl-incf real) + (unless (zerop strip) + (cl-incf pad strip) + (setq strip 0)))) + (when (and (zerop real) (not (zerop total)) (= total (+ pad strip))) + (cl-incf strip (1- pad)) + (setq pad 1)) + (list total pad strip))) + +(defvar erc--check-prompt-explanation nil + "List of strings to print if no validator returns non-nil.") + +(defun erc--check-prompt-input-for-multiline-blanks (_ lines) + "Return non-nil when multiline prompt input has blank LINES. +Consider newlines to be intervening delimiters, meaning the +zero-width logical line between a trailing newline and `eob' +constitutes a separate message." + (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines))) + (cond ((zerop total) nil) + ((and erc-warn-about-blank-lines erc-send-whitespace-lines) + (let (msg args) + (unless (zerop strip) + (push "stripping (%d)" msg) + (push strip args)) + (unless (zerop pad) + (when msg + (push "and" msg)) + (push "padding (%d)" msg) + (push pad args)) + (when msg + (push "blank" msg) + (push (if (> (apply #'+ args) 1) "lines" "line") msg)) + (when msg + (setf msg (nreverse msg) + (car msg) (capitalize (car msg)))) + (when msg + (push (apply #'format (string-join msg " ") (nreverse args)) + erc--check-prompt-explanation) + nil))) + (erc-warn-about-blank-lines + (concat (if (= total 1) + (if (zerop strip) "Blank" "Trailing") + (if (= total strip) + (format "%d trailing" strip) + (format "%d blank" total))) + (and (> total 1) (/= total strip) (not (zerop strip)) + (format " (%d trailing)" strip)) + (if (= total 1) " line" " lines") + " detected (see `erc-send-whitespace-lines')")) + (erc-send-whitespace-lines nil) + (t '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)) @@ -6481,25 +6539,34 @@ erc--check-prompt-input-for-multiline-command (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds + erc--check-prompt-input-for-something erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process erc--check-prompt-input-for-excess-lines erc--check-prompt-input-for-multiline-command) "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, ERC passes it to `erc-error'.") +Called with two arguments: the current input submitted by the +user, as a string, along with the same input as a list of +strings. If any member function returns non-nil, ERC abandons +processing and leaves pending input untouched in the prompt area. +When the returned value is a string, ERC passes it to +`user-error'. Any other non-nil value tells ERC to abort +silently. If all members return nil, and the variable +`erc--check-prompt-explanation' is a nonempty list of strings, +ERC prints them as a single message joined by newlines.") (defun erc--run-input-validation-checks (state) "Run input checkers from STATE, an `erc--input-split' object." - (when-let ((msg (run-hook-with-args-until-success - 'erc--check-prompt-input-functions - (erc--input-split-string state) - (erc--input-split-lines state)))) - (unless (stringp msg) - (setq msg (format "Input error: %S" msg))) - (user-error msg))) + (let* ((erc--check-prompt-explanation nil) + (msg (run-hook-with-args-until-success + 'erc--check-prompt-input-functions + (erc--input-split-string state) + (erc--input-split-lines state)))) + (cond ((stringp msg) (user-error msg)) + (msg (push msg (erc--input-split-abortp state))) + (erc--check-prompt-explanation + (message "%s" (string-join (nreverse erc--check-prompt-explanation) + "\n")))))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6523,8 +6590,9 @@ erc-send-current-line str erc--input-line-delim-regexp) :cmdp (string-match erc-command-regexp str)))) (run-hook-with-args 'erc--input-review-functions state) - (let ((inhibit-read-only t) - (old-buf (current-buffer))) + (when-let (((not (erc--input-split-abortp state))) + (inhibit-read-only t) + (old-buf (current-buffer))) (progn ; unprogn this during next major surgery (erc-set-active-buffer (current-buffer)) ;; Kill the input and the prompt @@ -6553,12 +6621,11 @@ erc-user-input (erc-end-of-input-line))) (defun erc--discard-trailing-multiline-nulls (state) - "Ensure last line of STATE's string is non-null. -But only when `erc-send-whitespace-lines' is non-nil. STATE is -an `erc--input-split' object." - (when (and erc-send-whitespace-lines (erc--input-split-lines state)) + "Remove trailing empty lines from STATE, an `erc--input-split' object. +When all lines are empty, remove all but the first." + (when (erc--input-split-lines state) (let ((reversed (nreverse (erc--input-split-lines state)))) - (while (and reversed (string-empty-p (car reversed))) + (while (and (cdr reversed) (string-empty-p (car reversed))) (setq reversed (cdr reversed))) (setf (erc--input-split-lines state) (nreverse reversed))))) @@ -6578,7 +6645,7 @@ erc--run-send-hooks limits and pad empty ones, knowing full well that additional processing may still corrupt messages before they reach the send queue. Expect LINES-OBJ to be an `erc--input-split' object." - (when (or erc-send-pre-hook erc-pre-send-functions) + (progn ; FIXME remove `progn' after code review. (with-suppressed-warnings ((lexical str) (obsolete erc-send-this)) (defvar str) ; see note in string `erc-send-input'. (let* ((str (string-join (erc--input-split-lines lines-obj) "\n")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 05d45b2d027..2da1f7b29c1 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -292,7 +292,7 @@ erc--refresh-prompt (cl-incf counter)))) erc-accidental-paste-threshold-seconds erc-insert-modify-hook - erc--input-review-functions + (erc--input-review-functions erc--input-review-functions) erc-send-completed-hook) (ert-info ("Server buffer") @@ -357,6 +357,9 @@ erc--refresh-prompt (should (= (point) erc-input-marker)) (insert "/query bob") (erc-send-current-line) + ;; Last command not inserted + (save-excursion (forward-line -1) + (should (looking-at " Howdy"))) ;; Query does not redraw (nor /help, only message input) (should (looking-back "#chan@ServNet 11> ")) ;; No sign of old prompts @@ -877,11 +880,12 @@ erc-ring-previous-command (with-current-buffer (get-buffer-create "*#fake*") (erc-mode) (erc-tests--send-prep) + (setq erc-server-current-nick "tester") (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) ;; Just in case erc-ring-mode is already on - (setq-local erc--input-review-functions nil) + (setq-local erc--input-review-functions erc--input-review-functions) (add-hook 'erc--input-review-functions #'erc-add-to-input-ring) ;; (cl-letf (((symbol-function 'erc-process-input-line) @@ -1056,43 +1060,6 @@ erc--input-line-delim-regexp (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--input-review-functions @@ -1138,7 +1105,7 @@ erc--check-prompt-input-functions (delete-region (point) (point-max)) (insert "one\n") (let ((e (should-error (erc-send-current-line)))) - (should (equal "Blank line - ignoring..." (cadr e)))) + (should (string-prefix-p "Trailing line detected" (cadr e)))) (goto-char (point-max)) (ert-info ("Input remains untouched") (should (save-excursion (goto-char erc-input-marker) @@ -1180,6 +1147,137 @@ erc-send-current-line (should (consp erc-last-input-time))))) +(ert-deftest erc--discard-trailing-multiline-nulls () + (pcase-dolist (`(,input ,want) '((("") ("")) + (("" "") ("")) + (("a") ("a")) + (("a" "") ("a")) + (("" "a") ("" "a")) + (("" "a" "") ("" "a")))) + (ert-info ((format "Input: %S, want: %S" input want)) + (let ((s (make-erc--input-split :lines input))) + (erc--discard-trailing-multiline-nulls s) + (should (equal (erc--input-split-lines s) want)))))) + +(ert-deftest erc--count-blank-lines () + (pcase-dolist (`(,input ,want) '((() (0 0 0)) + (("") (1 1 0)) + (("" "") (2 1 1)) + (("" "" "") (3 1 2)) + ((" " "") (2 0 1)) + ((" " "" "") (3 0 2)) + (("" " " "") (3 1 1)) + (("" "" " ") (3 2 0)) + (("a") (0 0 0)) + (("a" "") (1 0 1)) + (("a" " " "") (2 0 1)) + (("a" "" "") (2 0 2)) + (("a" "b") (0 0 0)) + (("a" "" "b") (1 1 0)) + (("a" " " "b") (1 0 0)) + (("" "a") (1 1 0)) + ((" " "a") (1 0 0)) + (("" "a" "") (2 1 1)) + (("" " " "a" "" " ") (4 2 0)) + (("" " " "a" "" " " "") (5 2 1)))) + (ert-info ((format "Input: %S, want: %S" input want)) + (should (equal (erc--count-blank-lines input) want))))) + +;; Opt `wb': `erc-warn-about-blank-lines' +;; Opt `sw': `erc-send-whitespace-lines' +;; `s': " \n",`a': "a\n",`b': "b\n" +(defvar erc-tests--check-prompt-input--expect + ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb" + '(((+wb -sw) err err err err err err err err err) + ((-wb -sw) nop nop nop nop nop nop nop nop nop) + ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b)) + ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b)))) + +;; Help messages echoed (not IRC message) was emitted +(defvar erc-tests--check-prompt-input-messages + '("Stripping" "Padding")) + +(ert-deftest erc--check-prompt-input-for-multiline-blanks () + (erc-tests--with-process-input-spy + (lambda (next) + (erc-tests--set-fake-server-process "sleep" "1") + (should-not erc-send-whitespace-lines) + (should erc-warn-about-blank-lines) + + (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect) + (let ((print-escape-newlines t) + (erc-warn-about-blank-lines (eq wb '+wb)) + (erc-send-whitespace-lines (eq sw '+sw)) + (samples '("" " " "\n" "\n " " \n" "\n\n" + "a\n" "a\n " "a\n \nb"))) + (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos + samples `(,@samples "a" "a\nb")) + (dolist (input samples) + (insert input) + (ert-info ((format "Opts: %S, Input: %S, want: %S" + (list wb sw) input (car ex))) + (ert-with-message-capture messages + (pcase-exhaustive (pop ex) + ('err (let ((e (should-error (erc-send-current-line)))) + (should (string-match (rx (| "trailing" "blank")) + (cadr e)))) + (should (equal (erc-user-input) input)) + (should-not (funcall next))) + ('nop (erc-send-current-line) + (should (equal (erc-user-input) input)) + (should-not (funcall next))) + ('clr (erc-send-current-line) + (should (string-empty-p (erc-user-input))) + (should-not (funcall next))) + ((and (pred consp) v) + (erc-send-current-line) + (should (string-empty-p (erc-user-input))) + (setq v (reverse v)) ; don't use `nreverse' here + (while v + (pcase (pop v) + ((and (pred integerp) n) + (should (string-search + (nth n erc-tests--check-prompt-input-messages) + messages))) + ('s (should (equal " \n" (car (funcall next))))) + ('a (should (equal "a\n" (car (funcall next))))) + ('b (should (equal "b\n" (car (funcall next))))))) + (should-not (funcall next)))))) + (delete-region erc-input-marker (point-max)))))))) + +(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations () + (should erc-warn-about-blank-lines) + (should-not erc-send-whitespace-lines) + + (let ((erc-send-whitespace-lines t)) + (pcase-dolist (`(,input ,msg) + '((("") "Padding (1) blank line") + (("" " ") "Padding (1) blank line") + ((" " "") "Stripping (1) blank line") + (("a" "") "Stripping (1) blank line") + (("" "") "Stripping (1) and padding (1) blank lines") + (("" "" "") "Stripping (2) and padding (1) blank lines") + (("" "a" "" "b" "" "c" "" "") + "Stripping (2) and padding (3) blank lines"))) + (ert-info ((format "Input: %S, Msg: %S" input msg)) + (let (erc--check-prompt-explanation) + (should-not (erc--check-prompt-input-for-multiline-blanks nil input)) + (should (equal (list msg) erc--check-prompt-explanation)))))) + + (pcase-dolist (`(,input ,msg) + '((("") "Blank line detected") + (("" " ") "2 blank lines detected") + ((" " "") "2 blank (1 trailing) lines detected") + (("a" "") "Trailing line detected") + (("" "") "2 blank (1 trailing) lines detected") + (("a" "" "") "2 trailing lines detected") + (("" "a" "" "b" "" "c" "" "") + "5 blank (2 trailing) lines detected"))) + (ert-info ((format "Input: %S, Msg: %S" input msg)) + (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input))) + (should (equal (concat msg " (see `erc-send-whitespace-lines')") + rv )))))) + (ert-deftest erc-send-whitespace-lines () (erc-tests--with-process-input-spy (lambda (next) @@ -1196,7 +1294,7 @@ erc-send-whitespace-lines (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) '(" \n" nil t))) (should (equal (funcall next) '("one\n" nil t)))) (ert-info ("Multiline hunk with trailing newline filtered") -- 2.41.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Detect-slash-commands-in-erc-input-review-functions.patch >From eeedb524c2686245da10aa827a6a9bfcbc54d046 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 9 Jun 2023 21:00:03 -0700 Subject: [PATCH 4/4] Detect slash commands in erc--input-review-functions * lisp/erc/erc.el (erc--input-review-functions): Add `erc--inhibit-slash-cmd-insertion'. (erc--check-prompt-input-functions): Move `erc--check-prompt-input-for-multiline-command' above `erc--check-prompt-input-for-multiline-blanks'. (erc--inhibit-slash-cmd-insertion): New function to suppress insertion of prompt input for slash commands. Doesn't affect "meta" slash commands like /SAY. (erc--send-input-lines): Don't bother checking whether message is a command. Instead, trust verdict handed down by message-prep functions. This opens the door to optional insertion for debugging purposes or when echoing command lines in a shell-like fashion. * test/lisp/erc/erc-tests.el (erc-send-whitespace-lines): clean up portion dealing with trimming slash commands. (Bug#66073) --- lisp/erc/erc.el | 17 +++++++++++------ test/lisp/erc/erc-tests.el | 9 ++------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 76af17583da..b9ce6b8e53a 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1101,7 +1101,8 @@ 'erc--pre-send-split-functions 'erc--input-review-functions "30.1") (defvar erc--input-review-functions '(erc--split-lines erc--run-input-validation-checks - erc--discard-trailing-multiline-nulls) + erc--discard-trailing-multiline-nulls + erc--inhibit-slash-cmd-insertion) "Special hook for reviewing and modifying prompt input. ERC runs this before clearing the prompt and before running any send-related hooks, such as `erc-pre-send-functions'. Thus, it's @@ -6540,10 +6541,10 @@ erc--check-prompt-input-for-multiline-command (defvar erc--check-prompt-input-functions '(erc--check-prompt-input-for-point-in-bounds erc--check-prompt-input-for-something + erc--check-prompt-input-for-multiline-command erc--check-prompt-input-for-multiline-blanks erc--check-prompt-input-for-running-process - erc--check-prompt-input-for-excess-lines - erc--check-prompt-input-for-multiline-command) + erc--check-prompt-input-for-excess-lines) "Validators for user input typed at prompt. Called with two arguments: the current input submitted by the user, as a string, along with the same input as a list of @@ -6568,6 +6569,11 @@ erc--run-input-validation-checks (message "%s" (string-join (nreverse erc--check-prompt-explanation) "\n")))))) +(defun erc--inhibit-slash-cmd-insertion (state) + "Don't insert STATE object's message if it's a \"slash\" command." + (when (erc--input-split-cmdp state) + (setf (erc--input-split-insertp state) nil))) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) @@ -6676,9 +6682,8 @@ erc--send-input-lines "Send lines in `erc--input-split-lines' object LINES-OBJ." (when (erc--input-split-sendp lines-obj) (dolist (line (erc--input-split-lines lines-obj)) - (unless (erc--input-split-cmdp lines-obj) - (when (erc--input-split-insertp lines-obj) - (erc-display-msg line))) + (when (erc--input-split-insertp lines-obj) + (erc-display-msg line)) (erc-process-input-line (concat line "\n") (null erc-flood-protect) (not (erc--input-split-cmdp lines-obj)))))) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 2da1f7b29c1..8a68eca6196 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1316,17 +1316,12 @@ erc-send-whitespace-lines (should-not (funcall next))) (ert-info ("Multiline command with trailing blank filtered") - (pcase-dolist (`(,p . ,q) - '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n") - ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n") - ("/a b\n\n\n" "/a b\n"))) + (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n")) (insert p) (erc-send-current-line) (erc-bol) (should (eq (point) (point-max))) - (while q - (should (pcase (funcall next) - (`(,cmd ,_ nil) (equal cmd (pop q)))))) + (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n")))) (should-not (funcall next)))) (ert-info ("Multiline command with non-blanks errors") -- 2.41.0 --=-=-=--