master 21b372a57bb 3/6: Improve erc-fill-wrap-merge refilling and movement

[F. Jason Park]

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

    Improve erc-fill-wrap-merge refilling and movement
    
    * lisp/erc/erc-fill.el (erc-fill--wrap-escape-hidden-speaker): Add
    parameter to suppress escaping of hidden prefixes.
    (erc-fill--wrap-beginning-of-line): Remember original value of point,
    and pass it to `erc-fill--wrap-escape-hidden-speaker'.
    (erc-fill--wrap-previous-line, erc-fill--wrap-next-line): Guard call
    to `erc-fill--wrap-escape-hidden-speaker' with conditional check for
    `erc-fill-wrap-merge'.
    (erc-fill--wrap-insert-merged-pre): Add additional text property,
    `erc-fill--wrap-merge', to help identify `display' regions servicing
    `erc-fill-wrap-merge'.  This should make resolving inconsistencies
    easier when "splicing" new messages between existing ones.
    (erc-fill-wrap): Add `erc-fill--wrap-merge' text property to merged
    speaker region.
    (erc-fill--wrap-rejigger-region): Remove assertion disallowing a
    non-nil `erc-fill--wrap-rejigger-last-message'.  Instead, adopt the
    existing value of that variable when shadowing it for the remaining
    extent of the function's execution.  When removing the `display'
    property, also look for nonempty replacement text, such as values
    specified by the option `erc-fill-wrap-merge-indicator'.
    (erc-fill--wrap-merged-button-p): Look for `erc-fill--wrap-merge'
    property instead of `display'.
    * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld:
    Update.
    * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
    (Bug#60936)
---
 lisp/erc/erc-fill.el                               | 72 +++++++++++++---------
 .../resources/fill/snapshots/merge-01-start.eld    |  2 +-
 .../resources/fill/snapshots/merge-02-right.eld    |  2 +-
 .../erc/resources/fill/snapshots/merge-wrap-01.eld |  2 +-
 .../fill/snapshots/merge-wrap-indicator-pre-01.eld |  2 +-
 .../resources/fill/snapshots/spacing-01-mono.eld   |  2 +-
 6 files changed, 48 insertions(+), 34 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 7e21a097c7c..c5d4e9c9e6f 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -318,24 +318,30 @@ command."
   ;; `kill-line' anyway so that users can see the error.
   (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
 
-(defun erc-fill--wrap-escape-hidden-speaker ()
+(defun erc-fill--wrap-escape-hidden-speaker (&optional old-point)
   "Move to start of message text when left of speaker.
-Basically mimic what `move-beginning-of-line' does with invisible text."
+Basically mimic what `move-beginning-of-line' does with invisible text.
+Stay put if OLD-POINT lies within hidden region."
   (when-let ((erc-fill-wrap-merge)
-             (prop (get-text-property (point) 'display))
-             ((or (equal prop "") (eq 'margin (car-safe (car-safe prop))))))
-    (goto-char (text-property-not-all (point) (pos-eol) 'display prop))))
+             (prop (get-text-property (point) 'erc-fill--wrap-merge))
+             ((or (member prop '("" t))
+                  (eq 'margin (car-safe (car-safe prop)))))
+             (end (text-property-not-all (point) (pos-eol)
+                                         'erc-fill--wrap-merge prop))
+             ((or (null old-point) (>= old-point end))))
+    (goto-char end)))
 
 (defun erc-fill--wrap-beginning-of-line (arg)
   "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
   (interactive "^p")
-  (let ((inhibit-field-text-motion t))
-    (erc-fill--wrap-move #'move-beginning-of-line
-                         #'beginning-of-visual-line arg))
-  (if (get-text-property (point) 'erc-prompt)
-      (goto-char erc-input-marker)
-    ;; Mimic what `move-beginning-of-line' does with invisible text.
-    (erc-fill--wrap-escape-hidden-speaker)))
+  (let ((opoint (point)))
+    (let ((inhibit-field-text-motion t))
+      (erc-fill--wrap-move #'move-beginning-of-line
+                           #'beginning-of-visual-line arg))
+    (if (get-text-property (point) 'erc-prompt)
+        (goto-char erc-input-marker)
+      (when erc-fill-wrap-merge
+        (erc-fill--wrap-escape-hidden-speaker opoint)))))
 
 (defun erc-fill--wrap-previous-line (&optional arg try-vscroll)
   "Move to ARGth previous logical or screen line."
@@ -347,7 +353,8 @@ Basically mimic what `move-beginning-of-line' does with 
invisible text."
         (erc-fill--wrap-move (if visp #'previous-line #'previous-logical-line)
                              #'previous-line
                              arg try-vscroll))
-    (erc-fill--wrap-escape-hidden-speaker)))
+    (when erc-fill-wrap-merge
+      (erc-fill--wrap-escape-hidden-speaker))))
 
 (defun erc-fill--wrap-next-line (&optional arg try-vscroll)
   "Move to ARGth next logical or screen line."
@@ -356,7 +363,9 @@ Basically mimic what `move-beginning-of-line' does with 
invisible text."
                     erc-fill-wrap-force-screen-line-movement)))
     (erc-fill--wrap-move (if visp #'next-line #'next-logical-line)
                          #'next-line
-                         arg try-vscroll)))
+                         arg try-vscroll)
+    (when erc-fill-wrap-merge
+      (erc-fill--wrap-escape-hidden-speaker))))
 
 (defun erc-fill--wrap-end-of-line (arg)
   "Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -625,11 +634,14 @@ to be disabled."
 (defvar-local erc-fill--wrap-merge-indicator-pre nil)
 
 (defun erc-fill--wrap-insert-merged-pre ()
-  "Add `display' property in lieu of speaker."
+  "Add `display' text property to speaker.
+Also cover region with text prop `erc-fill--wrap-merge' set to t."
   (if erc-fill--wrap-merge-indicator-pre
       (progn
-        (put-text-property (point-min) (point) 'display
-                           (car erc-fill--wrap-merge-indicator-pre))
+        (add-text-properties (point-min) (point)
+                             (list 'display
+                                   (car erc-fill--wrap-merge-indicator-pre)
+                                   'erc-fill--wrap-merge t))
         (cdr erc-fill--wrap-merge-indicator-pre))
     (let* ((option erc-fill-wrap-merge-indicator)
            (s (if (stringp option)
@@ -637,7 +649,8 @@ to be disabled."
                 (concat (propertize (string (car option))
                                     'font-lock-face (cdr option))
                         " "))))
-      (put-text-property (point-min) (point) 'display s)
+      (add-text-properties (point-min) (point)
+                           (list 'display s 'erc-fill--wrap-merge t))
       (cdr (setq erc-fill--wrap-merge-indicator-pre
                  (cons s (erc-fill--wrap-measure (point-min) (point))))))))
 
@@ -672,8 +685,9 @@ See `erc-fill-wrap-mode' for details."
                                   (delete-region (1- (point)) (point))))))
                            ((and erc-fill-wrap-merge
                                  (erc-fill--wrap-continued-message-p))
-                            (put-text-property (point-min) (point)
-                                               'display "")
+                            (add-text-properties
+                             (point-min) (point)
+                             '(display "" erc-fill--wrap-merge ""))
                             (if erc-fill-wrap-merge-indicator
                                 (erc-fill--wrap-insert-merged-pre)
                               0))
@@ -711,9 +725,9 @@ stash and restore `erc-fill--wrap-last-msg' before doing 
so, in
 case this module's insert hooks run by way of the process filter.
 With REPAIRP, destructively fill gaps and re-merge speakers."
   (goto-char start)
-  (cl-assert (null erc-fill--wrap-rejigger-last-message))
   (setq erc-fill--wrap-merge-indicator-pre nil)
-  (let (erc-fill--wrap-rejigger-last-message)
+  (let ((erc-fill--wrap-rejigger-last-message
+         erc-fill--wrap-rejigger-last-message))
     (while-let
         (((< (point) finish))
          (beg (if (get-text-property (point) 'line-prefix)
@@ -724,12 +738,13 @@ With REPAIRP, destructively fill gaps and re-merge 
speakers."
       ;; If this is a left-side stamp on its own line.
       (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil))
       (when-let ((repairp)
-                 (dbeg (text-property-not-all beg end 'display nil))
+                 (dbeg (text-property-not-all beg end
+                                              'erc-fill--wrap-merge nil))
                  ((get-text-property (1+ dbeg) 'erc--speaker))
-                 (dval (get-text-property dbeg 'display))
-                 ((equal "" dval)))
-        (remove-text-properties
-         dbeg (text-property-not-all dbeg end 'display dval) '(display)))
+                 (dval (get-text-property dbeg 'erc-fill--wrap-merge)))
+        (remove-list-of-text-properties
+         dbeg (text-property-not-all dbeg end 'erc-fill--wrap-merge dval)
+         '(display erc-fill--wrap-merge)))
       ;; This "should" work w/o `front-sticky' and `rear-nonsticky'.
       (let* ((pos (if-let (((eq 'erc-timestamp (field-at-pos beg)))
                            (b (field-beginning beg))
@@ -777,9 +792,8 @@ like `erc-match-toggle-hidden-fools'."
                                         callback repair)
         (progress-reporter-done rep)))))
 
-;; FIXME use own text property to avoid false positives.
 (defun erc-fill--wrap-merged-button-p (point)
-  (equal "" (get-text-property point 'display)))
+  (get-text-property point 'erc-fill--wrap-merge))
 
 (defun erc-fill--wrap-nudge (arg)
   (when (zerop arg)
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 6ff7af218c0..166ed59e292 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index 7d9822c80bc..8b502373807 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index 2d0e5a5965f..9744e659813 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
diff --git 
a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
index 615de982b1e..36729b890be 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr  1 
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld 
b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index ae364accdea..5405ca2a7dc 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This 
buffer is for text.\n*** one two t [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan  1 1970]\n*** This server is in debug mode and is logging 
all user I/O. If you do not wish for everything you send to be readable by the 
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a 
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause 
to complain of? Come me to what was done to her.\n<bob> alice: Either your 
unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This 
buffer is for text.\n*** one two t [...]
\ No newline at end of file