master 31a80f61ec0 5/5: Preserve prompt in erc-cmd-CLEAR

[F. Jason Park]

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

    Preserve prompt in erc-cmd-CLEAR
    
    * etc/ERC-NEWS: Mention behavioral changes to functionality provided
    by the `truncate' and `log' modules and also the "/CLEAR" command.
    * lisp/erc/erc-log.el (erc-truncate-buffer-on-save): Deprecate option
    because three's a crowd, and ERC already has a dedicated module as
    well as a slash command for this purpose.  And although this commit
    restores functionality, this option has been unusable since at least
    the release of ERC 5.5, with no known complaints received thus far.
    Also, the doc string of `erc-save-buffer-in-logs' makes no mention of
    this feature WRT interactive invocations or otherwise.
    (erc-log-mode, erc-log-enable, erc-log-disable): Subscribe to
    new internal hook `erc--pre-clear-functions'.
    (erc-log--save-in-progress-p): New variable to help restore
    `erc-truncate-buffer-on-save' and promote code reuse.
    (erc-logging-enabled): Guard with `erc-log--saved-in-progress-p'.
    (erc-save-buffer-in-logs): Overload `buffer' parameter to allow
    various hooks to supply a non-buffer as well.  Warn when people use
    `erc-truncate-buffer-on-save', which is now deprecated.
    * lisp/erc/erc-stamp.el (erc-stamp-mode, erc-stamp-enable,
    erc-stamp-disable): Subscribe to `erc--pre-clear-functions'.
    (erc-stamp--update-saved-position): New function for updating
    last-logged marker on `erc-stamp--insert-date-function'.
    (erc-stamp--reset-on-clear): New function to forget last inserted
    stamps when truncating.
    * lisp/erc/erc-truncate.el (erc-truncate-mode, erc-truncate-enable,
    erc-truncate-disable): Use `erc-insert-done-hook' instead of
    `erc-insert-post-hook', as implicitly suggested by an ancient comment,
    which ponders whether truncating the buffer at the insertion phase may
    be harmful to other hook members.
    (erc-truncate-buffer-to-size): Set truncation boundary at message
    break instead of line break.  Run `erc--pre-clear-functions'.
    (erc-truncate-buffer): Save excursion.  This should probably be
    handled by `erc-truncate-buffer-to-size' instead, but that's
    likelier to cause breakage in third-party code.
    * lisp/erc/erc.el (erc--pre-clear-functions): New internal hook.
    (erc-cmd-CLEAR): Run `erc--pre-clear-functions' before clearing, and
    don't blow away prompt.  The latter was a regression caused by
    05f6fdb9e78 "Preserve ERC prompt and its bounding markers".
    * test/lisp/erc/erc-scenarios-log.el: New file.  (Bug#60936)
---
 etc/ERC-NEWS                       |  11 ++
 lisp/erc/erc-log.el                |  17 ++-
 lisp/erc/erc-stamp.el              |  16 +++
 lisp/erc/erc-truncate.el           |  21 ++--
 lisp/erc/erc.el                    |   9 +-
 test/lisp/erc/erc-scenarios-log.el | 207 +++++++++++++++++++++++++++++++++++++
 6 files changed, 264 insertions(+), 17 deletions(-)

diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index c7d157eacfb..e9ec9e2caab 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -131,6 +131,17 @@ 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'.
 
+** Improved interplay between buffer truncation and message logging.
+While most of these improvements are subtle, some affect everyday use.
+For example, users of the 'truncate' module may notice that truncation
+now happens between messages rather than arbitrary lines.  And those
+with the default 'erc-insert-timestamp-left-and-right' for their
+'erc-insert-timestamp-function' will see date stamps reprinted after
+every "/CLEAR" but omitted from any logs.  One notable casualty of
+these changes has been the deprecation of the ancient option
+'erc-truncate-buffer-on-save'.  Users of the 'log' module can achieve
+the same effect by issuing a "/CLEAR" at the prompt.
+
 ** Miscellaneous UX changes.
 Some minor quality-of-life niceties have finally made their way to
 ERC.  For example, the function 'erc-echo-timestamp' is now
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 2b58a7c56ed..d3106da4017 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -124,6 +124,7 @@ custom function which returns the directory part and set
 (defcustom erc-truncate-buffer-on-save nil
   "Erase the contents of any ERC (channel, query, server) buffer when it is 
saved."
   :type 'boolean)
+(make-obsolete 'erc-truncate-buffer-on-save 'erc-cmd-CLEAR "30.1")
 
 (defcustom erc-enable-logging t
   "If non-nil, ERC will log IRC conversations.
@@ -230,6 +231,7 @@ also be a predicate function.  To only log when you are not 
set away, use:
    (add-hook 'erc-part-hook #'erc-conditional-save-buffer)
    ;; append, so that 'erc-initialize-log-marker runs first
    (add-hook 'erc-connect-pre-hook #'erc-log-setup-logging 'append)
+   (add-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs)
    (dolist (buffer (erc-buffer-list))
      (erc-log-setup-logging buffer))
    (erc--modify-local-map t "C-c C-l" #'erc-save-buffer-in-logs))
@@ -242,6 +244,7 @@ also be a predicate function.  To only log when you are not 
set away, use:
    (remove-hook 'erc-quit-hook #'erc-conditional-save-queries)
    (remove-hook 'erc-part-hook #'erc-conditional-save-buffer)
    (remove-hook 'erc-connect-pre-hook #'erc-log-setup-logging)
+   (remove-hook 'erc--pre-clear-functions #'erc-save-buffer-in-logs)
    (dolist (buffer (erc-buffer-list))
      (erc-log-disable-logging buffer))
    (erc--modify-local-map nil "C-c C-l" #'erc-save-buffer-in-logs)))
@@ -301,6 +304,8 @@ Returns nil if `erc-server-buffer-p' returns t."
   (dolist (buffer (erc-buffer-list))
     (erc-save-buffer-in-logs buffer)))
 
