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

Consider all windows in erc-scrolltobottom-mode

Browse source 
* etc/ERC-NEWS: Add entry for option `erc-scrolltobottom-all', and
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 and
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-at-prompt-minibuffer-active): New function to
scroll to bottom on window configuration changes when using the
minibuffer.
(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 in the default client and trivial to implement otherwise.
(erc--scrolltobottom-setup): New generic function to perform teardown
as well as setup depending on the state of the module's mode variable.
Also add an implementation specifically for `erc-scrolltobottom-all'
that locally modifies different sets of hooks depending on
`erc-scrolltobottom-relaxed'.
(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.  For now, used only when
`erc-scrolltobottom-all' is enabled.
(erc-move-to-prompt-setup): Add `erc-move-to-prompt' to
`pre-command-hook' at a depth of 70 in the current buffer.
(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 locally so as not to conflict with a
value of t, for append.
(erc--keep-place-indicator-on-global-module): Change hook depth from
90 to 85 locally.
* test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el: New file.
* test/lisp/erc/erc-scenarios-scrolltobottom.el: New file.
* 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 an inferior Emacs, in term-mode.
(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)
This commit is contained in:
F. Jason Park 2023-07-22 00:46:44 -07:00
parent 7c932fa307
commit 617ddb8089
7 changed files with 731 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
etc/ERC-NEWS
View file

@ -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' can attempt to be more aggressive.
Enabling the experimental option 'erc-scrolltobottom-all' tells
'scrolltobottom' to be more vigilant about staking down the input area
and to do so in all ERC windows. The dependent option
'erc-scrolltobottom-relaxed', also experimental, makes ERC's prompt
stationary wherever it happens to reside instead of forcing it to the
bottom of a 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
@ -246,9 +255,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
@ -262,6 +271,11 @@ the first two, 'erc-button-add-buttons' and 'erc-fill', which have
been swapped with respect to their previous places in recent ERC
versions.
ERC also provisionally reserves the same depth interval for
'erc-insert-pre-hook' and possibly other, similar hooks, but will
continue to modify non-ERC hooks locally whenever possible, especially
in new code.
*** 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

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

@ -1089,7 +1089,7 @@ Change value of property `erc-prompt' from t to `hidden'."
(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."

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

@ -44,42 +44,277 @@
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 forced scroll to prompt.
Only applies with `erc-scrolltobottom-relaxed' while 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)
"Commands exempt from triggering a stash and restore of `window-start'.
Only applies with `erc-scrolltobottom-relaxed' while in the input
area.")
(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.
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.
Assume an unnarrowed buffer."
(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)))
;; It may be desirable to also restore the relative line position of
;; window point after changing dimensions. Perhaps stashing the
;; previous ratio of window line to body height and later recentering
;; proportionally would achieve this.
(defun erc--scrolltobottom-at-prompt-minibuffer-active ()
"Scroll window to bottom when at prompt and using the minibuffer."
;; This is redundant or ineffective in the selected window if at
;; prompt or if only one window exists.
(unless (or (input-pending-p)
(and (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)))
"Add and remove local hooks specific to `erc-scrolltobottom-all'."
(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-at-prompt-minibuffer-active 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-at-prompt-minibuffer-active 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 +370,13 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
(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 +448,15 @@ the active frame."
(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 +471,7 @@ and `keep-place-indicator' in different buffers."
((memq 'keep-place erc-modules)
(erc-keep-place-mode +1))
;; Enable a local version of `keep-place-mode'.
(t (add-hook 'erc-insert-pre-hook #'erc-keep-place 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 +494,7 @@ That is, ensure the local module can survive a user toggling the
global one."
(if erc-keep-place-mode
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(add-hook 'erc-insert-pre-hook #'erc-keep-place 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.

140
test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el Normal file
View file

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

66
test/lisp/erc/erc-scenarios-scrolltobottom.el Normal file
View file

@ -0,0 +1,66 @@
;;; 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)
;; These two actually seem to run fine on Emacs 28, but skip them for
;; now to stay in sync with `erc-scenarios-scrolltobottom--relaxed'.
(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))))))))
(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.el ends here

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

@ -184,6 +184,112 @@ Dialog resource directories are located by expanding the variable
,@body)))
(defvar erc-scenarios-common--term-size '(34 . 80))
(declare-function term-char-mode "term" nil)
(declare-function term-line-mode "term" nil)
;; Much of this concerns accommodating test environments outside of
;; the emacs.git tree, such as CI jobs running ERC's ELPA-package on
;; older Emacsen. See also `erc-tests--assert-printed-in-subprocess'.
(defun erc-scenarios-common--run-in-term (&optional debug)
(require 'term)
(let* ((default-directory (or (getenv "EMACS_TEST_DIRECTORY")
(expand-file-name
".." erc-scenarios-common--resources-dir)))
;; In the emacs.git tree, "HOME" will be "/nonexistent", which
;; is fine because we don't need any ELPA packages.
(process-environment (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))
(init (and-let* ((found (getenv "ERC_TESTS_INIT"))
(files (split-string found ",")))
(mapcan (lambda (f) (list "-l" f)) files)))
(setup `(progn
,@(and (not init) (featurep 'compat)
`((require 'package)
(let ((package-load-list
'((compat t) (,package t))))
(package-initialize))))
(require 'erc)
(cl-assert (equal erc-version ,erc-version) t)))
;; 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))))
(apply #'make-term (symbol-name name)
(expand-file-name invocation-name invocation-directory)
nil `(,@(or init '("-Q")) "-nw"
"-eval" ,(format "%S" 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)))))
(unless noninteractive
(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))
(erc-d-t-wait-for 30 (process-live-p proc))
(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
"Non-nil means run test in an inferior Emacs, even if 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 cygwin haiku))
(ert-skip "System must be UNIX-like"))
(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
@ -210,9 +316,108 @@ Dialog resource directories are located by expanding the variable
(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

46
test/lisp/erc/resources/scrolltobottom/help.eld Normal file
View file

@ -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 ":tester!~u@26axz8nh8zaag.irc QUIT :Quit: \2ERC\2")
(0.02 "ERROR :Quit: \2ERC\2"))