From: F. Jason Park Date: Mon, 9 Sep 2024 22:23:46 +0000 (-0700) Subject: Make erc-keep-place-indicator aware of erc-truncate X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=15ffcc74fb3519010395af0cc7ffb5c120e6799e;p=emacs.git 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) (cherry picked from commit 4d7f41716e1485fb57efc6eac9f45f2879c90266) --- diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 135f3936572..34cf9ceb377 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -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 diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 97c9b264983..ec1e0054dd5 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -306,6 +306,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))) @@ -368,6 +381,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)) @@ -399,7 +414,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 @@ -416,6 +433,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 @@ -439,6 +471,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))))) diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el b/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el new file mode 100644 index 00000000000..d6d50ab09a6 --- /dev/null +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator-trunc.el @@ -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 . + +;;; 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 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 " tester, welcome!") + (erc-scenarios-common-say "one") + (erc-scenarios-common-say "two") + (funcall expect 10 " 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 " Ready") + (redisplay) + (funcall expect 10 "]\n 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 diff --git a/test/lisp/erc/erc-scenarios-keep-place-indicator.el b/test/lisp/erc/erc-scenarios-keep-place-indicator.el index ccd6f81b7d2..435bbcef304 100644 --- a/test/lisp/erc/erc-scenarios-keep-place-indicator.el +++ b/test/lisp/erc/erc-scenarios-keep-place-indicator.el @@ -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")