* 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)
(cherry picked from commit
4d7f41716e1485fb57efc6eac9f45f2879c90266)
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.
+
\f
* Changes in ERC 5.6
: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)))
#'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))
(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
(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
(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)))))
--- /dev/null
+;;; 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
(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")
projects / emacs.git / commitdiff