master 5c4a9b73031 4/5: Use marker for max pos in erc--traverse-inserted

[F. Jason Park]

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

    Use marker for max pos in erc--traverse-inserted
    
    * lisp/erc/erc-stamp.el (erc-stamp--propertize-left-date-stamp): Run
    `erc-stamp--insert-date-hook' separately here instead of via
    `erc-insert-modify-hook'.
    (erc-stamp--insert-date-stamp-as-phony-message): Don't include value
    of `erc-stamp--insert-date-hook' in let-bound `erc-insert-modify-hook'
    because its members can run twice if buffer-local.  Remove
    `erc-send-modify-hook' because it only runs via `erc-display-msg'.
    Shadow "pre" and "done" hooks because they don't expect to run in a
    narrowed buffer.  Call getter for `erc-stamp--current-time'.
    (erc-stamp--lr-date-on-pre-modify,
    erc-insert-timestamp-left-and-right): Use function form of
    `erc-stamp--current-time' for determining current time stamp.
    * lisp/erc/erc.el (erc--get-inserted-msg-bounds): Fix off-by-one like
    thinko.
    (erc--traverse-inserted): Create temporary marker when END is a buffer
    position so that insertions and deletions are accounted for in
    the terminating condition.
    (erc--delete-inserted-message): New function.
    * test/lisp/erc/erc-tests.el (erc--delete-inserted-message): New test.
    (erc--update-modules/unknown): Improve readability slightly.
    * test/lisp/erc/resources/erc-d/erc-d-t.el (erc-d-t-make-expecter):
    Indicate assertion flavor in error message.  (Bug#60936)
---
 lisp/erc/erc-stamp.el                    | 18 +++----
 lisp/erc/erc.el                          | 35 +++++++++++--
 test/lisp/erc/erc-tests.el               | 84 +++++++++++++++++++++++++++++---
 test/lisp/erc/resources/erc-d/erc-d-t.el |  1 +
 4 files changed, 119 insertions(+), 19 deletions(-)

diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 2ff1f3832fb..daa33cac3b2 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -638,7 +638,8 @@ printed just after each line's text (no alignment)."
 (defun erc-stamp--propertize-left-date-stamp ()
   (add-text-properties (point-min) (1- (point-max))
                        '(field erc-timestamp erc-stamp-type date-left))
-  (erc--hide-message 'timestamp))
+  (erc--hide-message 'timestamp)
+  (run-hooks 'erc-stamp--insert-date-hook))
 
 ;; A kludge to pass state from insert hook to nested insert hook.
 (defvar erc-stamp--current-datestamp-left nil)
@@ -665,19 +666,18 @@ printed just after each line's text (no alignment)."
   (cl-assert string)
   (let ((erc-stamp--skip t)
         (erc--msg-props (map-into `((erc-msg . datestamp)
-                                    (erc-ts . ,erc-stamp--current-time))
+                                    (erc-ts . ,(erc-stamp--current-time)))
                                   'hash-table))
-        (erc-send-modify-hook `(,@erc-send-modify-hook
-                                erc-stamp--propertize-left-date-stamp
-                                ,@erc-stamp--insert-date-hook))
         (erc-insert-modify-hook `(,@erc-insert-modify-hook
-                                  erc-stamp--propertize-left-date-stamp
-                                  ,@erc-stamp--insert-date-hook)))
+                                  erc-stamp--propertize-left-date-stamp))
+        ;; Don't run hooks that aren't expecting a narrowed buffer.
+        (erc-insert-pre-hook nil)
+        (erc-insert-done-hook nil))
     (erc-display-message nil nil (current-buffer) string)
     (setq erc-timestamp-last-inserted-left string)))
 
 (defun erc-stamp--lr-date-on-pre-modify (_)
-  (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+  (when-let ((ct (erc-stamp--current-time))
              (rendered (erc-stamp--format-date-stamp ct))
              ((not (string-equal rendered erc-timestamp-last-inserted-left)))
              (erc-stamp--current-datestamp-left rendered)
@@ -723,7 +723,7 @@ left-sided stamps and date stamps inserted by this 
function."
       (narrow-to-region erc--insert-marker end-marker)
       (set-marker end-marker nil)
       (set-marker erc--insert-marker nil)))
-  (let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+  (let* ((ct (erc-stamp--current-time))
          (ts-right (with-suppressed-warnings
                        ((obsolete erc-timestamp-format-right))
                      (if erc-timestamp-format-right
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f618fb17076..872ce5b4f49 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2980,7 +2980,7 @@ POINT, search from POINT instead of `point'."
                           (and-let*
                               ((p (previous-single-property-change point
                                                                    'erc-msg)))
-                            (if (= p (1- point)) point (1- p)))))))
+                            (if (= p (1- point)) p (1- p)))))))
           ,@(and (member only '(nil 'end))
                  '((e (1- (next-single-property-change
                            (if at-start-p (1+ point) point)
@@ -3005,8 +3005,12 @@ Expect callers to know that this doesn't wrap BODY in
        ,@body)))
 
 (defun erc--traverse-inserted (beg end fn)
-  "Visit messages between BEG and END and run FN in narrowed buffer."
-  (setq end (min end (marker-position erc-insert-marker)))
+  "Visit messages between BEG and END and run FN in narrowed buffer.
+If END is a marker, possibly update its position."
+  (unless (markerp end)
+    (setq end (set-marker (make-marker) (or end erc-insert-marker))))
+  (unless (eq end erc-insert-marker)
+    (set-marker end (min erc-insert-marker end)))
   (save-excursion
     (goto-char beg)
     (let ((b (if (get-text-property (point) 'erc-msg)
@@ -3018,7 +3022,9 @@ Expect callers to know that this doesn't wrap BODY in
         (save-restriction
           (narrow-to-region b e)
           (funcall fn))
-        (setq b e)))))
+        (setq b e))))
+  (unless (eq end erc-insert-marker)
+    (set-marker end nil)))
 
 (defvar erc--insert-marker nil
   "Internal override for `erc-insert-marker'.")
