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#66073: 30.0.50; ERC 5.6: Improve handling of blank lines at ERC's prompt Date: Mon, 18 Sep 2023 07:25:18 -0700 Message-ID: <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="39597"; 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 Mon Sep 18 16:26:13 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 1qiFCX-000A5A-9C for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 18 Sep 2023 16:26:13 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qiFCQ-0006Pv-SH; Mon, 18 Sep 2023 10:26:08 -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 1qiFCF-0006PD-MX; Mon, 18 Sep 2023 10:25:57 -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 1qiFCF-0007pz-6t; Mon, 18 Sep 2023 10:25:55 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qiFCM-0006Uj-DA; Mon, 18 Sep 2023 10:26:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: emacs-erc@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Mon, 18 Sep 2023 14:26:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 66073 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: emacs-erc@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.169504715524948 (code B ref -1); Mon, 18 Sep 2023 14:26:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 18 Sep 2023 14:25:55 +0000 Original-Received: from localhost ([127.0.0.1]:53967 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qiFCD-0006UF-Vm for submit@debbugs.gnu.org; Mon, 18 Sep 2023 10:25:55 -0400 Original-Received: from lists.gnu.org ([2001:470:142::17]:43656) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qiFC8-0006Tu-PW for submit@debbugs.gnu.org; Mon, 18 Sep 2023 10:25:52 -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 1qiFBu-0006O7-KF for bug-gnu-emacs@gnu.org; Mon, 18 Sep 2023 10:25:34 -0400 Original-Received: from mail-108-mta89.mxroute.com ([136.175.108.89]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qiFBq-0007iw-Bl for bug-gnu-emacs@gnu.org; Mon, 18 Sep 2023 10:25:34 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta89.mxroute.com (ZoneMTA) with ESMTPSA id 18aa8ae7cfe000d7b6.001 for (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Mon, 18 Sep 2023 14:25:22 +0000 X-Zone-Loop: 4f29e146979e832227b232934be31fb3e30dd677ba3d 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:Subject:To:From:Sender: Reply-To:Cc:Content-Transfer-Encoding:Content-ID:Content-Description: Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc:Resent-Message-ID: In-Reply-To:References:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=a52Pg5SgR6U5JAHLqP8CoNd670atkHvdJ1YfoPSeLJs=; b=M9j7C2lAYoGaTjYibbfogwPKJr rvpt1O6+0VBim8TI5zDj4MFYLLNvXAg9JkdALNHO6STDT96Tk4o2etTQz/cpdWjrhlzC3oDCIgq7s uX84GK54misqPHtX3KSrzhsP5tb3WpG1r6+LWUMHw5gmvir9rbvK3AzTVhOMj5ev8Sh3UffOJ36co YV/vPV9oYFUcpN2fiZHQhY3gTPabARnIXnOgTd2TKg2EkvaHDJmz7P9HFu/Wu75TDD0bdZugR0rg7 4oah+Arah3AQkBaQE2lONJ01ky31+6Ccj7+YJsi4vGwzND6xCI62d0cre3CBCkl33hvpz+mD218rx RqY1M60g==; X-Authenticated-Id: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.89; envelope-from=jp@neverwas.me; helo=mail-108-mta89.mxroute.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action 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:270800 gmane.emacs.erc.general:2253 Archived-At: --=-=-= Content-Type: text/plain Tags: patch ERC has made some strides in recent versions when it comes to dealing with unwelcome or irregular whitespace in user input [1]. But rough edges definitely remain. One important option influencing this area is `erc-warn-about-blank-lines'. It concerns feedback in the echo area from blank lines submitted at the prompt [2]. Its purview overlaps somewhat with that of `erc-send-whitespace-lines', though the latter option also affects implicit trimming and padding. This proposal attempts to clarify and formalize ERC's treatment of both. One thing this bug does not attempt is to define and attain optimal UX in this area because finding a sweet spot between user friendliness and compatibility is likely infeasible given the many options whose defaults can't be changed without breaking ancient bots and user code [3]. Instead, this bug attempts to file down some burry bits affecting how submitted input is massaged and how accompanying feedback is communicated, both currently inconsistent and not super predictable. (It also attempts to fix a closely related bug [4].) To better understand what's being proposed here, compare the last row of the following table with the "desired output" below (see [5] for baseline cases): | vers/opts | "" | " " | "\n" | "\n " | " \n" | "\n\n" | "a\n" | "a\n " | "a\n \nb" | |-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------| | 28 +w,-s* | err | e/c | e/c | e/c | e/c | e/c | a,\s | a,\s | a,\s,b | | 28 -w,-s | nop | clr | clr | clr | clr | clr | a,\s | a,\s | a,\s,b | | 28 +w,+s | err | \s | \s,\s | \s,\s | \s,\s | \s(x3) | a,\s | a,\s | a,\s,b | | 28 -w,+s | nop | \s | \s,\s | \s,\s | \s,\s | \s(x3) | a,\s | a,\s | a,\s,b | |-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------| | 29 +w,-s* | err | err | err | err | err | err | err | err | err | | 29 -w,-s | nop | nop | nop | nop | nop | nop | nop | nop | nop | | 29 +w,+s | err | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b | | 29 -w,+s | nop | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b | |-----------+-----+-----+-------+-------+-------+--------+-------+--------+-----------| | 30 +w,-s* | err | err | err | err | err | err | err | err | err | | 30 -w,-s | fbe | fbe | fbe | fbe | fbe | fbe | fbe | fbe | fbe | | 30 +w,+s | nop | \s | clr | \s,\s | \s | clr | a | a,\s | a,\s,b | | 30 -w,+s | nop | \s | clr | \s,\s | \s | clr | a | a,\s | a,\s,b | Desired output: | 30 +w,-s* | err | *er | *er | *er | *er | *er | *er | *er | *er | | 30 -w,-s | nop | nop | nop | nop | nop | nop | nop | nop | nop | | 30 +w,+s | err | *\s | *\s | *\s,\s | *\s | *\s | *a | *a,\s | *a,\s,b | | 30 -w,+s | nop | \s | \s | \s,\s | \s | \s | a | a,\s | a,\s,b | - w: `erc-warn-about-blank-lines' - s: `erc-send-whitespace-lines' - +w,-s*: default configuration as seen with Emacs -Q - err: signal `user-error' but leave input area untouched - nop: No-op; leave input untouched - fbe: fallback error (likely a bug [4]), otherwise like err - clr: clear entire prompt area and don't send anything - e/c: signal a `user-error' and clear the prompt area - *er: detailed error with null/white tallies and other context - : outgoing message (\s is a space), implies clearing - *: same, but with detailed feedback in echo area For examples of the improved feedback wording, see the attached test called `erc--check-prompt-input-for-multiline-blanks/explanations'. The basic idea is to report on the number of lines padded and/or stripped when `erc-send-whitespace-lines' is enabled and the number of blanks and/or trailing lines detected when that option is nil (as long as `erc-warn-about-blank-lines' is still enabled). One idea discussed recently on Libera was to enable implicit trimming of trailing blanks by default, at least for the common "a\n" case. While certainly possible, doing so would make for some complicated explaining in the doc strings of both options. And adding yet another knob to achieve this effect would only further complicate an already unruly mix. Hopefully, the proposed solution of richer feedback will prove sufficient enough to fill this void. Lastly, this bug also addresses some design mishaps in this same general area. For example, the functions `erc--blank-in-multiline-input-p' and `erc--discard-trailing-multiline-nulls' really shouldn't concern themselves with user options. Rather, they should just report on or process data as requested by their options-aware caller (the function `erc--check-prompt-input-for-excess-lines'), which should be the sole arbiter of what gets sent and warned about (and how). As always, if anyone has any better ideas, please say so. I'd like to solve this before the next release, which is hopefully right around the corner. Thanks. [1] Related bugs: bug#54536: 29.0.50; Improve ERC's handling of multiline prompt input bug#62947: 30.0.50; ERC 5.6: Improve partitioning of outgoing messages [2] Here, "blank" refers to empty lines as well as those consisting entirely of whitespace. However, ERC at times also uses "whitespace" to refer to empty lines. [3] Plenty of user code relies on simulating user interaction, for example, by inserting hunks of text at the prompt and calling `erc-send-current-line' instead of using lower level library functions. Such code would surely suffer were it to be interrupted by a dialog asking for confirmation before sending. For an example of saner options values that could one day become defaults (e.g., in ERC 6.0) see "(erc) Sample Configuration" in the manual. [4] A second, comparatively minor issue also addressed by this bug is more or less a clear-cut regression, shown as "30 -w,-s" in the table (note all the fbe's). Basically, in all recent releases, disabling `erc-warn-about-blank-lines' resulted in a `ding' (accompanied by a clearing of input in 27 and 28). Unfortunately, the version on HEAD just prints a rather useless error message instead: "Input error: invalid". [5] Baseline behavior identical across all versions, regardless of options: | | a | "a\nb" | |----------------------+---+--------| | all versions/options | a | a,b | In GNU Emacs 30.0.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version 3.24.38, cairo version 1.17.6) of 2023-09-17 built on localhost Repository revision: a0ed463babaa6301dfe2fecc27e2a6c92eb0d90c Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12014000 System Description: Fedora Linux 37 (Workstation Edition) Configured using: 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs 'CFLAGS=-O0 -g3' PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig' Configured features: ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB Important settings: value of $LANG: en_US.UTF-8 value of $XMODIFIERS: @im=ibus locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t eldoc-mode: t show-paren-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t minibuffer-regexp-mode: t line-number-mode: t indent-tabs-mode: t transient-mark-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t Load-path shadows: None found. Features: (shadow sort mail-extr emacsbug message mailcap yank-media puny dired dired-loaddefs rfc822 mml mml-sec epa epg rfc6068 epg-config gnus-util text-property-search time-date mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils erc derived auth-source eieio eieio-core password-cache json map format-spec erc-backend erc-networks easy-mmode byte-opt bytecomp byte-compile erc-common inline erc-compat cl-seq cl-macs gv pcase rx subr-x cl-loaddefs cl-lib erc-loaddefs rmc iso-transl tooltip cconv eldoc paren electric uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd touch-screen tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu timer select scroll-bar mouse jit-lock font-lock syntax font-core term/tty-colors frame minibuffer nadvice seq simple cl-generic indonesian philippine cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite emoji-zwj charscript charprop case-table epa-hook jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs theme-loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget keymap hashtable-print-readable backquote threads dbusbind inotify lcms2 dynamic-setting system-font-setting font-render-setting cairo gtk x-toolkit xinput2 x multi-tty move-toolbar make-network-process emacs) Memory information: ((conses 16 120902 9231) (symbols 48 10034 0) (strings 32 24640 2237) (string-bytes 1 824086) (vectors 16 14496) (vector-slots 8 204135 15157) (floats 8 24 45) (intervals 56 242 0) (buffers 984 10)) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-5.6-Improve-erc-warn-about-blank-lines-behavior.patch >From e65ce41a8418591a026525dea53d1b950c74ec12 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 15 Sep 2023 06:08:55 -0700 Subject: [PATCH] [5.6] Improve erc-warn-about-blank-lines behavior * lisp/erc/erc-common.el (erc--input-split): Add `abortp' slot. Its purpose is to allow for making a premature exit while validating prompt input without having to trap or signaling `user-error' with an empty string. * lisp/erc/erc.el (erc-warn-about-blank-lines): Clarify meaning of "blank lines" and mention interaction with `erc-send-whitespace-lines'. (erc--input-review-functions): Move `erc--discard-trailing-multiline-nulls' after `erc--run-input-validation-checks'. (erc--blank-in-multiline-input-p): Remove 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 lines and whitespace lines in the current input. (erc--check-prompt-input-for-multiline-blanks): Rework 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 returned object is a symbol, rather than printing a fallback error. Also accept a list of `message' arguments as another new return type. (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 adjacent logic rather than only when hooks are populated. * test/lisp/erc/erc-tests.el (erc--blank-in-multiline-input-p): Remove 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. --- lisp/erc/erc-common.el | 1 + lisp/erc/erc.el | 119 +++++++++++++++++++------- test/lisp/erc/erc-tests.el | 171 ++++++++++++++++++++++++++++--------- 3 files changed, 220 insertions(+), 71 deletions(-) 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..7165f38189e 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) @@ -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,72 @@ 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))) + +(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)))) + (and msg `(message ,(string-join msg " ") ,@(nreverse args))))) + (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,6 +6533,7 @@ 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 @@ -6497,9 +6550,11 @@ erc--run-input-validation-checks '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))) + (cond ((eq (car-safe msg) 'message) + (apply 'message (cdr msg))) + ((stringp msg) + (user-error msg)) + (t (push msg (erc--input-split-abortp state)))))) (defun erc-send-current-line () "Parse current line and send it to IRC." @@ -6523,8 +6578,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 +6609,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 +6633,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..bb7e3259608 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -1056,43 +1056,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 +1101,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 +1143,136 @@ 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 ((rv (erc--check-prompt-input-for-multiline-blanks nil input))) + (should (equal (apply #'format (cdr rv)) msg)))))) + + (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 +1289,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 --=-=-=--