master 4d7f41716e1 7/9: Make erc-keep-place-indicator aware of erc-truncate

[F. Jason Park]

branch: master
commit 4d7f41716e1485fb57efc6eac9f45f2879c90266
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    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)
---
 etc/ERC-NEWS                                       |  4 +
 lisp/erc/erc-goodies.el                            | 37 ++++++++-
 .../erc-scenarios-keep-place-indicator-trunc.el    | 94 ++++++++++++++++++++++
 .../lisp/erc/erc-scenarios-keep-place-indicator.el |  7 +-
 4 files changed, 137 insertions(+), 5 deletions(-)

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 9837ec302ee..38c2918af8f 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -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)))))
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 <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
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")