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