From 617ddb808999a71c925b68f5369d77aebfcd9254 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 22 Jul 2023 00:46:44 -0700 Subject: [PATCH] Consider all windows in erc-scrolltobottom-mode * 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) --- etc/ERC-NEWS | 20 +- lisp/erc/erc-backend.el | 2 +- lisp/erc/erc-goodies.el | 274 ++++++++++++++++-- .../erc-scenarios-scrolltobottom-relaxed.el | 140 +++++++++ test/lisp/erc/erc-scenarios-scrolltobottom.el | 66 +++++ .../erc/resources/erc-scenarios-common.el | 205 +++++++++++++ .../erc/resources/scrolltobottom/help.eld | 46 +++ 7 files changed, 731 insertions(+), 22 deletions(-) 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 8997bd3e97b..05e933930e2 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' 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 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 @@ 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." diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index b37855cbecc..b261f381382 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -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. 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 . + +;; 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..dd0a8612388 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el @@ -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 . + +;;; 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 diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index 2eb040d28d9..19f26bf08bd 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -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 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 [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 [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")) -- 2.39.5