unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* 29.0.50; Improve ERC's handling of multiline prompt input
@ 2022-03-23 13:26 J.P.
  2022-03-23 13:50 ` bug#54536: " Lars Ingebrigtsen
                   ` (5 more replies)
  0 siblings, 6 replies; 17+ messages in thread
From: J.P. @ 2022-03-23 13:26 UTC (permalink / raw)
  To: bug-gnu-emacs; +Cc: emacs-erc

[-- Attachment #1: Type: text/plain, Size: 5846 bytes --]

Tags: patch

ERC suffers from a few related issues concerning the early handling of
user input at the prompt. Especially troublesome is "multiline" input
containing line feeds and/or carriage returns. This patch (or at least
this discussion) aims to tackle both.

Any solution should probably address these fundamental UX questions:

1. What should happen when a user submits multiline input containing
   empty lines? Should these be padded so they're not rejected by the
   server? If so, where in the processing pipeline should that occur?
   Should `erc-send-whitespace-lines' play a role here?

   This patch says yes to the latter and interprets that option as
   meaning "preserve whitespace-only lines and create them as necessary
   from blank ones." As to where padding should happen, this patch punts
   and retains the existing (unfortunate) practice of treating them at
   the last minute.

2. Should trailing blank lines be treated differently? If so, how?
   Should they be auto-padded? Simply dropped? Or should encountering
   them raise an error?

   When `erc-send-whitespace-lines' is non-nil, this patch drops
   trailing blanks by default, but it also provides an escape hatch.

3. When `erc-send-whitespace-lines' is non-nil, should it auto-pad a
   submission consisting of a single empty line? Should it allow a
   whitespace-only singleton through?

   This patch says no to the first and yes to the second.

4. Should slash commands, like /MSG be allowed to lead a multiline
   submission?

   This patch says no, still choosing to interpret commands as always
   consisting of a single line.

To offer some flexibility, I'm introducing a hook to perform some
validation on the input being submitted. It comes prepopulated with
functions that replicate existing behavior, such as ensuring point
resides within the input area. It also contains an additional function
to perform the blank-detection business. While it's true that multiple
members of this hook may end up repeating some basic operations (such as
splitting the input string), at present, this isn't the case, and such
waste is pretty negligible anyway since this is an interactive function.

There is one behavioral change being introduced that doesn't come
with an escape hatch, and that's the preservation of input when
a validation check fails. Previously, a user's input would be wiped
out, which seems undesirable and unnecessary in all cases (IMO).

For these and any other, less significant changes not mentioned, the
floor is open for questions and debate, as usual. Thanks.

(See also: "bug#50008: 28.0.50; ERC sends empty lines with user input"
and "bug#50006: 28.0.50; remove deprecated option erc-send-pre-hook".)


In GNU Emacs 29.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.31, cairo version 1.17.4)
 of 2022-03-23 built on localhost
Repository revision: fed9a353dbe79a7a6acc74c1e223c46e7541e627
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 35 (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 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
  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 rmc puny
dired dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg
rfc6068 epg-config gnus-util text-property-search time-date seq gv
subr-x byte-opt bytecomp byte-compile cconv mm-decode mm-bodies
mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-loaddefs
cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils
iso-transl tooltip eldoc paren electric uniquify ediff-hook vc-hooks
lisp-float-type elisp-mode mwheel term/x-win x-win term/common-win x-dnd
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
simple cl-generic 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 cl-preloaded button 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 move-toolbar gtk x-toolkit x multi-tty
make-network-process emacs)

Memory information:
((conses 16 43960 5198)
 (symbols 48 5704 1)
 (strings 32 15802 1589)
 (string-bytes 1 526831)
 (vectors 16 12066)
 (vector-slots 8 167842 8149)
 (floats 8 20 55)
 (intervals 56 241 0)
 (buffers 992 11))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-regression-in-erc-send-input-line.patch --]
[-- Type: text/x-patch, Size: 2448 bytes --]

From fe1f21eeb9027116f263b968d792943b92064df3 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 21 Mar 2022 19:21:57 -0700
Subject: [PATCH 1/2] 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 52fe106f2d..d8ef62cf93 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Improve-ERC-s-handling-of-multiline-prompt-input.patch --]
[-- Type: text/x-patch, Size: 18130 bytes --]

From 8a921612bdafdc5720fe12b49d215c1a42f9c0d0 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Mon, 21 Mar 2022 05:40:16 -0700
Subject: [PATCH 2/2] Improve ERC's handling of multiline prompt input

* lisp/erc/erc.el (erc-pre-send-functions,
erc-discard-trailing-multiline-nulls): Add the latter, a new function,
that drops any trailing null lines from a multiline sequence submitted
for processing.  Add it to `erc-pre-send-functions' as the lone new
default.
(erc-last-input-time): Tweak meaning of variable to match likely
original intent, which is that it's only updated on successful calls
to `erc-send-current-line'.
(erc--input-line-delim-regexp): Add regex var for splitting multiline
prompt input.
(erc--blank-in-multiline-p): Add helper for detecting blank lines.
(erc-check-prompt-input-for-multiline-blanks,
erc-check-prompt-input-for-point-in-bounds,
erc-check-prompt-input-for-running-process): New functions to
encapsulate logic for various pre-flight idiot checks.
(erc-check-prompt-input-functions): Add new hook for validating prompt
input prior to clearing it.
(erc-send-current-line): pre-screen for blank lines and bail out if
necessary.
(erc-send-input): Add optional param to skip
checking for blank lines.

* test/lisp/erc/erc-tests.el (erc-ring-previous-command): Use new test
helper.
(erc--input-line-delim-regexp,
erc--blank-in-multiline-input-p): Add tests.
(erc-tests--send-prep, erc-tests--set-fake-server-process,
erc-tests--with-process-input-spy): Add test helpers.
(erc-check-prompt-input-functions, erc-send-current-line,
erc-send-whitespace-lines): Add tests.
---
 lisp/erc/erc.el            | 103 ++++++++++++++-----
 test/lisp/erc/erc-tests.el | 200 +++++++++++++++++++++++++++++++++++--
 2 files changed, 273 insertions(+), 30 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d8ef62cf93..cbb30bab5b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1040,7 +1040,7 @@ erc-send-pre-hook
   :type 'hook)
 (make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1")
 
-(defcustom erc-pre-send-functions nil
+(defcustom erc-pre-send-functions '(erc-discard-trailing-multiline-nulls)
   "Special hook run to possibly alter the string that is sent.
 The functions are called with one argument, an `erc-input' struct,
 and should alter that struct.
@@ -5536,7 +5536,7 @@ erc-end-of-input-line
   (point-max))
 
 (defvar erc-last-input-time 0
-  "Time of last call to `erc-send-current-line'.
+  "Time of last successful call to `erc-send-current-line'.
 If that function has never been called, the value is 0.")
 
 (defcustom erc-accidental-paste-threshold-seconds 0.2
@@ -5552,6 +5552,66 @@ erc-accidental-paste-threshold-seconds
   :version "26.1"
   :type '(choice number (other :tag "disabled" nil)))
 
+(defvar erc--input-line-delim-regexp (rx (| (: (? ?\r) ?\n) ?\r)))
+
+(defun erc--blank-in-multiline-input-p (string)
+  "Detect whether STRING contains any blank lines.
+When `erc-send-whitespace-lines' is in effect and the input is not a
+\"command\", like /msg, return nil if the input is multiline or the line
+is non-empty.  When `erc-send-whitespace-lines' is nil, return non-nil
+when any line is empty or consists of one or more spaces, tabs, or
+form-feeds."
+  (catch 'return
+    (let ((lines (split-string string erc--input-line-delim-regexp))
+          (cmdp '--?--))
+      (dolist (line lines)
+        (when (if erc-send-whitespace-lines
+                  (and (string= line "")
+                       (or (null (cdr lines)) ; string is one line
+                           (if (eq cmdp '--?--) ; string is /cmd
+                               (setq cmdp (string-match erc-command-regexp
+                                                        (car lines)))
+                             cmdp)))
+                (string-match (rx bot (* (in " \t\f")) eot) line))
+          (throw 'return t))))))
+
+(defun erc-discard-trailing-multiline-nulls (state)
+  "Ensure last line of `erc-input' STATE's string is non-null.
+But only when `erc-send-whitespace-lines' is non-nil."
+  (when erc-send-whitespace-lines
+    (cl-callf (lambda (s) (string-trim-right s "[\r\n]+"))
+        (erc-input-string state))))
+
+(defun erc-check-prompt-input-for-multiline-blanks (string)
+  "Return non-nil when multiline prompt input has blank lines."
+  (when (erc--blank-in-multiline-input-p string)
+    (if erc-warn-about-blank-lines
+        "Blank line - ignoring..."
+      'invalid)))
+
+(defun erc-check-prompt-input-for-point-in-bounds (_)
+  "Return non-nil when point is before prompt."
+  (when (< (point) (erc-beg-of-input-line))
+    "Point is not in the input area"))
+
+(defun erc-check-prompt-input-for-running-process (string)
+  "Return non-nil unless in an active ERC server buffer."
+  (unless (or (erc-server-buffer-live-p)
+              (erc-command-no-process-p string))
+    "ERC: No process running"))
+
+(defcustom erc-check-prompt-input-functions
+  '(erc-check-prompt-input-for-point-in-bounds
+    erc-check-prompt-input-for-multiline-blanks
+    erc-check-prompt-input-for-running-process)
+  "Validators for user input typed at prompt.
+Called with latest input string submitted by user.  If any member
+returns non-nil, processing is abandoned and input is left untouched.
+When the returned value is a string, pass it to `erc-error'."
+  :group 'erc
+  :version "29.1"
+  :type 'hook)
+
 (defun erc-send-current-line ()
   "Parse current line and send it to IRC."
   (interactive)
@@ -5565,20 +5625,20 @@ erc-send-current-line
                      (eolp))
             (expand-abbrev))
           (widen)
-          (if (< (point) (erc-beg-of-input-line))
-              (erc-error "Point is not in the input area")
+          (if-let* ((str (erc-user-input))
+                    (msg (run-hook-with-args-until-success
+                          'erc-check-prompt-input-functions str)))
+              (when (stringp msg)
+                (erc-error msg))
             (let ((inhibit-read-only t)
-                  (str (erc-user-input))
                   (old-buf (current-buffer)))
-              (if (and (not (erc-server-buffer-live-p))
-                       (not (erc-command-no-process-p str)))
-                  (erc-error "ERC: No process running")
+              (progn ; unprogn this during next major surgery
                 (erc-set-active-buffer (current-buffer))
                 ;; Kill the input and the prompt
                 (delete-region (erc-beg-of-input-line)
                                (erc-end-of-input-line))
                 (unwind-protect
-                    (erc-send-input str)
+                    (erc-send-input str 'skip-ws-chk)
                   ;; Fix the buffer if the command didn't kill it
                   (when (buffer-live-p old-buf)
                     (with-current-buffer old-buf
@@ -5593,8 +5653,8 @@ erc-send-current-line
                           (set-buffer-modified-p buffer-modified))))))
 
                 ;; Only when last hook has been run...
-                (run-hook-with-args 'erc-send-completed-hook str))))
-          (setq erc-last-input-time now))
+                (run-hook-with-args 'erc-send-completed-hook str)))
+            (setq erc-last-input-time now)))
       (switch-to-buffer "*ERC Accidental Paste Overflow*")
       (lwarn 'erc :warning
              "You seem to have accidentally pasted some text!"))))
@@ -5611,21 +5671,16 @@ erc-command-regexp
 (cl-defstruct erc-input
   string insertp sendp)
 
-(defun erc-send-input (input)
+(defun erc-send-input (input &optional skip-ws-chk)
   "Treat INPUT as typed in by the user.
 It is assumed that the input and the prompt is already deleted.
 Return non-nil only if we actually send anything."
   ;; Handle different kinds of inputs
-  (cond
-   ;; Ignore empty input
-   ((if erc-send-whitespace-lines
-        (string= input "")
-      (string-match "\\`[ \t\r\f\n]*\\'" input))
-    (when erc-warn-about-blank-lines
-      (message "Blank line - ignoring...")
-      (beep))
-    nil)
-   (t
+  (if (and (not skip-ws-chk)
+           (erc-check-prompt-input-for-multiline-blanks input))
+      (when erc-warn-about-blank-lines
+        (message "Blank line - ignoring...") ; compat
+        (beep))
     ;; This dynamic variable is used by `erc-send-pre-hook'.  It's
     ;; obsolete, and when it's finally removed, this binding should
     ;; also be removed.
@@ -5663,9 +5718,9 @@ erc-send-input
                                             (null erc-flood-protect) t))
                   (or (and erc-flood-protect (erc-split-line line))
                       (list line))))
-               (split-string string "\n"))
+               (split-string string erc--input-line-delim-regexp))
             (erc-process-input-line (concat string "\n") t nil))
-          t))))))
+          t)))))
 
 ;; (defun erc-display-command (line)
 ;;   (when erc-insert-this
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 10e3c16dfc..6a9d291f8a 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -197,14 +197,10 @@ erc-ring-previous-command-base-case
 (ert-deftest erc-ring-previous-command ()
   (with-current-buffer (get-buffer-create "*#fake*")
     (erc-mode)
-    (insert "\n\n")
+    (erc-tests--send-prep)
+    (setq-local erc-last-input-time 0)
     (should-not (local-variable-if-set-p 'erc-send-completed-hook))
     (set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
-    (setq erc-input-marker (make-marker)
-          erc-insert-marker (make-marker))
-    (set-marker erc-insert-marker (point-max))
-    (erc-display-prompt)
-    (should (= (point) erc-input-marker))
     ;; Just in case erc-ring-mode is already on
     (setq-local erc-pre-send-functions nil)
     (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring)
@@ -285,6 +281,198 @@ erc-log-irc-protocol
     (kill-buffer "*erc-protocol*")
     (should-not erc-debug-irc-protocol)))
 
+(ert-deftest erc--input-line-delim-regexp ()
+  (let ((p erc--input-line-delim-regexp))
+    ;; none
+    (should (equal '("a" "b") (split-string "a\r\nb" p)))
+    (should (equal '("a" "b") (split-string "a\nb" p)))
+    (should (equal '("a" "b") (split-string "a\rb" p)))
+
+    ;; one
+    (should (equal '("") (split-string "" p)))
+    (should (equal '("a" "" "b") (split-string "a\r\rb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\rb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\nb" p)))
+    (should (equal '("a" "" "b") (split-string "a\r\r\nb" p)))
+    (should (equal '("a" "" "b") (split-string "a\n\r\nb" p)))
+    (should (equal '("a" "") (split-string "a\n" p)))
+    (should (equal '("a" "") (split-string "a\r" p)))
+    (should (equal '("a" "") (split-string "a\r\n" p)))
+    (should (equal '("" "b") (split-string "\nb" p)))
+    (should (equal '("" "b") (split-string "\rb" p)))
+    (should (equal '("" "b") (split-string "\r\nb" p)))
+
+    ;; two
+    (should (equal '("" "") (split-string "\r" p)))
+    (should (equal '("" "") (split-string "\n" p)))
+    (should (equal '("" "") (split-string "\r\n" p)))
+
+    ;; three
+    (should (equal '("" "" "") (split-string "\r\r" p)))
+    (should (equal '("" "" "") (split-string "\n\n" p)))
+    (should (equal '("" "" "") (split-string "\n\r" p)))))
+
+(ert-deftest erc--blank-in-multiline-input-p ()
+  (ert-info ("With `erc-send-whitespace-lines'")
+    (let ((erc-send-whitespace-lines t))
+      (should (erc--blank-in-multiline-input-p ""))
+      (should (erc--blank-in-multiline-input-p "/msg a\n")) ; likely oops
+      (should (erc--blank-in-multiline-input-p "/msg a\n\nb")) ; "" not allowed
+      (should-not (erc--blank-in-multiline-input-p "a\n\nb")) ; "" allowed
+      (should-not (erc--blank-in-multiline-input-p " "))
+      (should-not (erc--blank-in-multiline-input-p "\t"))
+      (should-not (erc--blank-in-multiline-input-p "a\nb"))
+      (should-not (erc--blank-in-multiline-input-p "a\n "))
+      (should-not (erc--blank-in-multiline-input-p "a\n \t"))
+      (should-not (erc--blank-in-multiline-input-p "a\n \f"))
+      (should-not (erc--blank-in-multiline-input-p "a\n \nb"))
+      (should-not (erc--blank-in-multiline-input-p "a\n \t\nb"))
+      (should-not (erc--blank-in-multiline-input-p "a\n \f\nb"))))
+
+  (should (erc--blank-in-multiline-input-p ""))
+  (should (erc--blank-in-multiline-input-p " "))
+  (should (erc--blank-in-multiline-input-p "\t"))
+  (should (erc--blank-in-multiline-input-p "a\n\nb"))
+  (should (erc--blank-in-multiline-input-p "a\n\nb"))
+  (should (erc--blank-in-multiline-input-p "a\n "))
+  (should (erc--blank-in-multiline-input-p "a\n \t"))
+  (should (erc--blank-in-multiline-input-p "a\n \f"))
+  (should (erc--blank-in-multiline-input-p "a\n \nb"))
+  (should (erc--blank-in-multiline-input-p "a\n \t\nb"))
+
+  (should-not (erc--blank-in-multiline-input-p "a\rb"))
+  (should-not (erc--blank-in-multiline-input-p "a\nb"))
+  (should-not (erc--blank-in-multiline-input-p "a\r\nb")))
+
+(defun erc-tests--send-prep ()
+  (erc-mode)
+  (insert "\n\n")
+  (setq erc-input-marker (make-marker)
+        erc-insert-marker (make-marker))
+  (set-marker erc-insert-marker (point-max))
+  (erc-display-prompt)
+  (should (= (point) erc-input-marker)))
+
+(defun erc-tests--set-fake-server-process (&rest args)
+  (setq erc-server-process
+        (apply #'start-process (car args) (current-buffer) args))
+  (set-process-query-on-exit-flag erc-server-process nil))
+
+(defmacro erc-tests--with-process-input-spy (calls-var &rest body)
+  (declare (indent 1))
+  `(with-current-buffer (get-buffer-create "FakeNet")
+     (let ((erc-pre-send-functions
+            (remove #'erc-add-to-input-ring erc-pre-send-functions)) ; for now
+           (inhibit-message noninteractive)
+           (erc-server-current-nick "tester")
+           (erc-last-input-time 0)
+           erc-accidental-paste-threshold-seconds
+           ,calls-var)
+       (cl-letf (((symbol-function 'erc-process-input-line)
+                  (lambda (&rest r) (push r ,calls-var)))
+                 ((symbol-function 'erc-server-buffer)
+                  (lambda () (current-buffer))))
+         (erc-tests--send-prep)
+         ,@body))
+     (when noninteractive (kill-buffer))))
+
+(ert-deftest erc-check-prompt-input-functions ()
+  (erc-tests--with-process-input-spy calls
+
+    (ert-info ("Errors when point not in prompt area") ; actually just dings
+      (insert "/msg #chan hi")
+      (forward-line -1)
+      (let ((e (should-error (erc-send-current-line))))
+        (should (equal "Point is not in the input area" (cadr e))))
+      (goto-char (point-max))
+      (ert-info ("Input remains untouched")
+        (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+    (ert-info ("Errors when no process running")
+      (let ((e (should-error (erc-send-current-line))))
+        (should (equal "ERC: No process running" (cadr e))))
+      (ert-info ("Input remains untouched")
+        (should (save-excursion (erc-bol) (looking-at "/msg #chan hi")))))
+
+    (ert-info ("Errors when line contains empty newline")
+      (erc-bol)
+      (delete-region (point) (point-max))
+      (insert "one\n")
+      (let ((e (should-error (erc-send-current-line))))
+        (should (equal "Blank line - ignoring..." (cadr e))))
+      (goto-char (point-max))
+      (ert-info ("Input remains untouched")
+        (should (save-excursion (goto-char erc-input-marker)
+                                (looking-at "one\n")))))
+
+    (should (= 0 erc-last-input-time))
+    (should-not calls)))
+
+;; These also indirectly tests `erc-send-input'
+
+(ert-deftest erc-send-current-line ()
+  (erc-tests--with-process-input-spy calls
+
+    (erc-tests--set-fake-server-process "sleep" "1")
+    (should (= 0 erc-last-input-time))
+
+    (ert-info ("Simple command")
+      (insert "/msg #chan hi")
+      (erc-send-current-line)
+      (ert-info ("Prompt restored")
+        (forward-line 0)
+        (should (looking-at-p erc-prompt)))
+      (ert-info ("Input cleared")
+        (erc-bol)
+        (should (eq (point) (point-max))))
+      ;; Commands are forced (no flood protection)
+      (should (equal (pop calls) '("/msg #chan hi\n" t nil))))
+
+    (ert-info ("Simple non-command")
+      (insert "hi")
+      (erc-send-current-line)
+      (should (eq (point) (point-max)))
+      (should (save-excursion (forward-line -1)
+                              (search-forward "<tester> hi")))
+      ;; Non-ommands are forced only when `erc-flood-protect' is nil
+      (should (equal (pop calls) '("hi\n" nil t))))
+
+    (should (consp erc-last-input-time))))
+
+(ert-deftest erc-send-whitespace-lines ()
+  (erc-tests--with-process-input-spy calls
+
+    (erc-tests--set-fake-server-process "sleep" "1")
+    (setq-local erc-send-whitespace-lines t)
+
+    (ert-info ("Multiline hunk with blank line correctly split")
+      (insert "one\n\ntwo")
+      (erc-send-current-line)
+      (ert-info ("Prompt restored")
+        (forward-line 0)
+        (should (looking-at-p erc-prompt)))
+      (ert-info ("Input cleared")
+        (erc-bol)
+        (should (eq (point) (point-max))))
+      (should (equal (pop calls) '("two\n" nil t)))
+      (should (equal (pop calls) '("\n" nil t)))
+      (should (equal (pop calls) '("one\n" nil t))))
+
+    (ert-info ("Multiline hunk with trailing blank filtered")
+      (insert "hi\n")
+      (erc-send-current-line)
+      (ert-info ("Input cleared")
+        (erc-bol)
+        (should (eq (point) (point-max))))
+      (should (equal (pop calls) '("hi\n" nil t)))
+      (should-not (pop calls)))
+
+    (ert-info ("Multiline hunk with trailing whitespace not filtered")
+      (insert "there\n ")
+      (erc-send-current-line)
+      (should (equal (pop calls) '(" \n" nil t)))
+      (should (equal (pop calls) '("there\n" nil t)))
+      (should-not (pop calls)))))
 
 ;; The point of this test is to ensure output is handled identically
 ;; regardless of whether a command handler is summoned.
-- 
2.35.1


^ permalink raw reply related	[flat|nested] 17+ messages in thread
[parent not found: <ADC23CE3-E6A4-4FF8-B033-174F60B2D59E@getmailspring.com>]
[parent not found: <87y20m7xzs.fsf@neverwas.me>]
end of thread, other threads:[~2022-05-18  1:34 UTC | newest]

Thread overview: 17+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2022-03-23 13:26 29.0.50; Improve ERC's handling of multiline prompt input J.P.
2022-03-23 13:50 ` bug#54536: " Lars Ingebrigtsen
     [not found] ` <87czic93sa.fsf@gnus.org>
2022-03-24 19:50   ` J.P.
2022-03-24 20:16     ` Michael Albinus
     [not found]     ` <8735j7jecz.fsf@gmx.de>
2022-03-24 23:38       ` J.P.
     [not found]       ` <87tubm53ar.fsf@neverwas.me>
2022-03-25 15:29         ` Lars Ingebrigtsen
     [not found]         ` <874k3mf3th.fsf@gnus.org>
2022-03-25 19:23           ` J.P.
2022-03-26 16:44             ` Lars Ingebrigtsen
     [not found]   ` <87ee2rb04e.fsf@neverwas.me>
2022-03-25 15:31     ` Lars Ingebrigtsen
     [not found]     ` <87zgledp6a.fsf@gnus.org>
2022-03-25 19:20       ` J.P.
2022-04-23  3:17 ` J.P.
2022-04-29 13:05 ` J.P.
2022-05-17 13:10 ` J.P.
     [not found] ` <874k1os3te.fsf@neverwas.me>
2022-05-17 22:48   ` Will Mengarini via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]   ` <YoQmVCugPRXY58eO@eskimo.com>
2022-05-18  1:34     ` J.P.
     [not found] <ADC23CE3-E6A4-4FF8-B033-174F60B2D59E@getmailspring.com>
2022-04-03 19:44 ` J.P.
     [not found] <87y20m7xzs.fsf@neverwas.me>
2022-04-03 20:15 ` Matheus Fillipe

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).