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
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
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
(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."
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
(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
(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)))
((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))
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.
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
,@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
(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
--- /dev/null
+;; -*- 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"))
projects / emacs.git / commitdiff