Make erc-keep-place-indicator aware of erc-truncate

* etc/ERC-NEWS: Entry mentioning `erc-keep-place-indicator-truncation'.
* lisp/erc/erc-goodies.el (erc-keep-place-indicator-truncation): New
option.  Something like this should have accompanied the module's
introduction.
(erc-keep-place-indicator-mode, erc-keep-place-indicator-enable)
(erc-keep-place-indicator-disable): Arrange to take necessary measures
to avoid losing the indicator on `erc--clear-function'.  This module was
first introduced by bug#59943.
(erc--keep-place-move-hook): New variable.
(erc--keep-place-indicator-adjust-on-clear): New function.
(erc-keep-place-move): Try to ensure the overlay resides at the
beginning of a message.  Run hook `erc--keep-place-move-hook'.
* test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el: New file.
* test/lisp/erc/erc-scenarios-keep-place-indicator.el
(erc-scenarios-keep-place-indicator--follow): Fix missing test
description.  (Bug#72736)
This commit is contained in:
F. Jason Park 2024-09-09 15:23:46 -07:00
parent 51d5419fdc
commit 4d7f41716e
4 changed files with 137 additions and 5 deletions

View file

@ -26,6 +26,10 @@ In fast-moving channels and in queries with long-winded bots, the
on account of a rather stingy buffering threshold of 512 characters.
Now configurable, its default has been relaxed eightfold to 4096.
** New option determines 'keep-place-indicator's influence on 'truncate'.
Option 'erc-keep-place-indicator-truncation' manages the tension between
truncation and place keeping, prioritizing one or the other.
* Changes in ERC 5.6

View file

@ -308,6 +308,19 @@ buffer than the window's start."
:package-version '(ERC . "5.6")
:type 'boolean)
(defcustom erc-keep-place-indicator-truncation nil
"What to do when truncation occurs and the buffer is trimmed.
If nil, a truncation event moves the indicator, effectively resetting it
to `point-min'. If this option's value is t, the indicator stays put
and limits the operation, but only when it resides on an actual message.
That is, if it remains at its initial position at or near `point-min',
truncation will still occur. As of ERC 5.6.1, this option only
influences the behavior of the `truncate' module, rather than truncation
resulting from a /CLEAR."
:group 'erc
:package-version '(ERC . "5.6.1")
:type 'boolean)
(defface erc-keep-place-indicator-line
'((((class color) (min-colors 88) (background light)
(supports :underline (:style wave)))
@ -370,6 +383,8 @@ and `keep-place-indicator' in different buffers."
#'erc--keep-place-indicator-on-window-buffer-change 40)
(add-hook 'erc-keep-place-mode-hook
#'erc--keep-place-indicator-on-global-module 40)
(add-function :before (local 'erc--clear-function)
#'erc--keep-place-indicator-adjust-on-clear '((depth . 40)))
(if (pcase erc-keep-place-indicator-buffer-type
('target erc--target)
('server (not erc--target))
@ -401,7 +416,9 @@ and `keep-place-indicator' in different buffers."
(remove-hook 'erc-keep-place-mode-hook
#'erc--keep-place-indicator-on-global-module)
(remove-hook 'window-buffer-change-functions
#'erc--keep-place-indicator-on-window-buffer-change)))
#'erc--keep-place-indicator-on-window-buffer-change)
(remove-function (local 'erc--clear-function)
#'erc--keep-place-indicator-adjust-on-clear)))
(when (local-variable-p 'erc-insert-pre-hook)
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t))
(remove-hook 'erc-keep-place-mode-hook
@ -418,6 +435,21 @@ Do this by simulating `keep-place' in all buffers where
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
(add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t))))
(defvar erc--keep-place-move-hook nil
"Hook run when `erc-keep-place-move' moves the indicator.")
(defun erc--keep-place-indicator-adjust-on-clear (beg end)
"Either shrink region bounded by BEG to END to preserve overlay, or reset."
(when-let ((pos (overlay-start erc--keep-place-indicator-overlay))
((<= beg pos end)))
(if (and erc-keep-place-indicator-truncation
(not erc--called-as-input-p))
(when-let ((pos (erc--get-inserted-msg-beg pos)))
(set-marker end pos))
(let (erc--keep-place-move-hook)
;; Move earlier than `beg', which may delimit date stamps, etc.
(erc-keep-place-move (point-min))))))
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.
For use with `keep-place-indicator' module. When called
@ -441,6 +473,9 @@ window's first line. Interpret an integer as an offset in lines."
(let ((inhibit-field-text-motion t))
(when pos
(goto-char pos))
(when-let ((pos (erc--get-inserted-msg-beg)))
(goto-char pos))
(run-hooks 'erc--keep-place-move-hook)
(move-overlay erc--keep-place-indicator-overlay
(line-beginning-position)
(line-end-position)))))

View file

@ -0,0 +1,94 @@
;;; erc-scenarios-keep-place-indicator-trunc.el --- `truncate' integration -*- lexical-binding: t -*-
;; Copyright (C) 2024 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert-x)
(eval-and-compile
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
(require 'erc-goodies)
(ert-deftest erc-scenarios-keep-place-indicator-trunc ()
:tags `(:expensive-test
,@(and (getenv "ERC_TESTS_GRAPHICAL") '(:erc--graphical)))
(when (and noninteractive (= emacs-major-version 27))
(ert-skip "Times out"))
(defvar erc-max-buffer-size)
(defvar erc-truncate-padding-size)
(erc-scenarios-common-with-noninteractive-in-term
((erc-scenarios-common-dialog "keep-place")
(dumb-server (erc-d-run "localhost" t 'follow))
(port (process-contact dumb-server :service))
(erc-modules `( keep-place-indicator scrolltobottom
truncate ,@erc-modules))
(erc-server-flood-penalty 0.1)
(erc-max-buffer-size 300)
(erc-truncate-padding-size 200)
(erc-keep-place-indicator-truncation t)
(erc-autojoin-channels-alist '((foonet "#chan" "#spam")))
(expect (erc-d-t-make-expecter)))
(with-current-buffer (erc :server "127.0.0.1"
:port port
:full-name "tester"
:nick "tester"
:user "tester")
(funcall expect 10 "debug mode"))
(with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
(set-window-buffer nil (current-buffer))
(delete-other-windows)
(ert-info ("Truncation occurs because indicator still at start pos")
(funcall expect 10 "]\n<alice> bob: And what I spake")
(redisplay)
(should (= (overlay-start erc--keep-place-indicator-overlay) 2))
(funcall expect 10 "Yes, faith will I")
(goto-char (point-max)))
(switch-to-buffer (erc-d-t-wait-for 10 (get-buffer "#spam"))) ; lower
(funcall expect 10 "<alice> tester, welcome!")
(erc-scenarios-common-say "one")
(erc-scenarios-common-say "two")
(funcall expect 10 "<bob> Cause they take")
(erc-scenarios-common-say "three")
(goto-char (point-max))
(ert-info ("Truncation limited by indicator")
(switch-to-buffer "#chan")
(funcall expect 10 "<bob> Ready")
(redisplay)
(funcall expect 10 "]\n<alice> Yes, faith will I" (point-min))
(should (= (overlay-start erc--keep-place-indicator-overlay)
(pos-bol)))
(should (> (buffer-size) 500)))
(ert-info ("Normal keep-place behavior still present")
(switch-to-buffer "#spam")
(should (< (point) erc-input-marker)))
(erc-keep-place-mode -1)
(erc-scrolltobottom-mode -1))))
;;; erc-scenarios-keep-place-indicator-trunc.el ends here

View file

@ -125,11 +125,10 @@
(save-excursion
(goto-char (window-point))
(should (looking-back (rx "you can cog")))
(should (= (pos-bol) (window-start)))
(should (= (overlay-start erc--keep-place-indicator-overlay)
(pos-bol)))))
(should (= (pos-bol) (window-start)
(overlay-start erc--keep-place-indicator-overlay)))))
(ert-info ("description")
(ert-info ("Point formerly at prompt resides at last arrived message")
(erc-send-input-line "#spam" "three")
(save-excursion (erc-d-t-search-for 10 "Ready"))
(switch-to-buffer "#spam")