+(defvar erc-log--save-in-progress-p nil)
+
 ;;;###autoload
 (defun erc-logging-enabled (&optional buffer)
   "Return non-nil if logging is enabled for BUFFER.
@@ -310,6 +315,7 @@ is writable (it will be created as necessary) and
 `erc-enable-logging' returns a non-nil value."
   (or buffer (setq buffer (current-buffer)))
   (and erc-log-channels-directory
+       (not erc-log--save-in-progress-p)
        (or (functionp erc-log-channels-directory)
           (erc-directory-writable-p erc-log-channels-directory))
        (if (functionp erc-enable-logging)
@@ -399,7 +405,7 @@ automatically.
 You can save every individual message by putting this function on
 `erc-insert-post-hook'."
   (interactive)
-  (or buffer (setq buffer (current-buffer)))
+  (unless (bufferp buffer) (setq buffer (current-buffer)))
   (when (erc-logging-enabled buffer)
     (let ((file (erc-current-logfile buffer))
           (coding-system erc-log-file-coding-system))
@@ -423,10 +429,11 @@ You can save every individual message by putting this 
function on
                    (write-region start end file t 'nomessage))))
              (if (and erc-truncate-buffer-on-save
                       (called-interactively-p 'interactive))
-                 (progn
-                   (let ((inhibit-read-only t)) (erase-buffer))
-                   (move-marker erc-last-saved-position (point-max))
-                   (erc-display-prompt))
+                  (let ((erc-log--save-in-progress-p t))
+                    (erc-cmd-CLEAR)
+                    (erc-button--display-error-notice-with-keys
+                     (erc-server-buffer) "Option `%s' is deprecated."
+                     " Use /CLEAR instead." 'erc-truncate-buffer-on-save))
                (move-marker erc-last-saved-position
                             ;; If we place erc-last-saved-position at
                             ;; erc-insert-marker, because text gets
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 9191bbe5a2a..500f6f3c0c9 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -166,12 +166,14 @@ from entering them and instead jump over them."
    (add-hook 'erc-insert-modify-hook #'erc-add-timestamp t)
    (add-hook 'erc-send-modify-hook #'erc-add-timestamp t)
    (add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
+   (add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
    (unless erc--updating-modules-p
      (erc-buffer-filter #'erc-munge-invisibility-spec)))
   ((remove-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
    (remove-hook 'erc-insert-modify-hook #'erc-add-timestamp)
    (remove-hook 'erc-send-modify-hook #'erc-add-timestamp)
    (remove-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
+   (remove-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
    (erc-with-all-buffers-of-server nil nil
      (kill-local-variable 'erc-timestamp-last-inserted)
      (kill-local-variable 'erc-timestamp-last-inserted-left)
@@ -584,6 +586,20 @@ enabled when the message was inserted."
 (defun erc--echo-ts-csf (_window _before dir)
   (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
 
+(defun erc-stamp--update-saved-position (&rest _)
+  (remove-function (local 'erc-stamp--insert-date-function)
+                   #'erc-stamp--update-saved-position)
+  (move-marker erc-last-saved-position (1- (point))))
+
+(defun erc-stamp--reset-on-clear (pos)
+  "Forget last-inserted stamps when POS is at insert marker."
+  (when (= pos (1- erc-insert-marker))
+    (add-function :after (local 'erc-stamp--insert-date-function)
+                  #'erc-stamp--update-saved-position)
+    (setq erc-timestamp-last-inserted nil
+          erc-timestamp-last-inserted-left nil
+          erc-timestamp-last-inserted-right nil)))
+
 (provide 'erc-stamp)
 
 ;;; erc-stamp.el ends here
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index b8fd4ae2e14..8430a68d92b 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -50,9 +50,9 @@ This prevents the query buffer from getting too large, which 
can
 bring any grown Emacs to its knees after a few days worth of
 tracking heavy-traffic channels."
   ;;enable
-  ((add-hook 'erc-insert-post-hook #'erc-truncate-buffer))
+  ((add-hook 'erc-insert-done-hook #'erc-truncate-buffer))
   ;; disable
-  ((remove-hook 'erc-insert-post-hook #'erc-truncate-buffer)))
+  ((remove-hook 'erc-insert-done-hook #'erc-truncate-buffer)))
 
 ;;;###autoload
 (defun erc-truncate-buffer-to-size (size &optional buffer)
@@ -75,9 +75,11 @@ region is logged if `erc-logging-enabled' returns non-nil."
       (save-restriction
        (widen)
        (let ((end (- erc-insert-marker size)))
-         ;; truncate at line boundaries
+          ;; Truncate at message boundary (formerly line boundary
+          ;; before 5.6).
          (goto-char end)
-         (beginning-of-line)
+          (goto-char (or (previous-single-property-change (point) 'erc-command)
+                         (pos-bol)))
          (setq end (point))
          ;; try to save the current buffer using
          ;; `erc-save-buffer-in-logs'.  We use this, in case the
@@ -91,10 +93,7 @@ region is logged if `erc-logging-enabled' returns non-nil."
          ;; (not (memq 'erc-save-buffer-in-logs
          ;;             erc-insert-post-hook))
          ;; Comments?
-         (when (and (boundp 'erc-enable-logging)
-                    erc-enable-logging
-                    (erc-logging-enabled buffer))
-           (erc-save-buffer-in-logs))
+          (run-hook-with-args 'erc--pre-clear-functions end)
          ;; disable undoing for the truncating
          (buffer-disable-undo)
          (let ((inhibit-read-only t))
@@ -103,10 +102,10 @@ region is logged if `erc-logging-enabled' returns 
non-nil."
 
 ;;;###autoload
 (defun erc-truncate-buffer ()
-  "Truncates the current buffer to `erc-max-buffer-size'.
-Meant to be used in hooks, like `erc-insert-post-hook'."
+  "Truncate current buffer to `erc-max-buffer-size'."
   (interactive)
-  (erc-truncate-buffer-to-size erc-max-buffer-size))
+  (save-excursion
+    (erc-truncate-buffer-to-size erc-max-buffer-size)))
 
 (provide 'erc-truncate)
 ;;; erc-truncate.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 9c1125a9351..5a91285c1d1 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3436,10 +3436,17 @@ If no USER argument is specified, list the contents of 
`erc-ignore-list'."
       (erc-with-server-buffer
         (setq erc-ignore-list (delete user erc-ignore-list))))))
 
+(defvar erc--pre-clear-functions nil
+  "Abnormal hook run when truncating buffers.
+Called with position indicating boundary of interval to be excised.")
+
 (defun erc-cmd-CLEAR ()
   "Clear the window content."
   (let ((inhibit-read-only t))
-    (delete-region (point-min) (line-beginning-position)))
+    (run-hook-with-args 'erc--pre-clear-functions (1- erc-insert-marker))
+    ;; Ostensibly, `line-beginning-position' is for use in lisp code.
+    (delete-region (point-min) (min (line-beginning-position)
+                                    (1- erc-insert-marker))))
   t)
 (put 'erc-cmd-CLEAR 'process-not-needed t)
 
diff --git a/test/lisp/erc/erc-scenarios-log.el 
b/test/lisp/erc/erc-scenarios-log.el
new file mode 100644
index 00000000000..c37e6b323aa
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -0,0 +1,207 @@
+;;; erc-scenarios-log.el --- erc-log scenarios -*- 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+  (let ((load-path (cons (ert-resource-directory) load-path)))
+    (require 'erc-scenarios-common)))
+
+(require 'erc-log)
+(require 'erc-truncate)
+
+(defvar erc-timestamp-format-left)
+
+(ert-deftest erc-scenarios-log--kill-hook ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
+       (dumb-server (erc-d-run "localhost" t 'foonet))
+       (tempdir (make-temp-file "erc-tests-log." t nil nil))
+       (erc-log-channels-directory tempdir)
+       (erc-modules (cons 'log erc-modules))
+       (port (process-contact dumb-server :service))
+       (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
+                                  tempdir))
+       (erc-server-flood-penalty 0.1)
+       (expect (erc-d-t-make-expecter)))
+
+    (ert-info ("Connect to foonet")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester"
+                                :password "foonet:changeme"
+                                :full-name "tester")
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+        (funcall expect 5 "foonet")))
+
+    (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+      (funcall expect 10 "was created on")
+      (funcall expect 10 "please your lordship")
+      (with-current-buffer "foonet"
+        (delete-process erc-server-process)
+        (funcall expect 5 "failed"))
+      (should-not (file-exists-p logfile))
+      (kill-buffer)
+      (should (file-exists-p logfile)))
+
+    (with-temp-buffer
+      (insert-file-contents logfile)
+      (funcall expect 1 "You have joined")
+      (funcall expect 1 "Playback Complete.")
+      (funcall expect 1 "please your lordship"))
+
+    (erc-log-mode -1)
+    (if noninteractive
+        (delete-directory tempdir :recursive)
+      (add-hook 'kill-emacs-hook
+                (lambda () (delete-directory tempdir :recursive))))))
+
+;; This shows that, in addition to truncating the buffer, /clear also
+;; syncs the log.
+
+(ert-deftest erc-scenarios-log--clear-stamp ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
+       (dumb-server (erc-d-run "localhost" t 'foonet))
+       (tempdir (make-temp-file "erc-tests-log." t nil nil))
+       (erc-log-channels-directory tempdir)
+       (erc-modules (cons 'log erc-modules))
+       (erc-timestamp-format-left "\n[%a %b %e %Y @@STAMP@@]\n")
+       (port (process-contact dumb-server :service))
+       (logfile (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
+                                  tempdir))
+       (erc-server-flood-penalty 0.1)
+       (expect (erc-d-t-make-expecter)))
+
+    (unless noninteractive
+      (add-hook 'kill-emacs-hook
+                (lambda () (delete-directory tempdir :recursive))))
+
+    (ert-info ("Connect to foonet")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester"
+                                :password "foonet:changeme"
+                                :full-name "tester")
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+        (funcall expect 5 "foonet")))
+
+    (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+      (funcall expect 10 "@@STAMP@@")
+      (funcall expect 10 "Grows, lives")
+      (should-not (file-exists-p logfile))
+      (goto-char (point-max))
+      (erc-cmd-CLEAR)
+      (should (file-exists-p logfile))
+      (funcall expect 10 "please your lordship")
+      (ert-info ("Buffer truncated")
+        (goto-char (point-min))
+        (funcall expect 10 "@@STAMP@@" (point)) ; reset
+        (funcall expect -0.1 "Grows, lives")
+        (funcall expect 1 "For these two")))
+
+    (ert-info ("Current contents saved")
+      (with-temp-buffer
+        (insert-file-contents logfile)
+        (funcall expect 1 "@@STAMP@@")
+        (funcall expect 1 "You have joined")
+        (funcall expect 1 "Playback Complete.")
+        (funcall expect 1 "Grows, lives")
+        (funcall expect -0.01 "please your lordship")))
+
+    (ert-info ("Remainder saved, timestamp printed when option non-nil")
+      (with-current-buffer "foonet"
+        (delete-process erc-server-process)
+        (funcall expect 5 "failed"))
+      (kill-buffer "#chan")
+      (with-temp-buffer
+        (insert-file-contents logfile)
+        (funcall expect 1 "@@STAMP@@")
+        (funcall expect 1 "Grows, lives")
+        (funcall expect -0.01 "@@STAMP@@")
+        (forward-line 1) ; no blank, no timestamp
+        (should (looking-at (rx "<bob> alice: For these two hours,")))
+        (funcall expect 1 "please your lordship")))
+
+    (erc-log-mode -1)
+    (when noninteractive (delete-directory tempdir :recursive))))
+
+(ert-deftest erc-scenarios-log--truncate ()
+  :tags '(:expensive-test)
+  (erc-scenarios-common-with-cleanup
+      ((erc-scenarios-common-dialog "base/assoc/bouncer-history")
+       (dumb-server (erc-d-run "localhost" t 'foonet))
+       (tempdir (make-temp-file "erc-tests-log." t nil nil))
+       (erc-log-channels-directory tempdir)
+       (erc-modules (cons 'truncate (cons 'log erc-modules)))
+       (erc-max-buffer-size 512)
+       (port (process-contact dumb-server :service))
+       (logchan (expand-file-name (format "#chan!tester@127.0.0.1:%d.txt" port)
+                                  tempdir))
+       (logserv (expand-file-name
+                 (format "127.0.0.1:%d!tester@127.0.0.1:%d.txt" port port)
+                 tempdir))
+       (erc-server-flood-penalty 0.1)
+       (expect (erc-d-t-make-expecter)))
+
+    (unless noninteractive
+      (add-hook 'kill-emacs-hook
+                (lambda () (delete-directory tempdir :recursive))))
+
+    (ert-info ("Connect to foonet")
+      (with-current-buffer (erc :server "127.0.0.1"
+                                :port port
+                                :nick "tester"
+                                :password "foonet:changeme"
+                                :full-name "tester")
+        (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+        (should-not (file-exists-p logserv))
+        (should-not (file-exists-p logchan))
+        (funcall expect 10 "*** MAXLIST=beI:60")
+        (should (= (pos-bol) (point-min)))
+        (should (file-exists-p logserv))))
+
+    (ert-info ("Log file ahead of truncation point")
+      ;; Log contains lines still present in buffer.
+      (with-temp-buffer
+        (insert-file-contents logserv)
+        (funcall expect 10 "*** MAXLIST=beI:60")))
+
+    (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+      (funcall expect 10 "please your lordship")
+      (should (file-exists-p logchan))
+      (funcall expect -0.1 "[07:04:37] alice: Here," (point-min)))
+
+    (ert-info ("Log ahead of truncation point")
+      (with-temp-buffer
+        (insert-file-contents logchan)
+        (funcall expect 1 "You have joined")
+        (funcall expect 1 "[07:04:37] alice: Here,")
+        (funcall expect 1 "loathed enemy")
+        (funcall expect -0.1 "please your lordship")))
+
+    (erc-log-mode -1)
+    (when noninteractive (delete-directory tempdir :recursive))))
+
+;;; erc-scenarios-log.el ends here