@@ -3240,6 +3246,27 @@ don't bother including the preceding newline."
           (cl-incf beg))
         (erc--merge-prop (1- beg) (1- end) 'invisible value)))))
 
+(defun erc--delete-inserted-message (beg-or-point &optional end)
+  "Remove message between BEG and END.
+Expect BEG and END to match bounds as returned by the macro
+`erc--get-inserted-msg-bounds'.  Ensure all markers residing at
+the start of the deleted message end up at the beginning of the
+subsequent message."
+  (let ((beg beg-or-point))
+    (save-restriction
+      (widen)
+      (unless end
+        (setq end (erc--get-inserted-msg-bounds nil beg-or-point)
+              beg (pop end)))
+      (with-silent-modifications
+        (if erc-legacy-invisible-bounds-p
+            (delete-region beg (1+ end))
+          (save-excursion
+            (goto-char beg)
+            (insert-before-markers
+             (substring (delete-and-extract-region (1- (point)) (1+ end))
+                        -1))))))))
+
 (defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
 
 (defun erc--order-text-properties-from-hash (table)
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 57bf5860ac4..1af087e7e31 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1432,6 +1432,80 @@
 
           (should-not calls))))))
 
+(ert-deftest erc--delete-inserted-message ()
+  (erc-mode)
+  (erc--initialize-markers (point) nil)
+  ;; Put unique invisible properties on the line endings.
+  (erc-display-message nil 'notice nil "one")
+  (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'a)
+  (let ((erc--msg-prop-overrides '((erc-msg . datestamp) (erc-ts . 0))))
+    (erc-display-message nil nil nil
+                         (propertize "\n[date]" 'field 'erc-timestamp)))
+  (put-text-property (1- erc-insert-marker) erc-insert-marker 'invisible 'b)
+  (erc-display-message nil 'notice nil "two")
+
+  (ert-info ("Date stamp deleted cleanly")
+    (goto-char 11)
+    (should (looking-at (rx "\n[date]")))
+    (should (eq 'datestamp (get-text-property (point) 'erc-msg)))
+    (should (eq (point) (field-beginning (1+ (point)))))
+
+    (erc--delete-inserted-message (point))
+
+    ;; Preceding line ending clobbered, replaced by trailing.
+    (should (looking-back (rx "*** one\n")))
+    (should (looking-at (rx "*** two")))
+    (should (eq 'b (get-text-property (1- (point)) 'invisible))))
+
+  (ert-info ("Markers at pos-bol preserved")
+    (erc-display-message nil 'notice nil "three")
+    (should (looking-at (rx "*** two")))
+
+    (let ((m (point-marker))
+          (n (point-marker))
+          (p (point)))
+      (set-marker-insertion-type m t)
+      (goto-char (point-max))
+      (erc--delete-inserted-message p)
+      (should (= (marker-position n) p))
+      (should (= (marker-position m) p))
+      (goto-char p)
+      (set-marker m nil)
+      (set-marker n nil)
+      (should (looking-back (rx "*** one\n")))
+      (should (looking-at (rx "*** three")))))
+
+  (ert-info ("Compat")
+    (erc-display-message nil 'notice nil "four")
+    (should (looking-at (rx "*** three\n")))
+    (with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
+      (let ((erc-legacy-invisible-bounds-p t))
+        (erc--delete-inserted-message (point))))
+    (should (looking-at (rx "*** four\n"))))
+
+  (ert-info ("Deleting most recent message preserves markers")
+    (let ((m (point-marker))
+          (n (point-marker))
+          (p (point)))
+      (should (equal "*** four\n" (buffer-substring p erc-insert-marker)))
+      (set-marker-insertion-type m t)
+      (goto-char (point-max))
+      (erc--delete-inserted-message p)
+      (should (= (marker-position m) p))
+      (should (= (marker-position n) p))
+      (goto-char p)
+      (should (looking-back (rx "*** one\n")))
+      (should (looking-at erc-prompt))
+      (erc--assert-input-bounds)
+
+      ;; However, `m' is now forever "trapped" at `erc-insert-marker'.
+      (erc-display-message nil 'notice nil "two")
+      (should (= m erc-insert-marker))
+      (goto-char n)
+      (should (looking-at (rx "*** two\n")))
+      (set-marker m nil)
+      (set-marker n nil))))
+
 (ert-deftest erc--order-text-properties-from-hash ()
   (let ((table (map-into '((a . 1)
                            (erc-ts . 0)
@@ -2617,8 +2691,8 @@
               (obarray (obarray-make))
               (err (should-error (erc--update-modules erc-modules))))
          (should (equal (cadr err) "`foo' is not a known ERC module"))
-         (should (equal (funcall get-calls)
-                        `((req . ,(intern-soft "erc-foo")))))))
+         (should (equal (mapcar #'prin1-to-string (funcall get-calls))
+                        '("(req . erc-foo)")))))
 
      ;; Module's mode command exists but lacks an associated file.
      (ert-info ("Bad autoload flagged as suspect")
@@ -2627,10 +2701,8 @@
               (obarray (obarray-make))
               (erc-modules (list (intern "foo"))))
 
-         ;; Create a mode activation command.
+         ;; Create a mode-activation command and make mode-var global.
          (funcall mk-cmd "foo")
-
-         ;; Make the mode var global.
          (funcall mk-global "foo")
 
          ;; No local modules to return.
@@ -2639,7 +2711,7 @@
                         '("foo")))
          ;; ERC requires the library via prefixed module name.
          (should (equal (mapcar #'prin1-to-string (funcall get-calls))
-                        `("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
+                        '("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
 
 ;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
 ;; load its defining library, first via the symbol property
diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el 
b/test/lisp/erc/resources/erc-d/erc-d-t.el
index cf869fb3c70..7126165fd91 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-t.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-t.el
@@ -157,6 +157,7 @@ ON-SUCCESS, is nonexistent.  To reset, specify a FROM 
argument."
   (let (positions)
     (lambda (timeout text &optional reset-from)
       (let* ((pos (cdr (assq (current-buffer) positions)))
+             (erc-d-t--wait-message-prefix (and (< timeout 0) "Sustaining: "))
              (cb (lambda ()
                    (unless pos
                      (push (cons (current-buffer) (setq pos (make-marker)))