Re: bug#64855: 30.0.50; ERC 5.6: Make scrolltobottom less erratic
"J.P." <[email protected]>
| Newsgroups | gmane.emacs.erc.general |
|---|---|
| Message-ID | <[email protected]> |
v5. Make new behavior hinge on new option, disabled by default. Assign some module functions explicit hook depths. Add news and tests.
0000-v4-v5.diff
(text/x-patch, 47 KB)
From 3ed5a748d76989ec2ed79311e3550da5c6d1aaa1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Thu, 24 Aug 2023 06:49:46 -0700 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [5.6] Consider all windows in erc-scrolltobottom-mode etc/ERC-NEWS | 19 +- lisp/erc/erc-backend.el | 2 +- lisp/erc/erc-goodies.el | 267 ++++++++++++++++-- .../erc/erc-scenarios-scrolltobottom-all.el | 48 ++++ .../erc-scenarios-scrolltobottom-relaxed.el | 140 +++++++++ test/lisp/erc/erc-scenarios-scrolltobottom.el | 44 +++ .../erc/resources/base/assoc/bumped/again.eld | 10 +- .../resources/base/assoc/bumped/foisted.eld | 10 +- .../resources/base/assoc/bumped/refoisted.eld | 8 +- .../resources/base/netid/bouncer/barnet.eld | 2 +- .../resources/base/netid/bouncer/foonet.eld | 2 +- test/lisp/erc/resources/erc-d/erc-d-t.el | 7 +- .../erc/resources/erc-scenarios-common.el | 196 +++++++++++++ .../erc/resources/scrolltobottom/help.eld | 46 +++ 14 files changed, 761 insertions(+), 40 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom-all.el create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom.el create mode 100644 test/lisp/erc/resources/scrolltobottom/help.eld Interdiff: diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 94452514e6d..72b768b02ec 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -178,6 +178,15 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** Module 'scrolltobottom' attempts to behave more sensibly. +Enabling the experimental option 'erc-scrolltobottom-all' tells +'scrolltobottom' to be more vigilant about recentering and to do so in +all ERC windows. The dependent option 'erc-scrolltobottom-relaxed', +likewise experimental, makes ERC's prompt stationary wherever it +resides instead of forcing it to the bottom of the window. That is, +new input appears above the prompt, scrolling existing messages upward +to compensate. + ** Subtle changes in two fundamental faces. Users of the default theme may notice that 'erc-action-face' and 'erc-notice-face' now appear slightly less bold on systems supporting @@ -232,9 +241,9 @@ property of the same name has been retained and now has a value of Built-in and third-party modules rely on certain hooks for adjusting incoming and outgoing messages upon insertion. And some modules only want to do so after others have done their damage. Traditionally, -this required various hacks and finagling to achieve. And while this -release makes an effort to load modules in a more consistent order, -that alone isn't enough to ensure similar predictability among +this has required various hacks and finagling to achieve. And while +this release makes an effort to load modules in a more consistent +order, that alone isn't enough to ensure similar predictability among essential members of important hooks. Luckily, ERC now leverages a feature introduced in Emacs 27, "hook @@ -248,6 +257,10 @@ the first two, 'erc-button-add-buttons' and 'erc-fill', which have been swapped with respect to their previous places in recent ERC versions. +The same depth interval is now also provisionally reserved for +'erc-insert-pre-hook' and for the non-ERC hooks 'pre-command-hook' and +'post-command-hook', but only locally, in ERC buffers. + *** ERC now manages timestamp-related properties a bit differently. For starters, the 'cursor-sensor-functions' property no longer contains unique closures and thus no longer proves effective for diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index eb3ec39fedd..9e121ec1e92 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1089,7 +1089,7 @@ erc--hide-prompt (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt 'hidden) (erc--conceal-prompt)) - (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t)))) + (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t)))) (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 30089915c19..07a93b06f2c 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -50,19 +50,31 @@ erc-input-line-position :group 'erc-display :type '(choice integer (const nil))) +(defcustom erc-scrolltobottom-all nil + "Whether to scroll all windows or just the selected one. +A value of nil preserves pre-5.6 behavior, in which scrolling +only affects the selected window. Users should consider its +non-nil behavior experimental for the time being. Note also that +ERC expects this option to be configured before module +initialization." + :group 'erc-display + :package-version '(ERC . "5.6") ; FIXME sync on release + :type 'boolean) + (defcustom erc-scrolltobottom-relaxed nil "Whether to forgo forcing prompt to the bottom of the window. When non-nil, and point is at the prompt, ERC scrolls the window up when inserting messages, making the prompt appear stationary. Users who find this effect too \"stagnant\" can adjust the option `erc-input-line-position', which ERC borrows to express a scroll -offset when this option is non-nil. Setting that value to zero -lets the prompt drift toward the bottom by one line per message, -which is generally slow enough not to distract while composing -input. Of course, this doesn't apply when receiving a large -influx of messages, such as after typing \"/msg NickServ help\". -Note that ERC only considers this option when initializing the -`scrolltobottom' module and enabling `erc-scrolltobottom-mode'." +step offset when this option is non-nil. Setting that value to +zero lets the prompt drift toward the bottom by one line per +message, which is generally slow enough not to distract while +composing input. Of course, this doesn't apply when receiving a +large influx of messages, such as after typing \"/msg NickServ +help\". Note that ERC only considers this option when the +experimental companion option `erc-scrolltobottom-all' is enabled +and, only then, during module setup." :group 'erc-display :package-version '(ERC . "5.6") ; FIXME sync on release :type 'boolean) @@ -70,18 +82,25 @@ erc-scrolltobottom-relaxed ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." - ((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) - (add-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) - (add-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) - (add-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) - (add-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) - (unless erc--updating-modules-p (erc-buffer-do #'erc-add-scroll-to-bottom))) - ((remove-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) - (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) - (remove-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) - (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) - (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) - (erc-buffer-do #'erc-add-scroll-to-bottom))) + ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) + (if erc-scrolltobottom-all + (progn + (add-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert 25) + (add-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) + (add-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (add-hook 'erc-send-completed-hook #'erc--scrolltobottom-all)) + (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) + ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) + (erc-buffer-do #'erc--scrolltobottom-setup) + (if erc-scrolltobottom-all + (progn + (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-pre-send-functions + #'erc--scrolltobottom-on-pre-insert)) + (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)))) (defun erc-possibly-scroll-to-bottom () "Like `erc-add-scroll-to-bottom', but only if window is selected." @@ -100,8 +119,12 @@ erc--scrolltobottom-window-info `window-point', inclusive.") (defvar erc--scrolltobottom-post-force-commands - '(electric-newline-and-maybe-indent default-indent-new-line) - "Commands that force a scroll after execution at prompt.") + '(beginning-of-buffer + electric-newline-and-maybe-indent + default-indent-new-line) + "Commands that force a scroll after execution at prompt. +That is, ERC recalculates the window's start instead of blindly +restoring it.") (defvar erc--scrolltobottom-relaxed-skip-commands '(recenter-top-bottom scroll-down-command)) @@ -112,7 +135,7 @@ erc--scrolltobottom-on-pre-command (setq erc--scrolltobottom-window-info (list (list (selected-window) (window-start) - (count-screen-lines (window-start) (point))))))) + (count-screen-lines (window-start) (point-max))))))) (defun erc--scrolltobottom-on-post-command () "Restore window start or scroll to prompt and recenter. @@ -127,7 +150,8 @@ erc--scrolltobottom-on-post-command ((eq (car found) (selected-window))) ((not (memq this-command erc--scrolltobottom-post-force-commands))) - ((= (nth 2 found) (count-screen-lines (window-start) (point))))) + ((= (nth 2 found) + (count-screen-lines (window-start) (point-max))))) (set-window-start (selected-window) (nth 1 found)) (erc--scrolltobottom-confirm)) (setq erc--scrolltobottom-window-info nil))) @@ -137,8 +161,9 @@ erc--scrolltobottom-on-pre-command-relaxed When `erc-scrolltobottom-relaxed' is active, only scroll when prompt is past window's end and the command is `end-of-buffer' or `self-insert-command' (assuming `move-to-prompt' is active). -When at prompt and current command is not `recenter-top-bottom', -stash `erc--scrolltobottom-window-info' for the selected window." +When at prompt and current command does not appear in +`erc--scrolltobottom-relaxed-skip-commands', stash +`erc--scrolltobottom-window-info' for the selected window." (when (eq (selected-window) (get-buffer-window)) (when (and (not (input-pending-p)) (< (point) erc-input-marker) @@ -175,7 +200,9 @@ erc--scrolltobottom-on-post-command-relaxed ;; that may not be worth the added bookkeeping. (defun erc--scrolltobottom-away-from-prompt () "Scroll to bottom unless at prompt." - (unless (input-pending-p) + (unless (or (input-pending-p) + (minibuffer-window-active-p (minibuffer-window)) + (eq (old-selected-window) (minibuffer-window))) (erc--scrolltobottom-confirm))) (defun erc--scrolltobottom-all (&rest _) @@ -195,8 +222,7 @@ erc--scrolltobottom-all (setq erc--scrolltobottom-window-info nil)) (defun erc-add-scroll-to-bottom () - "Arrange for scrolling to bottom on window configuration changes. -Undo that arrangement when disabling `erc-scrolltobottom-mode'. + "A hook function for `erc-mode-hook' to recenter output at bottom of window. If you find that ERC hangs when using this function, try customizing the value of `erc-input-line-position'. @@ -204,24 +230,35 @@ erc-add-scroll-to-bottom Note that the prior suggestion comes from a time when this function used `window-scroll-functions', which was replaced by `post-command-hook' in ERC 5.3." + (declare (obsolete erc--scrolltobottom-setup "30.1")) + (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)) + +(cl-defgeneric erc--scrolltobottom-setup () + "Arrange for scrolling to bottom on window configuration changes. +Undo that arrangement when disabling `erc-scrolltobottom-mode'." (if erc-scrolltobottom-mode - (progn + (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t) + (remove-hook 'post-command-hook #'erc-scroll-to-bottom t))) + +(cl-defmethod erc--scrolltobottom-setup (&context + (erc-scrolltobottom-all (eql t))) + (if erc-scrolltobottom-mode + (if erc-scrolltobottom-relaxed + (progn + (when (or (bound-and-true-p erc-move-to-prompt-mode) + (memq 'move-to-prompt erc-modules)) + (cl-pushnew 'self-insert-command + erc--scrolltobottom-relaxed-commands)) + (add-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command-relaxed 60 t) + (add-hook 'pre-command-hook ; preempt `move-to-prompt' + #'erc--scrolltobottom-on-pre-command-relaxed 60 t)) (add-hook 'window-configuration-change-hook #'erc--scrolltobottom-away-from-prompt nil t) - (if erc-scrolltobottom-relaxed - (progn - (when (or (bound-and-true-p erc-move-to-prompt-mode) - (memq 'move-to-prompt erc-modules)) - (cl-pushnew 'self-insert-command - erc--scrolltobottom-relaxed-commands)) - (add-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command-relaxed 60 t) - (add-hook 'pre-command-hook ; preempt `move-to-prompt' - #'erc--scrolltobottom-on-pre-command-relaxed 60 t)) - (add-hook 'pre-command-hook - #'erc--scrolltobottom-on-pre-command 60 t) - (add-hook 'post-command-hook - #'erc--scrolltobottom-on-post-command 60 t))) + (add-hook 'pre-command-hook + #'erc--scrolltobottom-on-pre-command 60 t) + (add-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command 60 t)) (remove-hook 'window-configuration-change-hook #'erc--scrolltobottom-away-from-prompt t) (remove-hook 'pre-command-hook @@ -255,9 +292,9 @@ erc--scrolltobottom-on-pre-insert (defun erc--scrolltobottom-confirm (&optional scroll-to) "Like `erc-scroll-to-bottom', but use `window-point'. -Expect to run in some window, not necessarily the user-selected -one. Scroll to SCROLL-TO (or 0) lines from the window's top. -Return non-nil when recentering has occurred." +Position current line (with `recenter') SCROLL-TO lines below +window's top. Return nil if point is not in prompt area or if +prompt isn't ready." (when erc-insert-marker (let ((resize-mini-windows nil)) (save-restriction @@ -332,7 +369,7 @@ erc-move-to-prompt-setup ;;;###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)) + ((add-hook 'erc-insert-pre-hook #'erc-keep-place 85)) ((remove-hook 'erc-insert-pre-hook #'erc-keep-place))) (defcustom erc-keep-place-indicator-style t @@ -427,7 +464,7 @@ keep-place-indicator ((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 90 t))) + (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t))) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) @@ -450,7 +487,7 @@ erc--keep-place-indicator-on-global-module 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 90 t))) + (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t))) (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-all.el b/test/lisp/erc/erc-scenarios-scrolltobottom-all.el new file mode 100644 index 00000000000..33f232e64d9 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-all.el @@ -0,0 +1,48 @@ +;;; erc-scenarios-scrolltobottom-all.el --- erc-scrolltobottom-all test -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--all () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (let ((erc-scrolltobottom-all t)) + + (erc-scenarios-scrolltobottom--normal + (lambda () + (ert-info ("New insertion anchors prompt in other window") + (let ((w (next-window))) + ;; We're at prompt and aligned to bottom. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (erc-scenarios-common--at-win-end-p w)) + (erc-d-t-ensure-for 0.5 + (erc-scenarios-common--at-win-end-p w)))))))) + +;;; erc-scenarios-scrolltobottom-all.el ends here diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el new file mode 100644 index 00000000000..7d256bf711b --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el @@ -0,0 +1,140 @@ +;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-relaxed -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;; TODO assert behavior of prompt input spanning multiple lines, with +;; and without line endings. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--relaxed () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "scrolltobottom") + (dumb-server (erc-d-run "localhost" t 'help)) + (port (process-contact dumb-server :service)) + (erc-modules `(scrolltobottom fill-wrap ,@erc-modules)) + (erc-scrolltobottom-all t) + (erc-scrolltobottom-relaxed t) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter)) + lower upper) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer "foonet" + (should (looking-at " and")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + (split-window-below 15) + (recenter 0) + + (ert-info ("Moving into prompt does not trigger scroll") + (with-selected-window (next-window) + (should-not (erc-scenarios-common--at-win-end-p)) + (recenter 0) + (goto-char (1- erc-insert-marker)) + (execute-kbd-macro "\C-n") + (should-not (erc-scenarios-common--at-win-end-p)) + (should (= (point) (point-max))) + (setq lower (count-screen-lines (window-start) (window-point))))) + + (ert-info ("Module `move-to-prompt' still works") + ;; Prompt is somewhere in the middle of the window. + (should (erc-scenarios-common--above-win-end-p)) + (should-not (= (point-max) (point))) + ;; Hitting a self-insert key triggers `move-to-prompt' but not + ;; a scroll (to bottom). + (execute-kbd-macro "hi") + ;; Prompt and input appear on same line. + (should (= (point-max) (point))) + (setq upper (count-screen-lines (window-start) (window-point))) + (should-not (= upper (window-body-height)))) + + (ert-info ("Command `recenter-top-bottom' allowed at prompt") + ;; Hitting C-l recenters the window. + (should (= upper (count-screen-lines (window-start) (window-point)))) + (let ((lines (list upper))) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (setq lines (delete-dups lines)) + (should (= (length lines) 4)))) + + (ert-info ("Command `beginning-of-buffer' allowed at prompt") + ;; Hitting C-< goes to beginning of buffer. + (execute-kbd-macro "\M-<") + (should (= 1 (point))) + (redisplay) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New message doesn't trigger scroll when away from prompt") + ;; Arriving insertions don't trigger a scroll when away from the + ;; prompt. New output not seen. + (erc-cmd-MSG "NickServ help register") + (save-excursion (erc-d-t-search-for 10 "End of NickServ")) + (should (= 1 (point))) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New insertion keeps prompt stationary in other window") + (let ((w (next-window))) + ;; We're at prompt and completely stationary. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (= lower (count-screen-lines (window-start w) (window-point w)))) + (erc-d-t-ensure-for 0.5 + (= lower (count-screen-lines (window-start w) + (window-point w)))))) + + (should (= 2 (length (window-list)))) + (ert-info ("New message does not trigger a scroll when at prompt") + ;; Recenter so prompt is above rather than at window's end. + (funcall expect 10 "End of NickServ HELP") + (recenter 0) + (set-window-point nil (point-max)) + (setq upper (count-screen-lines (window-start) (window-point))) + ;; Prompt is somewhere in the middle of the window. + (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p)) + (erc-scenarios-common-say "/msg NickServ help identify") + ;; New arriving messages don't move prompt. + (erc-d-t-ensure-for 1 + (= upper (count-screen-lines (window-start) (window-point)))) + (funcall expect 10 "IDENTIFY lets you login"))))) + +;;; erc-scenarios-scrolltobottom-relaxed.el ends here diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el new file mode 100644 index 00000000000..44e64204fb1 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -0,0 +1,44 @@ +;;; erc-scenarios-scrolltobottom.el --- erc-scrolltobottom-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--normal () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (erc-scenarios-scrolltobottom--normal + (lambda () + (ert-info ("New insertion doesn't anchor prompt in other window") + (let ((w (next-window))) + ;; We're at prompt but not aligned to bottom. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (not (erc-scenarios-common--at-win-end-p w)))))))) + +;;; erc-scenarios-scrolltobottom.el ends here diff --git a/test/lisp/erc/resources/base/assoc/bumped/again.eld b/test/lisp/erc/resources/base/assoc/bumped/again.eld index ab3c7b06214..aef164b6237 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/again.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/again.eld @@ -1,10 +1,10 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account") (0.0 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account")) -((nick 3 "NICK tester`") +((nick 10 "NICK tester`") (0.1 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`") (0.0 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 tester` :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -21,10 +21,10 @@ (0.2 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3") (0.0 ":irc.foonet.org 422 tester` :MOTD File is missing")) -((mode-user 3.2 "MODE tester` +i") +((mode-user 10 "MODE tester` +i") (0.0 ":irc.foonet.org 221 tester` +i") (0.0 ":irc.foonet.org NOTICE tester` :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((privmsg 42.6 "PRIVMSG NickServ :IDENTIFY tester changeme") +((privmsg 10 "PRIVMSG NickServ :IDENTIFY tester changeme") (0.01 ":tester`[email protected] NICK tester") (0.0 ":NickServ!NickServ@localhost NOTICE tester :You're now logged in as tester")) diff --git a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld index 5c36e58d9d3..0f7aadac564 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld @@ -1,6 +1,6 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 tester :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -17,14 +17,14 @@ (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0.0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 1.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0.0 ":irc.foonet.org 221 tester +i") (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((privmsg 17.21 "PRIVMSG bob :hi") +((privmsg 10 "PRIVMSG bob :hi") (0.02 ":[email protected] PRIVMSG tester :hola") (0.01 ":[email protected] PRIVMSG tester :how r u?")) -((quit 18.19 "QUIT :" quit) +((quit 10 "QUIT :" quit) (0.01 ":[email protected] QUIT :Quit: " quit)) ((drop 1 DROP)) diff --git a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld index 33e4168ac46..63366d3f576 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld @@ -1,6 +1,6 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.1 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy") (0.0 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 dummy :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -22,10 +22,10 @@ (0.01 ":[email protected] PRIVMSG dummy :back?") ) -((mode-user 1.2 "MODE dummy +i") +((mode-user 10 "MODE dummy +i") (0.0 ":irc.foonet.org 221 dummy +i") (0.0 ":irc.foonet.org NOTICE dummy :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((renick 42.6 "NICK tester") +((renick 10 "NICK tester") (0.01 ":[email protected] NICK tester") (0.0 ":NickServ!NickServ@localhost NOTICE dummy :You're now logged in as tester")) diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld index 204d01fef77..596383c2699 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld @@ -38,4 +38,4 @@ (0.05 ":[email protected] PRIVMSG #chan :mike: As he regards his aged father's life.") (0.05 ":[email protected] PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) -((linger 1 LINGER)) +((linger 2 LINGER)) diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld index 4445350ca0c..2e1a3ac27da 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld @@ -43,4 +43,4 @@ (0.1 ":[email protected] PRIVMSG #chan :bob: Orlando, my liege; the youngest son of Sir Rowland de Boys.") (0.1 ":[email protected] PRIVMSG #chan :alice: The ape is dead, and I must conjure him.")) -((linger 1 LINGER)) +((linger 2 LINGER)) diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el index 7b2adf4f07b..cf869fb3c70 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-t.el +++ b/test/lisp/erc/resources/erc-d/erc-d-t.el @@ -83,6 +83,8 @@ erc-d-t-with-cleanup (ignore-errors (kill-buffer buf))))) (sleep-for erc-d-t-cleanup-sleep-secs))))) +(defvar erc-d-t--wait-message-prefix "Awaiting: ") + (defmacro erc-d-t-wait-for (max-secs msg &rest body) "Wait for BODY to become non-nil. Or signal error with MSG after MAX-SECS. When MAX-SECS is negative, @@ -99,7 +101,7 @@ erc-d-t-wait-for (let ((inverted (make-symbol "inverted")) (time-out (make-symbol "time-out")) (result (make-symbol "result"))) - `(ert-info ((concat "Awaiting: " ,msg)) + `(ert-info ((concat erc-d-t--wait-message-prefix ,msg)) (let ((,time-out (abs ,max-secs)) (,inverted (< ,max-secs 0)) (,result ',result)) @@ -120,7 +122,8 @@ erc-d-t-ensure-for (unless (or (stringp msg) (memq (car-safe msg) '(format concat))) (push msg body) (setq msg (prin1-to-string body))) - `(erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body)))) + `(let ((erc-d-t--wait-message-prefix "Sustaining: ")) + (erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body))))) (defun erc-d-t-search-for (timeout text &optional from on-success) "Wait for TEXT to appear in current buffer before TIMEOUT secs. diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 972faa5c73f..b92acdd81e8 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -183,6 +183,103 @@ erc-scenarios-common-with-cleanup ,@body))) +(defvar erc-scenarios-common--term-size '(34 . 80)) +(declare-function term-char-mode "term" nil) +(declare-function term-line-mode "term" nil) + +(defun erc-scenarios-common--run-in-term (&optional debug) + (require 'term) + (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY")) + (emacs (expand-file-name invocation-name invocation-directory)) + (process-environment (cons "HOME=/nonexistent" + (cons "ERC_TESTS_SUBPROCESS=1" + process-environment))) + (name (ert-test-name (ert-running-test))) + (temp-file (make-temp-file "erc-term-test-")) + (cmd `(let ((stats 1)) + (setq enable-dir-local-variables nil) + (unwind-protect + (setq stats (ert-run-tests-batch ',name)) + (unless ',debug + (let ((buf (with-current-buffer (messages-buffer) + (buffer-string)))) + (with-temp-file ,temp-file + (insert buf))) + (kill-emacs (ert-stats-completed-unexpected stats)))))) + ;; The `ert-test' object in Emacs 29 has a `file-name' field. + (file-name (symbol-file name 'ert--test)) + (default-directory (expand-file-name (file-name-directory file-name))) + (package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) + (intern found) + 'erc)) + ;; This is for testing ERC's ELPA-package on older Emacsen we + ;; still support. It won't run inside the emacs.git tree. + (setup (and (featurep 'compat) + `(progn + (require 'package) + (let ((package-load-list '((compat t) (,package t)))) + (package-initialize))))) + ;; Make subprocess terminal bigger than controlling. + (buf (cl-letf (((symbol-function 'window-screen-lines) + (lambda () (car erc-scenarios-common--term-size))) + ((symbol-function 'window-max-chars-per-line) + (lambda () (cdr erc-scenarios-common--term-size)))) + (make-term (symbol-name name) emacs nil "-Q" "-nw" + "-eval" (prin1-to-string setup) + "-l" file-name "-eval" (format "%S" cmd)))) + (proc (get-buffer-process buf)) + (err (lambda () + (with-temp-buffer + (insert-file-contents temp-file) + (message "Subprocess: %s" (buffer-string)) + (delete-file temp-file))))) + (set-window-buffer (selected-window) buf) + (delete-other-windows) + (with-current-buffer buf + (set-process-query-on-exit-flag proc nil) + (unless noninteractive (term-char-mode)) + (with-timeout (30 (funcall err) (error "Timed out awaiting result")) + (while (process-live-p proc) + (accept-process-output proc 0.1) + (unless noninteractive + (redisplay)))) + (while (accept-process-output proc)) + (term-line-mode) + (goto-char (point-min)) + ;; Otherwise gives process exited abnormally with exit-code >0 + (unless (search-forward (format "Process %s finished" name) nil t) + (funcall err) + (ert-fail (when (search-forward "exited" nil t) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))))) + (delete-file temp-file) + (when noninteractive + (kill-buffer))))) + +(defvar erc-scenarios-common-interactive-debug-term-p nil + "When non-nil, run interactive ") + +(defmacro erc-scenarios-common-with-noninteractive-in-term (&rest body) + "Run BODY via `erc-scenarios-common-with-cleanup' in a `term' subprocess. +Also do so when `erc-scenarios-common-interactive-debug-term-p' +is non-nil. When debugging, leave the `term-mode' buffer around +for inspection and name it after the test, bounded by asterisks. +When debugging, ensure the test always fails, as a reminder to +disable `erc-scenarios-common-interactive-debug-term-p'. + +See Info node `(emacs) Term Mode' for the various commands." + (declare (indent 1)) + `(if (and (or erc-scenarios-common-interactive-debug-term-p + noninteractive) + (not (getenv "ERC_TESTS_SUBPROCESS"))) + (progn + (when (memq system-type '(windows-nt ms-dos)) + (ert-skip "System must be UNIX")) + (erc-scenarios-common--run-in-term + erc-scenarios-common-interactive-debug-term-p)) + (erc-scenarios-common-with-cleanup ,@body))) + (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given (should (string= (if id @@ -209,9 +306,108 @@ erc-scenarios-common-say (insert str) (erc-send-current-line))) +(defun erc-scenarios-common--at-win-end-p (&optional window) + (= (window-body-height window) + (count-screen-lines (window-start window) (point-max) nil window))) + +(defun erc-scenarios-common--above-win-end-p (&optional window) + (> (window-body-height window) + (count-screen-lines (window-start window) (point-max)))) + +(defun erc-scenarios-common--prompt-past-win-end-p (&optional window) + (< (window-body-height window) + (count-screen-lines (window-start window) (point-max)))) + +(defun erc-scenarios-common--recenter-top-bottom-around (orig &rest args) + (let (this-command last-command) (apply orig args))) + +(defun erc-scenarios-common--recenter-top-bottom () + (advice-add 'recenter-top-bottom + :around #'erc-scenarios-common--recenter-top-bottom-around) + (execute-kbd-macro "\C-l") + (advice-remove 'recenter-top-bottom + #'erc-scenarios-common--recenter-top-bottom-around)) + ;;;; Fixtures +(defun erc-scenarios-scrolltobottom--normal (test) + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "scrolltobottom") + (dumb-server (erc-d-run "localhost" t 'help)) + (port (process-contact dumb-server :service)) + (erc-modules `(scrolltobottom fill-wrap ,@erc-modules)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer "foonet" + (should (looking-at " and")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + (split-window-below 15) + (recenter 0) + + (ert-info ("Moving into prompt in other window triggers scroll") + (with-selected-window (next-window) + (should-not (erc-scenarios-common--at-win-end-p)) + (goto-char (1- erc-insert-marker)) + (execute-kbd-macro "\C-n") + ;; Ensure point is at prompt and aligned to bottom. + (should (erc-scenarios-common--at-win-end-p)))) + + (ert-info ("Module `move-to-prompt' still works") + ;; Prompt is somewhere in the middle of the window. + (should (erc-scenarios-common--above-win-end-p)) + ;; Hitting a self-insert key triggers `move-to-prompt' as well + ;; as a scroll (to bottom). + (execute-kbd-macro "hi") + ;; Prompt and input appear on last line of window. + (should (erc-scenarios-common--at-win-end-p))) + + (ert-info ("Command `recenter-top-bottom' disallowed at prompt") + ;; Hitting C-l does not recenter the window. + (erc-scenarios-common--recenter-top-bottom) + (should (erc-scenarios-common--at-win-end-p)) + (erc-scenarios-common--recenter-top-bottom) + (should (erc-scenarios-common--at-win-end-p))) + + (ert-info ("Command `beginning-of-buffer' allowed at prompt") + ;; Hitting C-< goes to beginning of buffer. + (call-interactively #'beginning-of-buffer) + (should (= 1 (point))) + (redisplay) + (should (zerop (count-screen-lines (window-start) (point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New message doesn't trigger scroll when away from prompt") + ;; Arriving insertions don't trigger a scroll when away from the + ;; prompt. New output not seen. + (erc-cmd-MSG "NickServ help register") + (save-excursion (erc-d-t-search-for 10 "End of NickServ")) + (should (= 1 (point))) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (funcall test) + + (ert-info ("New message does trigger a scroll when at prompt") + ;; Recenter so prompt is above rather than at window's end. + (funcall expect 10 "If you are currently logged in") + (recenter 0) + ;; Prompt is somewhere in the middle of the window. + (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p)) + (erc-scenarios-common-say "/msg NickServ help identify") + ;; New arriving messages trigger a snap when inserted. + (erc-d-t-wait-for 10 (erc-scenarios-common--at-win-end-p)) + (funcall expect 10 "IDENTIFY lets you login"))))) + (cl-defun erc-scenarios-common--base-network-id-bouncer ((&key autop foo-id bar-id after &aux diff --git a/test/lisp/erc/resources/scrolltobottom/help.eld b/test/lisp/erc/resources/scrolltobottom/help.eld new file mode 100644 index 00000000000..ba44a0def39 --- /dev/null +++ b/test/lisp/erc/resources/scrolltobottom/help.eld @@ -0,0 +1,46 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Mon, 21 Aug 2023 06:18:36 UTC") + (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.01 ":irc.foonet.org 254 tester 2 :channels formed") + (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 221 tester +i")) + +((privmsg-help-register 10 "PRIVMSG NickServ :help register") + (0.05 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2REGISTER <password> [email]\2") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :REGISTER lets you register your current nickname as a user account. If the") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :server allows anonymous registration, you can omit the e-mail address.") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :If you are currently logged in with a TLS client certificate and wish to use") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :it instead of a password to log in, send * as the password.") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***")) + +((privmsg-help-identify 20 "PRIVMSG NickServ :help identify") + (0.06 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2IDENTIFY <username> [password]\2") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :IDENTIFY lets you login to the given username using either password auth, or") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :certfp (your client certificate) if a password is not given.") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***")) + +((quit 10 "QUIT :\2ERC\2 ") + (0.07 ":[email protected] QUIT :Quit: \2ERC\2") + (0.02 "ERROR :Quit: \2ERC\2")) -- 2.41.0
0001-5.6-Consider-all-windows-in-erc-scrolltobottom-mode.patch
(text/x-patch, 55.5 KB)
From 3ed5a748d76989ec2ed79311e3550da5c6d1aaa1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <[email protected]> Date: Sat, 22 Jul 2023 00:46:44 -0700 Subject: [PATCH 1/1] [5.6] Consider all windows in erc-scrolltobottom-mode * etc/ERC-NEWS: Add entry for option `erc-scrolltobottom-all'. Also mention explicit hook-depth intervals reserved by ERC. * lisp/erc/erc-backend.el (erc--hide-prompt): Change hook depth on `pre-command-hook' from 91 to 80. * lisp/erc/erc-goodies.el (erc-input-line-position): Mention secondary role when new option `erc-scroll-to-bottom-relaxed' is non-nil. (erc-scrolltobottom-all): New option that decides whether module `scrolltobottom' affects all windows or just the selected one, as it always has. (erc-scrolltobottom-relaxed): New option to leave the prompt stationary instead of forcing it to the bottom of the window. (erc-scrolltobottom-mode, erc-scrolltobottom-enable, erc-scrolltobottom-disable): Use `erc--scrolltobottom-setup' instead of `erc-add-scroll-to-bottom' for adding and removing local hooks, instead of ranging over buffers when removing them. Also add and remove new hook members when `erc-scrolltobottom-all' is non-nil. (erc--scrolltobottom-relaxed-commands, erc--scrolltobottom-window-info, erc--scrolltobottom-post-force-commands, erc--scrolltobottom-relaxed-skip-commands): New internal variables. (erc--scrolltobottom-on-pre-command erc--scrolltobottom-on-post-command): New functions resembling `erc-possibly-scroll-to-bottom' that try to avoid scrolling repeatedly for no reason. (erc--scrolltobottom-on-pre-command-relaxed, erc--scrolltobottom-on-post-command-relaxed): New commands to help implement `erc-scroll-to-bottom-relaxed'. (erc--scrolltobottom-away-from-prompt): New function to scroll to bottom on window configuration changes. (erc--scrolltobottom-all): New function to scroll all windows displaying the current buffer. (erc-add-scroll-to-bottom): Deprecate this function because it is now unused. (erc--scrolltobottom-setup): New generic function to perform teardown as well as setup, depending on module mode var. Add scrolling on `window-configuration-changed-hook' when `erc-scrolltobottom-all' is non-nil and `erc-scrolltobottom-relaxed' is nil. (erc--scrolltobottom-on-pre-insert): New generic function that remembers the last `window-start' and maybe the current screen line before inserting a message, in order to restore it afterward. (erc--scrolltobottom-confirm): New function, a replacement for `erc-scroll-to-bottom', that returns non-nil when it's actually recentered the window. (erc-move-to-prompt-setup): Add `erc-move-to-prompt' to `pre-command-hook' at a depth of 70. (erc-keep-place-mode, erc-keep-place-enable): Change hook depth from 0 to 85. (erc--keep-place-indicator-setup): Add overlay arrow `after-string' in non-graphical settings in case users have time stamps or other content occupying the left margin. (erc-keep-place-indicator-mode, erc-keep-place-indicator-enable): Change hook depth from 90 to 85 so as not to conflict with t. (erc--keep-place-indicator-on-global-module): Change hook depth from 90 to 85. * test/lisp/erc/erc-scenarios-scrolltobottom.el: New file. * test/lisp/erc/erc-scenarios-scrolltobottom-all.el: New file. * test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el: New file. * test/lisp/erc/resources/base/assoc/bumped/again.eld: Adjust timeouts. * test/lisp/erc/resources/base/assoc/bumped/foisted.eld: Adjust timeouts. * test/lisp/erc/resources/base/assoc/bumped/refoisted.eld: Adjust timeouts. * test/lisp/erc/resources/base/netid/bouncer/barnet.eld: Adjust timeouts. * test/lisp/erc/resources/base/netid/bouncer/foonet.eld: Adjust timeouts. * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t--wait-message-prefix, erc-d-t-wait-for, erc-d-t-ensure-for): Add and use new variable to make `ert-info' message prefix adjustable. * test/lisp/erc/resources/erc-scenarios-common.el (erc-scenarios-common--term-size, erc-scenarios-common--run-in-term, erc-scenarios-common-interactive-debug-term-p, erc-scenarios-common-with-noninteractive-in-term): New test macro and supporting helper function and variables to facilitate running scenario-based tests in a subprocess. (erc-scenarios-common--at-win-end-p, erc-scenarios-common--above-win-end-p, erc-scenarios-common--prompt-past-win-end-p, erc-scenarios-common--recenter-top-bottom-around, erc-scenarios-common--recenter-top-bottom, erc-scenarios-scrolltobottom--normal): New test fixture and assertion helper functions. * test/lisp/erc/resources/scrolltobottom/help.eld: New file. (Bug#64855) --- etc/ERC-NEWS | 19 +- lisp/erc/erc-backend.el | 2 +- lisp/erc/erc-goodies.el | 267 ++++++++++++++++-- .../erc/erc-scenarios-scrolltobottom-all.el | 48 ++++ .../erc-scenarios-scrolltobottom-relaxed.el | 140 +++++++++ test/lisp/erc/erc-scenarios-scrolltobottom.el | 44 +++ .../erc/resources/base/assoc/bumped/again.eld | 10 +- .../resources/base/assoc/bumped/foisted.eld | 10 +- .../resources/base/assoc/bumped/refoisted.eld | 8 +- .../resources/base/netid/bouncer/barnet.eld | 2 +- .../resources/base/netid/bouncer/foonet.eld | 2 +- test/lisp/erc/resources/erc-d/erc-d-t.el | 7 +- .../erc/resources/erc-scenarios-common.el | 196 +++++++++++++ .../erc/resources/scrolltobottom/help.eld | 46 +++ 14 files changed, 761 insertions(+), 40 deletions(-) create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom-all.el create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el create mode 100644 test/lisp/erc/erc-scenarios-scrolltobottom.el create mode 100644 test/lisp/erc/resources/scrolltobottom/help.eld diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 94452514e6d..72b768b02ec 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -178,6 +178,15 @@ been restored with a slightly revised role contingent on a few assumptions explained in its doc string. For clarity, it has been renamed 'erc-ensure-target-buffer-on-privmsg'. +** Module 'scrolltobottom' attempts to behave more sensibly. +Enabling the experimental option 'erc-scrolltobottom-all' tells +'scrolltobottom' to be more vigilant about recentering and to do so in +all ERC windows. The dependent option 'erc-scrolltobottom-relaxed', +likewise experimental, makes ERC's prompt stationary wherever it +resides instead of forcing it to the bottom of the window. That is, +new input appears above the prompt, scrolling existing messages upward +to compensate. + ** Subtle changes in two fundamental faces. Users of the default theme may notice that 'erc-action-face' and 'erc-notice-face' now appear slightly less bold on systems supporting @@ -232,9 +241,9 @@ property of the same name has been retained and now has a value of Built-in and third-party modules rely on certain hooks for adjusting incoming and outgoing messages upon insertion. And some modules only want to do so after others have done their damage. Traditionally, -this required various hacks and finagling to achieve. And while this -release makes an effort to load modules in a more consistent order, -that alone isn't enough to ensure similar predictability among +this has required various hacks and finagling to achieve. And while +this release makes an effort to load modules in a more consistent +order, that alone isn't enough to ensure similar predictability among essential members of important hooks. Luckily, ERC now leverages a feature introduced in Emacs 27, "hook @@ -248,6 +257,10 @@ the first two, 'erc-button-add-buttons' and 'erc-fill', which have been swapped with respect to their previous places in recent ERC versions. +The same depth interval is now also provisionally reserved for +'erc-insert-pre-hook' and for the non-ERC hooks 'pre-command-hook' and +'post-command-hook', but only locally, in ERC buffers. + *** ERC now manages timestamp-related properties a bit differently. For starters, the 'cursor-sensor-functions' property no longer contains unique closures and thus no longer proves effective for diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index eb3ec39fedd..9e121ec1e92 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -1089,7 +1089,7 @@ erc--hide-prompt (put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt 'hidden) (erc--conceal-prompt)) - (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 91 t)))) + (add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t)))) (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index b37855cbecc..07a93b06f2c 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -44,42 +44,270 @@ erc-input-line-position This should be an integer specifying the line of the buffer on which the input line should stay. A value of \"-1\" would keep the input line positioned on the last line in the buffer. This is passed as an -argument to `recenter'." +argument to `recenter', unless `erc-scrolltobottom-relaxed' is +non-nil, in which case, ERC interprets it as additional lines to +scroll down by per message insertion (minus one for the prompt)." :group 'erc-display :type '(choice integer (const nil))) +(defcustom erc-scrolltobottom-all nil + "Whether to scroll all windows or just the selected one. +A value of nil preserves pre-5.6 behavior, in which scrolling +only affects the selected window. Users should consider its +non-nil behavior experimental for the time being. Note also that +ERC expects this option to be configured before module +initialization." + :group 'erc-display + :package-version '(ERC . "5.6") ; FIXME sync on release + :type 'boolean) + +(defcustom erc-scrolltobottom-relaxed nil + "Whether to forgo forcing prompt to the bottom of the window. +When non-nil, and point is at the prompt, ERC scrolls the window +up when inserting messages, making the prompt appear stationary. +Users who find this effect too \"stagnant\" can adjust the option +`erc-input-line-position', which ERC borrows to express a scroll +step offset when this option is non-nil. Setting that value to +zero lets the prompt drift toward the bottom by one line per +message, which is generally slow enough not to distract while +composing input. Of course, this doesn't apply when receiving a +large influx of messages, such as after typing \"/msg NickServ +help\". Note that ERC only considers this option when the +experimental companion option `erc-scrolltobottom-all' is enabled +and, only then, during module setup." + :group 'erc-display + :package-version '(ERC . "5.6") ; FIXME sync on release + :type 'boolean) + ;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t) (define-erc-module scrolltobottom nil "This mode causes the prompt to stay at the end of the window." - ((add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) - (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) - (unless erc--updating-modules-p (erc-buffer-do #'erc-add-scroll-to-bottom))) - ((remove-hook 'erc-mode-hook #'erc-add-scroll-to-bottom) - (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom) - (dolist (buffer (erc-buffer-list)) - (with-current-buffer buffer - (remove-hook 'post-command-hook #'erc-scroll-to-bottom t))))) + ((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup) + (unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup)) + (if erc-scrolltobottom-all + (progn + (add-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert 25) + (add-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert) + (add-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (add-hook 'erc-send-completed-hook #'erc--scrolltobottom-all)) + (add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))) + ((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup) + (erc-buffer-do #'erc--scrolltobottom-setup) + (if erc-scrolltobottom-all + (progn + (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert) + (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all) + (remove-hook 'erc-pre-send-functions + #'erc--scrolltobottom-on-pre-insert)) + (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)))) (defun erc-possibly-scroll-to-bottom () "Like `erc-add-scroll-to-bottom', but only if window is selected." (when (eq (selected-window) (get-buffer-window)) (erc-scroll-to-bottom))) +(defvar-local erc--scrolltobottom-relaxed-commands '(end-of-buffer) + "Commands triggering a force scroll to prompt. +Only applies with `erc-scrolltobottom-relaxed' when away from prompt.") + +(defvar-local erc--scrolltobottom-window-info nil + "Alist with windows as keys and lists of window-related info as values. +Values are lists containing the last window start position and +the last \"window line\" of point. The \"window line\", which +may be nil, is the number of lines between `window-start' and +`window-point', inclusive.") + +(defvar erc--scrolltobottom-post-force-commands + '(beginning-of-buffer + electric-newline-and-maybe-indent + default-indent-new-line) + "Commands that force a scroll after execution at prompt. +That is, ERC recalculates the window's start instead of blindly +restoring it.") + +(defvar erc--scrolltobottom-relaxed-skip-commands + '(recenter-top-bottom scroll-down-command)) + +(defun erc--scrolltobottom-on-pre-command () + (when (and (eq (selected-window) (get-buffer-window)) + (>= (point) erc-input-marker)) + (setq erc--scrolltobottom-window-info + (list (list (selected-window) + (window-start) + (count-screen-lines (window-start) (point-max))))))) + +(defun erc--scrolltobottom-on-post-command () + "Restore window start or scroll to prompt and recenter. +When `erc--scrolltobottom-window-info' is non-nil and its first +item is associated with the selected window, restore start of +window so long as prompt hasn't moved. Expect buffer to be +unnarrowed." + (when (eq (selected-window) (get-buffer-window)) + (if-let (((not (input-pending-p))) + (erc--scrolltobottom-window-info) + (found (car erc--scrolltobottom-window-info)) + ((eq (car found) (selected-window))) + ((not (memq this-command + erc--scrolltobottom-post-force-commands))) + ((= (nth 2 found) + (count-screen-lines (window-start) (point-max))))) + (set-window-start (selected-window) (nth 1 found)) + (erc--scrolltobottom-confirm)) + (setq erc--scrolltobottom-window-info nil))) + +(defun erc--scrolltobottom-on-pre-command-relaxed () + "Maybe scroll to bottom when away from prompt in an unnarrowed buffer. +When `erc-scrolltobottom-relaxed' is active, only scroll when +prompt is past window's end and the command is `end-of-buffer' or +`self-insert-command' (assuming `move-to-prompt' is active). +When at prompt and current command does not appear in +`erc--scrolltobottom-relaxed-skip-commands', stash +`erc--scrolltobottom-window-info' for the selected window." + (when (eq (selected-window) (get-buffer-window)) + (when (and (not (input-pending-p)) + (< (point) erc-input-marker) + (memq this-command erc--scrolltobottom-relaxed-commands) + (< (window-end nil t) erc-input-marker)) + (save-excursion + (goto-char (point-max)) + (recenter (or erc-input-line-position -1)))) + (when (and (>= (point) erc-input-marker) + (not (memq this-command + erc--scrolltobottom-relaxed-skip-commands))) + (setq erc--scrolltobottom-window-info + (list (list (selected-window) + (window-start) + (count-screen-lines (window-start) (point-max)))))))) + +(defun erc--scrolltobottom-on-post-command-relaxed () + "Set window start or scroll when data was captured on pre-command." + (when-let (((eq (selected-window) (get-buffer-window))) + (erc--scrolltobottom-window-info) + (found (car erc--scrolltobottom-window-info)) + ((eq (car found) (selected-window)))) + (if (and (not (memq this-command erc--scrolltobottom-post-force-commands)) + (= (nth 2 found) + (count-screen-lines (window-start) (point-max)))) + (set-window-start (selected-window) (nth 1 found)) + (recenter (nth 2 found))) + (setq erc--scrolltobottom-window-info nil))) + +;; FIXME this is currently of little value because it doesn't restore +;; the relative position of window point after changing dimensions. +;; It would be preferable to instead stash the previous ratio of +;; window line to body height and later recenter proportionally. But +;; that may not be worth the added bookkeeping. +(defun erc--scrolltobottom-away-from-prompt () + "Scroll to bottom unless at prompt." + (unless (or (input-pending-p) + (minibuffer-window-active-p (minibuffer-window)) + (eq (old-selected-window) (minibuffer-window))) + (erc--scrolltobottom-confirm))) + +(defun erc--scrolltobottom-all (&rest _) + "Maybe put prompt on last line in all windows displaying current buffer. +Expect to run when narrowing is in effect, such as on insertion +or send-related hooks. When recentering has not been performed, +attempt to restore last `window-start', if known." + (dolist (window (get-buffer-window-list nil nil 'visible)) + (with-selected-window window + (when-let + ((erc--scrolltobottom-window-info) + (found (assq window erc--scrolltobottom-window-info)) + ((not (erc--scrolltobottom-confirm (nth 2 found))))) + (setf (window-start window) (cadr found))))) + ;; Necessary unless we're sure `erc--scrolltobottom-on-pre-insert' + ;; always runs between calls to this function. + (setq erc--scrolltobottom-window-info nil)) + (defun erc-add-scroll-to-bottom () "A hook function for `erc-mode-hook' to recenter output at bottom of window. If you find that ERC hangs when using this function, try customizing the value of `erc-input-line-position'. -This works whenever scrolling happens, so it's added to -`window-scroll-functions' rather than `erc-insert-post-hook'." +Note that the prior suggestion comes from a time when this +function used `window-scroll-functions', which was replaced by +`post-command-hook' in ERC 5.3." + (declare (obsolete erc--scrolltobottom-setup "30.1")) (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)) +(cl-defgeneric erc--scrolltobottom-setup () + "Arrange for scrolling to bottom on window configuration changes. +Undo that arrangement when disabling `erc-scrolltobottom-mode'." + (if erc-scrolltobottom-mode + (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t) + (remove-hook 'post-command-hook #'erc-scroll-to-bottom t))) + +(cl-defmethod erc--scrolltobottom-setup (&context + (erc-scrolltobottom-all (eql t))) + (if erc-scrolltobottom-mode + (if erc-scrolltobottom-relaxed + (progn + (when (or (bound-and-true-p erc-move-to-prompt-mode) + (memq 'move-to-prompt erc-modules)) + (cl-pushnew 'self-insert-command + erc--scrolltobottom-relaxed-commands)) + (add-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command-relaxed 60 t) + (add-hook 'pre-command-hook ; preempt `move-to-prompt' + #'erc--scrolltobottom-on-pre-command-relaxed 60 t)) + (add-hook 'window-configuration-change-hook + #'erc--scrolltobottom-away-from-prompt nil t) + (add-hook 'pre-command-hook + #'erc--scrolltobottom-on-pre-command 60 t) + (add-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command 60 t)) + (remove-hook 'window-configuration-change-hook + #'erc--scrolltobottom-away-from-prompt t) + (remove-hook 'pre-command-hook + #'erc--scrolltobottom-on-pre-command t) + (remove-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command t) + (remove-hook 'pre-command-hook + #'erc--scrolltobottom-on-pre-command-relaxed t) + (remove-hook 'post-command-hook + #'erc--scrolltobottom-on-post-command-relaxed t) + (kill-local-variable 'erc--scrolltobottom-relaxed-commands) + (kill-local-variable 'erc--scrolltobottom-window-info))) + +(cl-defmethod erc--scrolltobottom-on-pre-insert (_input-or-string) + "Remember the `window-start' before inserting a message." + (setq erc--scrolltobottom-window-info + (mapcar (lambda (w) + (list w + (window-start w) + (and-let* + ((erc-scrolltobottom-relaxed) + (c (count-screen-lines (window-start w) + (point-max) nil w))) + (if (= ?\n (char-before (point-max))) (1+ c) c)))) + (get-buffer-window-list nil nil 'visible)))) + +(cl-defmethod erc--scrolltobottom-on-pre-insert ((input erc-input)) + "Remember the `window-start' before inserting a message." + (when (erc-input-insertp input) + (cl-call-next-method))) + +(defun erc--scrolltobottom-confirm (&optional scroll-to) + "Like `erc-scroll-to-bottom', but use `window-point'. +Position current line (with `recenter') SCROLL-TO lines below +window's top. Return nil if point is not in prompt area or if +prompt isn't ready." + (when erc-insert-marker + (let ((resize-mini-windows nil)) + (save-restriction + (widen) + (when (>= (window-point) erc-input-marker) + (save-excursion + (goto-char (point-max)) + (recenter (+ (or scroll-to 0) (or erc-input-line-position -1))) + t)))))) + (defun erc-scroll-to-bottom () "Recenter WINDOW so that `point' is on the last line. -This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'. - You can control which line is recentered to by customizing the variable `erc-input-line-position'." ;; Temporarily bind resize-mini-windows to nil so that users who have it @@ -135,13 +363,13 @@ erc-move-to-prompt (defun erc-move-to-prompt-setup () "Initialize the move-to-prompt module." - (add-hook 'pre-command-hook #'erc-move-to-prompt nil t)) + (add-hook 'pre-command-hook #'erc-move-to-prompt 70 t)) ;;; Keep place in unvisited channels ;;;###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)) + ((add-hook 'erc-insert-pre-hook #'erc-keep-place 85)) ((remove-hook 'erc-insert-pre-hook #'erc-keep-place))) (defcustom erc-keep-place-indicator-style t @@ -213,12 +441,15 @@ erc--keep-place-indicator-setup (add-hook 'window-configuration-change-hook #'erc--keep-place-indicator-on-window-configuration-change nil t) (when-let* (((memq erc-keep-place-indicator-style '(t arrow))) + (ov-property (if (zerop (fringe-columns 'left)) + 'after-string + 'before-string)) (display (if (zerop (fringe-columns 'left)) `((margin left-margin) ,overlay-arrow-string) '(left-fringe right-triangle erc-keep-place-indicator-arrow))) (bef (propertize " " 'display display))) - (overlay-put erc--keep-place-indicator-overlay 'before-string bef)) + (overlay-put erc--keep-place-indicator-overlay ov-property bef)) (when (memq erc-keep-place-indicator-style '(t face)) (overlay-put erc--keep-place-indicator-overlay 'face 'erc-keep-place-indicator-line))) @@ -233,7 +464,7 @@ keep-place-indicator ((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 90 t))) + (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t))) (if (pcase erc-keep-place-indicator-buffer-type ('target erc--target) ('server (not erc--target)) @@ -256,7 +487,7 @@ erc--keep-place-indicator-on-global-module 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 90 t))) + (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t))) (defun erc-keep-place-move (pos) "Move keep-place indicator to current line or POS. diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-all.el b/test/lisp/erc/erc-scenarios-scrolltobottom-all.el new file mode 100644 index 00000000000..33f232e64d9 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-all.el @@ -0,0 +1,48 @@ +;;; erc-scenarios-scrolltobottom-all.el --- erc-scrolltobottom-all test -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--all () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (let ((erc-scrolltobottom-all t)) + + (erc-scenarios-scrolltobottom--normal + (lambda () + (ert-info ("New insertion anchors prompt in other window") + (let ((w (next-window))) + ;; We're at prompt and aligned to bottom. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (erc-scenarios-common--at-win-end-p w)) + (erc-d-t-ensure-for 0.5 + (erc-scenarios-common--at-win-end-p w)))))))) + +;;; erc-scenarios-scrolltobottom-all.el ends here diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el new file mode 100644 index 00000000000..7d256bf711b --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el @@ -0,0 +1,140 @@ +;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-relaxed -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;; TODO assert behavior of prompt input spanning multiple lines, with +;; and without line endings. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--relaxed () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "scrolltobottom") + (dumb-server (erc-d-run "localhost" t 'help)) + (port (process-contact dumb-server :service)) + (erc-modules `(scrolltobottom fill-wrap ,@erc-modules)) + (erc-scrolltobottom-all t) + (erc-scrolltobottom-relaxed t) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter)) + lower upper) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer "foonet" + (should (looking-at " and")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + (split-window-below 15) + (recenter 0) + + (ert-info ("Moving into prompt does not trigger scroll") + (with-selected-window (next-window) + (should-not (erc-scenarios-common--at-win-end-p)) + (recenter 0) + (goto-char (1- erc-insert-marker)) + (execute-kbd-macro "\C-n") + (should-not (erc-scenarios-common--at-win-end-p)) + (should (= (point) (point-max))) + (setq lower (count-screen-lines (window-start) (window-point))))) + + (ert-info ("Module `move-to-prompt' still works") + ;; Prompt is somewhere in the middle of the window. + (should (erc-scenarios-common--above-win-end-p)) + (should-not (= (point-max) (point))) + ;; Hitting a self-insert key triggers `move-to-prompt' but not + ;; a scroll (to bottom). + (execute-kbd-macro "hi") + ;; Prompt and input appear on same line. + (should (= (point-max) (point))) + (setq upper (count-screen-lines (window-start) (window-point))) + (should-not (= upper (window-body-height)))) + + (ert-info ("Command `recenter-top-bottom' allowed at prompt") + ;; Hitting C-l recenters the window. + (should (= upper (count-screen-lines (window-start) (window-point)))) + (let ((lines (list upper))) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (erc-scenarios-common--recenter-top-bottom) + (push (count-screen-lines (window-start) (window-point)) lines) + (setq lines (delete-dups lines)) + (should (= (length lines) 4)))) + + (ert-info ("Command `beginning-of-buffer' allowed at prompt") + ;; Hitting C-< goes to beginning of buffer. + (execute-kbd-macro "\M-<") + (should (= 1 (point))) + (redisplay) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New message doesn't trigger scroll when away from prompt") + ;; Arriving insertions don't trigger a scroll when away from the + ;; prompt. New output not seen. + (erc-cmd-MSG "NickServ help register") + (save-excursion (erc-d-t-search-for 10 "End of NickServ")) + (should (= 1 (point))) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New insertion keeps prompt stationary in other window") + (let ((w (next-window))) + ;; We're at prompt and completely stationary. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (= lower (count-screen-lines (window-start w) (window-point w)))) + (erc-d-t-ensure-for 0.5 + (= lower (count-screen-lines (window-start w) + (window-point w)))))) + + (should (= 2 (length (window-list)))) + (ert-info ("New message does not trigger a scroll when at prompt") + ;; Recenter so prompt is above rather than at window's end. + (funcall expect 10 "End of NickServ HELP") + (recenter 0) + (set-window-point nil (point-max)) + (setq upper (count-screen-lines (window-start) (window-point))) + ;; Prompt is somewhere in the middle of the window. + (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p)) + (erc-scenarios-common-say "/msg NickServ help identify") + ;; New arriving messages don't move prompt. + (erc-d-t-ensure-for 1 + (= upper (count-screen-lines (window-start) (window-point)))) + (funcall expect 10 "IDENTIFY lets you login"))))) + +;;; erc-scenarios-scrolltobottom-relaxed.el ends here diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el b/test/lisp/erc/erc-scenarios-scrolltobottom.el new file mode 100644 index 00000000000..44e64204fb1 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -0,0 +1,44 @@ +;;; erc-scenarios-scrolltobottom.el --- erc-scrolltobottom-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert-x) +(eval-and-compile + (let ((load-path (cons (ert-resource-directory) load-path))) + (require 'erc-scenarios-common))) + +(require 'erc-goodies) + +(ert-deftest erc-scenarios-scrolltobottom--normal () + :tags '(:expensive-test) + (when (version< emacs-version "29") (ert-skip "Times out")) + + (should-not erc-scrolltobottom-all) + + (erc-scenarios-scrolltobottom--normal + (lambda () + (ert-info ("New insertion doesn't anchor prompt in other window") + (let ((w (next-window))) + ;; We're at prompt but not aligned to bottom. + (should (>= (window-point w) erc-input-marker)) + (erc-d-t-wait-for 10 + (not (erc-scenarios-common--at-win-end-p w)))))))) + +;;; erc-scenarios-scrolltobottom.el ends here diff --git a/test/lisp/erc/resources/base/assoc/bumped/again.eld b/test/lisp/erc/resources/base/assoc/bumped/again.eld index ab3c7b06214..aef164b6237 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/again.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/again.eld @@ -1,10 +1,10 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.0 ":irc.foonet.org 433 * tester :Nickname is reserved by a different account") (0.0 ":irc.foonet.org FAIL NICK NICKNAME_RESERVED tester :Nickname is reserved by a different account")) -((nick 3 "NICK tester`") +((nick 10 "NICK tester`") (0.1 ":irc.foonet.org 001 tester` :Welcome to the foonet IRC Network tester`") (0.0 ":irc.foonet.org 002 tester` :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 tester` :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -21,10 +21,10 @@ (0.2 ":irc.foonet.org 266 tester` 3 3 :Current global users 3, max 3") (0.0 ":irc.foonet.org 422 tester` :MOTD File is missing")) -((mode-user 3.2 "MODE tester` +i") +((mode-user 10 "MODE tester` +i") (0.0 ":irc.foonet.org 221 tester` +i") (0.0 ":irc.foonet.org NOTICE tester` :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((privmsg 42.6 "PRIVMSG NickServ :IDENTIFY tester changeme") +((privmsg 10 "PRIVMSG NickServ :IDENTIFY tester changeme") (0.01 ":tester`[email protected] NICK tester") (0.0 ":NickServ!NickServ@localhost NOTICE tester :You're now logged in as tester")) diff --git a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld index 5c36e58d9d3..0f7aadac564 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/foisted.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/foisted.eld @@ -1,6 +1,6 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") (0.0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 tester :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -17,14 +17,14 @@ (0.0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3") (0.0 ":irc.foonet.org 422 tester :MOTD File is missing")) -((mode-user 1.2 "MODE tester +i") +((mode-user 10 "MODE tester +i") (0.0 ":irc.foonet.org 221 tester +i") (0.0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((privmsg 17.21 "PRIVMSG bob :hi") +((privmsg 10 "PRIVMSG bob :hi") (0.02 ":[email protected] PRIVMSG tester :hola") (0.01 ":[email protected] PRIVMSG tester :how r u?")) -((quit 18.19 "QUIT :" quit) +((quit 10 "QUIT :" quit) (0.01 ":[email protected] QUIT :Quit: " quit)) ((drop 1 DROP)) diff --git a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld index 33e4168ac46..63366d3f576 100644 --- a/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld +++ b/test/lisp/erc/resources/base/assoc/bumped/refoisted.eld @@ -1,6 +1,6 @@ ;; -*- mode: lisp-data; -*- -((nick 1 "NICK tester")) -((user 1 "USER user 0 * :tester") +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") (0.1 ":irc.foonet.org 001 dummy :Welcome to the foonet IRC Network dummy") (0.0 ":irc.foonet.org 002 dummy :Your host is irc.foonet.org, running version oragono-2.6.1-937b9b02368748e5") (0.0 ":irc.foonet.org 003 dummy :This server was created Fri, 24 Sep 2021 01:38:36 UTC") @@ -22,10 +22,10 @@ (0.01 ":[email protected] PRIVMSG dummy :back?") ) -((mode-user 1.2 "MODE dummy +i") +((mode-user 10 "MODE dummy +i") (0.0 ":irc.foonet.org 221 dummy +i") (0.0 ":irc.foonet.org NOTICE dummy :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.")) -((renick 42.6 "NICK tester") +((renick 10 "NICK tester") (0.01 ":[email protected] NICK tester") (0.0 ":NickServ!NickServ@localhost NOTICE dummy :You're now logged in as tester")) diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld index 204d01fef77..596383c2699 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/barnet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/barnet.eld @@ -38,4 +38,4 @@ (0.05 ":[email protected] PRIVMSG #chan :mike: As he regards his aged father's life.") (0.05 ":[email protected] PRIVMSG #chan :joe: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonor in doing it.")) -((linger 1 LINGER)) +((linger 2 LINGER)) diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld index 4445350ca0c..2e1a3ac27da 100644 --- a/test/lisp/erc/resources/base/netid/bouncer/foonet.eld +++ b/test/lisp/erc/resources/base/netid/bouncer/foonet.eld @@ -43,4 +43,4 @@ (0.1 ":[email protected] PRIVMSG #chan :bob: Orlando, my liege; the youngest son of Sir Rowland de Boys.") (0.1 ":[email protected] PRIVMSG #chan :alice: The ape is dead, and I must conjure him.")) -((linger 1 LINGER)) +((linger 2 LINGER)) diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el b/test/lisp/erc/resources/erc-d/erc-d-t.el index 7b2adf4f07b..cf869fb3c70 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-t.el +++ b/test/lisp/erc/resources/erc-d/erc-d-t.el @@ -83,6 +83,8 @@ erc-d-t-with-cleanup (ignore-errors (kill-buffer buf))))) (sleep-for erc-d-t-cleanup-sleep-secs))))) +(defvar erc-d-t--wait-message-prefix "Awaiting: ") + (defmacro erc-d-t-wait-for (max-secs msg &rest body) "Wait for BODY to become non-nil. Or signal error with MSG after MAX-SECS. When MAX-SECS is negative, @@ -99,7 +101,7 @@ erc-d-t-wait-for (let ((inverted (make-symbol "inverted")) (time-out (make-symbol "time-out")) (result (make-symbol "result"))) - `(ert-info ((concat "Awaiting: " ,msg)) + `(ert-info ((concat erc-d-t--wait-message-prefix ,msg)) (let ((,time-out (abs ,max-secs)) (,inverted (< ,max-secs 0)) (,result ',result)) @@ -120,7 +122,8 @@ erc-d-t-ensure-for (unless (or (stringp msg) (memq (car-safe msg) '(format concat))) (push msg body) (setq msg (prin1-to-string body))) - `(erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body)))) + `(let ((erc-d-t--wait-message-prefix "Sustaining: ")) + (erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body))))) (defun erc-d-t-search-for (timeout text &optional from on-success) "Wait for TEXT to appear in current buffer before TIMEOUT secs. diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 972faa5c73f..b92acdd81e8 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -183,6 +183,103 @@ erc-scenarios-common-with-cleanup ,@body))) +(defvar erc-scenarios-common--term-size '(34 . 80)) +(declare-function term-char-mode "term" nil) +(declare-function term-line-mode "term" nil) + +(defun erc-scenarios-common--run-in-term (&optional debug) + (require 'term) + (let* ((default-directory (getenv "EMACS_TEST_DIRECTORY")) + (emacs (expand-file-name invocation-name invocation-directory)) + (process-environment (cons "HOME=/nonexistent" + (cons "ERC_TESTS_SUBPROCESS=1" + process-environment))) + (name (ert-test-name (ert-running-test))) + (temp-file (make-temp-file "erc-term-test-")) + (cmd `(let ((stats 1)) + (setq enable-dir-local-variables nil) + (unwind-protect + (setq stats (ert-run-tests-batch ',name)) + (unless ',debug + (let ((buf (with-current-buffer (messages-buffer) + (buffer-string)))) + (with-temp-file ,temp-file + (insert buf))) + (kill-emacs (ert-stats-completed-unexpected stats)))))) + ;; The `ert-test' object in Emacs 29 has a `file-name' field. + (file-name (symbol-file name 'ert--test)) + (default-directory (expand-file-name (file-name-directory file-name))) + (package (if-let* ((found (getenv "ERC_PACKAGE_NAME")) + ((string-prefix-p "erc-" found))) + (intern found) + 'erc)) + ;; This is for testing ERC's ELPA-package on older Emacsen we + ;; still support. It won't run inside the emacs.git tree. + (setup (and (featurep 'compat) + `(progn + (require 'package) + (let ((package-load-list '((compat t) (,package t)))) + (package-initialize))))) + ;; Make subprocess terminal bigger than controlling. + (buf (cl-letf (((symbol-function 'window-screen-lines) + (lambda () (car erc-scenarios-common--term-size))) + ((symbol-function 'window-max-chars-per-line) + (lambda () (cdr erc-scenarios-common--term-size)))) + (make-term (symbol-name name) emacs nil "-Q" "-nw" + "-eval" (prin1-to-string setup) + "-l" file-name "-eval" (format "%S" cmd)))) + (proc (get-buffer-process buf)) + (err (lambda () + (with-temp-buffer + (insert-file-contents temp-file) + (message "Subprocess: %s" (buffer-string)) + (delete-file temp-file))))) + (set-window-buffer (selected-window) buf) + (delete-other-windows) + (with-current-buffer buf + (set-process-query-on-exit-flag proc nil) + (unless noninteractive (term-char-mode)) + (with-timeout (30 (funcall err) (error "Timed out awaiting result")) + (while (process-live-p proc) + (accept-process-output proc 0.1) + (unless noninteractive + (redisplay)))) + (while (accept-process-output proc)) + (term-line-mode) + (goto-char (point-min)) + ;; Otherwise gives process exited abnormally with exit-code >0 + (unless (search-forward (format "Process %s finished" name) nil t) + (funcall err) + (ert-fail (when (search-forward "exited" nil t) + (buffer-substring-no-properties (line-beginning-position) + (line-end-position))))) + (delete-file temp-file) + (when noninteractive + (kill-buffer))))) + +(defvar erc-scenarios-common-interactive-debug-term-p nil + "When non-nil, run interactive ") + +(defmacro erc-scenarios-common-with-noninteractive-in-term (&rest body) + "Run BODY via `erc-scenarios-common-with-cleanup' in a `term' subprocess. +Also do so when `erc-scenarios-common-interactive-debug-term-p' +is non-nil. When debugging, leave the `term-mode' buffer around +for inspection and name it after the test, bounded by asterisks. +When debugging, ensure the test always fails, as a reminder to +disable `erc-scenarios-common-interactive-debug-term-p'. + +See Info node `(emacs) Term Mode' for the various commands." + (declare (indent 1)) + `(if (and (or erc-scenarios-common-interactive-debug-term-p + noninteractive) + (not (getenv "ERC_TESTS_SUBPROCESS"))) + (progn + (when (memq system-type '(windows-nt ms-dos)) + (ert-skip "System must be UNIX")) + (erc-scenarios-common--run-in-term + erc-scenarios-common-interactive-debug-term-p)) + (erc-scenarios-common-with-cleanup ,@body))) + (defun erc-scenarios-common-assert-initial-buf-name (id port) ;; Assert no limbo period when explicit ID given (should (string= (if id @@ -209,9 +306,108 @@ erc-scenarios-common-say (insert str) (erc-send-current-line))) +(defun erc-scenarios-common--at-win-end-p (&optional window) + (= (window-body-height window) + (count-screen-lines (window-start window) (point-max) nil window))) + +(defun erc-scenarios-common--above-win-end-p (&optional window) + (> (window-body-height window) + (count-screen-lines (window-start window) (point-max)))) + +(defun erc-scenarios-common--prompt-past-win-end-p (&optional window) + (< (window-body-height window) + (count-screen-lines (window-start window) (point-max)))) + +(defun erc-scenarios-common--recenter-top-bottom-around (orig &rest args) + (let (this-command last-command) (apply orig args))) + +(defun erc-scenarios-common--recenter-top-bottom () + (advice-add 'recenter-top-bottom + :around #'erc-scenarios-common--recenter-top-bottom-around) + (execute-kbd-macro "\C-l") + (advice-remove 'recenter-top-bottom + #'erc-scenarios-common--recenter-top-bottom-around)) + ;;;; Fixtures +(defun erc-scenarios-scrolltobottom--normal (test) + (erc-scenarios-common-with-noninteractive-in-term + ((erc-scenarios-common-dialog "scrolltobottom") + (dumb-server (erc-d-run "localhost" t 'help)) + (port (process-contact dumb-server :service)) + (erc-modules `(scrolltobottom fill-wrap ,@erc-modules)) + (erc-server-flood-penalty 0.1) + (expect (erc-d-t-make-expecter))) + + (ert-info ("Connect") + (with-current-buffer (erc :server "127.0.0.1" + :port port + :full-name "tester" + :nick "tester") + (funcall expect 10 "debug mode"))) + + (with-current-buffer "foonet" + (should (looking-at " and")) + (set-window-buffer nil (current-buffer)) + (delete-other-windows) + (split-window-below 15) + (recenter 0) + + (ert-info ("Moving into prompt in other window triggers scroll") + (with-selected-window (next-window) + (should-not (erc-scenarios-common--at-win-end-p)) + (goto-char (1- erc-insert-marker)) + (execute-kbd-macro "\C-n") + ;; Ensure point is at prompt and aligned to bottom. + (should (erc-scenarios-common--at-win-end-p)))) + + (ert-info ("Module `move-to-prompt' still works") + ;; Prompt is somewhere in the middle of the window. + (should (erc-scenarios-common--above-win-end-p)) + ;; Hitting a self-insert key triggers `move-to-prompt' as well + ;; as a scroll (to bottom). + (execute-kbd-macro "hi") + ;; Prompt and input appear on last line of window. + (should (erc-scenarios-common--at-win-end-p))) + + (ert-info ("Command `recenter-top-bottom' disallowed at prompt") + ;; Hitting C-l does not recenter the window. + (erc-scenarios-common--recenter-top-bottom) + (should (erc-scenarios-common--at-win-end-p)) + (erc-scenarios-common--recenter-top-bottom) + (should (erc-scenarios-common--at-win-end-p))) + + (ert-info ("Command `beginning-of-buffer' allowed at prompt") + ;; Hitting C-< goes to beginning of buffer. + (call-interactively #'beginning-of-buffer) + (should (= 1 (point))) + (redisplay) + (should (zerop (count-screen-lines (window-start) (point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (ert-info ("New message doesn't trigger scroll when away from prompt") + ;; Arriving insertions don't trigger a scroll when away from the + ;; prompt. New output not seen. + (erc-cmd-MSG "NickServ help register") + (save-excursion (erc-d-t-search-for 10 "End of NickServ")) + (should (= 1 (point))) + (should (zerop (count-screen-lines (window-start) (window-point)))) + (should (erc-scenarios-common--prompt-past-win-end-p))) + + (funcall test) + + (ert-info ("New message does trigger a scroll when at prompt") + ;; Recenter so prompt is above rather than at window's end. + (funcall expect 10 "If you are currently logged in") + (recenter 0) + ;; Prompt is somewhere in the middle of the window. + (erc-d-t-wait-for 10 (erc-scenarios-common--above-win-end-p)) + (erc-scenarios-common-say "/msg NickServ help identify") + ;; New arriving messages trigger a snap when inserted. + (erc-d-t-wait-for 10 (erc-scenarios-common--at-win-end-p)) + (funcall expect 10 "IDENTIFY lets you login"))))) + (cl-defun erc-scenarios-common--base-network-id-bouncer ((&key autop foo-id bar-id after &aux diff --git a/test/lisp/erc/resources/scrolltobottom/help.eld b/test/lisp/erc/resources/scrolltobottom/help.eld new file mode 100644 index 00000000000..ba44a0def39 --- /dev/null +++ b/test/lisp/erc/resources/scrolltobottom/help.eld @@ -0,0 +1,46 @@ +;; -*- mode: lisp-data; -*- +((nick 10 "NICK tester")) +((user 10 "USER user 0 * :tester") + (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") + (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version ergo-v2.11.1") + (0.01 ":irc.foonet.org 003 tester :This server was created Mon, 21 Aug 2023 06:18:36 UTC") + (0.02 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv") + (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=# CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+ TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100 TOPICLEN=390 UTF8ONLY WHOX :are supported by this server") + (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by this server") + (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1 server(s)") + (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online") + (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections") + (0.01 ":irc.foonet.org 254 tester 2 :channels formed") + (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers") + (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4") + (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4") + (0.01 ":irc.foonet.org 422 tester :MOTD File is missing")) + +((mode 10 "MODE tester +i") + (0.00 ":irc.foonet.org 221 tester +i") + (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is logging all user I/O. If you do not wish for everything you send to be readable by the server owner(s), please disconnect.") + (0.02 ":irc.foonet.org 221 tester +i")) + +((privmsg-help-register 10 "PRIVMSG NickServ :help register") + (0.05 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2REGISTER <password> [email]\2") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :REGISTER lets you register your current nickname as a user account. If the") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :server allows anonymous registration, you can omit the e-mail address.") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :") + (0.01 ":NickServ!NickServ@localhost NOTICE tester :If you are currently logged in with a TLS client certificate and wish to use") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :it instead of a password to log in, send * as the password.") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***")) + +((privmsg-help-identify 20 "PRIVMSG NickServ :help identify") + (0.06 ":NickServ!NickServ@localhost NOTICE tester :*** \2NickServ HELP\2 ***") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :Syntax: \2IDENTIFY <username> [password]\2") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :IDENTIFY lets you login to the given username using either password auth, or") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :certfp (your client certificate) if a password is not given.") + (0.02 ":NickServ!NickServ@localhost NOTICE tester :*** \2End of NickServ HELP\2 ***")) + +((quit 10 "QUIT :\2ERC\2 ") + (0.07 ":[email protected] QUIT :Quit: \2ERC\2") + (0.02 "ERROR :Quit: \2ERC\2")) -- 2.41.0