procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into master-android-1

Browse source
This commit is contained in:
Po Lu 2023-10-03 08:59:31 +08:00
commit 3f0461e539
12 changed files with 330 additions and 141 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
etc/ERC-NEWS
View file

@ -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.

1
lisp/erc/erc-common.el
View file

@ -60,6 +60,7 @@
((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)

15
lisp/erc/erc-compat.el
View file

@ -444,6 +444,21 @@ If START or END is negative, it counts from the end."
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
;; `time-less-p' and friends do
;;
;; message("obsolete timestamp with cdr ...", ...)
;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
;; lisp_time_struct(...)
;; time_cmp(...)
;;
;; which spams *Messages* (and stderr when running the test suite).
(defmacro erc-compat--current-lisp-time ()
"Return `current-time' as a (TICKS . HZ) pair on 29+."
(if (>= emacs-major-version 29)
'(let (current-time-list) (current-time))
'(current-time)))
(provide 'erc-compat)

5
lisp/erc/erc-fill.el
View file

@ -158,9 +158,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
(when (or erc-fill--function erc-fill-function)
;; skip initial empty lines
(goto-char (point-min))
(save-match-data
(while (and (looking-at "[ \t\n]*$")
(= (forward-line 1) 0))))
(while (and (looking-at (rx bol (* (in " \t")) eol))
(zerop (forward-line 1))))
(unless (eobp)
(save-restriction
(narrow-to-region (point) (point-max))

14
lisp/erc/erc-goodies.el
View file

@ -128,6 +128,11 @@ may be nil, is the number of lines between `window-start' and
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 @@ unnarrowed."
((= (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 ()
@ -372,7 +378,7 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
;;;###autoload(autoload 'erc-keep-place-mode "erc-goodies" nil t)
(define-erc-module keep-place nil
"Leave point above un-viewed text in other channels."
((add-hook 'erc-insert-pre-hook #'erc-keep-place 85))
((add-hook 'erc-insert-pre-hook #'erc-keep-place 65))
((remove-hook 'erc-insert-pre-hook #'erc-keep-place)))
(defcustom erc-keep-place-indicator-style t
@ -467,7 +473,7 @@ and `keep-place-indicator' in different buffers."
((memq 'keep-place erc-modules)
(erc-keep-place-mode +1))
;; Enable a local version of `keep-place-mode'.
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t)))
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
(if (pcase erc-keep-place-indicator-buffer-type
('target erc--target)
('server (not erc--target))
@ -490,7 +496,7 @@ That is, ensure the local module can survive a user toggling the
global one."
(if erc-keep-place-mode
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t)))
(add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.

16
lisp/erc/erc-ibuffer.el
View file

@ -27,6 +27,9 @@
;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new
;; limiting commands
;; This library does not contain a module, but you can `require' it
;; after loading `erc' to make use of its functionality.
;;; Code:
(require 'ibuffer)
@ -118,11 +121,11 @@
(define-ibuffer-column
erc-members (:name "Users")
(if (and (eq major-mode 'erc-mode)
(boundp 'erc-channel-users)
(hash-table-p erc-channel-users)
(> (hash-table-size erc-channel-users) 0))
(number-to-string (hash-table-size erc-channel-users))
(if-let ((table (or erc-channel-users erc-server-users))
((hash-table-p table))
(count (hash-table-count table))
((> count 0)))
(number-to-string count)
""))
(define-ibuffer-column erc-away (:name "A")
@ -177,8 +180,7 @@
(defvar erc-ibuffer-limit-map nil
"Prefix keymap to use for ERC related limiting.")
(define-prefix-command 'erc-ibuffer-limit-map)
;; FIXME: Where is `ibuffer-limit-by-erc-server' defined?
(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server)
(define-key 'erc-ibuffer-limit-map (kbd "s") #'ibuffer-filter-by-erc-server)
(define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map)
(provide 'erc-ibuffer)

2
lisp/erc/erc-stamp.el
View file

@ -215,7 +215,7 @@ the stamp passed to `erc-insert-timestamp-function'.")
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
This becomes the message's `erc-timestamp' text property."
(let (current-time-list) (current-time)))
(erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))

166
lisp/erc/erc.el
View file

@ -252,7 +252,14 @@ node `(auth) Top' and Info node `(erc) auth-source'.")
: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)
@ -264,8 +271,8 @@ node `(auth) Top' and Info node `(erc) auth-source'.")
(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))
@ -1095,9 +1102,10 @@ subprotocols should probably be handled manually."
(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
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
@ -6424,20 +6432,6 @@ holds off on submitting it, for obvious reasons."
(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
@ -6457,13 +6451,78 @@ is empty or consists of one or more spaces, tabs, or form-feeds."
(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 empty
\"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))
@ -6484,25 +6543,39 @@ is empty or consists of one or more spaces, tabs, or form-feeds."
(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))))
(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--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."
@ -6526,8 +6599,9 @@ When the returned value is a string, ERC passes it to `erc-error'.")
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
@ -6556,12 +6630,11 @@ When the returned value is a string, ERC passes it to `erc-error'.")
(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)))))
@ -6581,7 +6654,7 @@ multiline input. Optionally readjust lines to protocol length
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"))
@ -6612,9 +6685,8 @@ queue. Expect LINES-OBJ to be an `erc--input-split' object."
"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))))))

4
test/lisp/erc/erc-scenarios-scrolltobottom.el
View file

@ -35,7 +35,7 @@
(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 @@
(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)))

189
test/lisp/erc/erc-tests.el
View file

@ -292,7 +292,7 @@
(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 @@
(should (= (point) erc-input-marker))
(insert "/query bob")
(erc-send-current-line)
;; Last command not inserted
(save-excursion (forward-line -1)
(should (looking-at "<tester> 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 @@
(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 @@
(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 @@
(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 @@
(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-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")
@ -1218,17 +1316,12 @@
(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")

48
test/lisp/erc/resources/erc-d/erc-d.el
View file

@ -254,7 +254,7 @@ return a replacement.")
(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 @@ With int SKIP, advance past that many exchanges."
(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))))
(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))))
(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--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)))

3
test/lisp/erc/resources/erc-scenarios-common.el
View file

@ -341,7 +341,7 @@ See Info node `(emacs) Term Mode' for the various commands."
;;;; 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 @@ See Info node `(emacs) Term Mode' for the various commands."
(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)))