master 52af0a5fb97 11/12: Add command to refill buffer in erc-fill-wrap-mode

[F. Jason Park]

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

    Add command to refill buffer in erc-fill-wrap-mode
    
    * lisp/erc/erc-fill.el (erc-fill-function, erc-fill-wrap-mode):
    Mention new command `erc-fill-wrap-refill-buffer' in doc string.
    (erc-fill--wrap-rejigger-last-message): New internal variable.
    (erc-fill--wrap-rejigger-region, erc-fill-wrap-refill-buffer): New
    command and helper function for fixing alignment issues that arise,
    for example, from adjusting pixel-display widths of buffer text during
    a session.
    * test/lisp/erc/erc-fill-tests.el (erc-fill-tests--simulate-refill):
    New function for approximating `erc-fill-wrap-refill-buffer'.
    (erc-fill-wrap--merge): Assert refilling is idempotent.  (Bug#60936)
---
 lisp/erc/erc-fill.el            | 98 ++++++++++++++++++++++++++++++++++++-----
 test/lisp/erc/erc-fill-tests.el | 18 +++++++-
 2 files changed, 104 insertions(+), 12 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 3f5c8377868..58aab176b66 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -86,10 +86,12 @@ function is called.
 
 A third style resembles static filling but \"wraps\" instead of
 fills, thanks to `visual-line-mode' mode, which ERC automatically
-enables when this option is `erc-fill-wrap' or when
-`erc-fill-wrap-mode' is active.  Set `erc-fill-static-center' to
-your preferred initial \"prefix\" width.  For adjusting the width
-during a session, see the command `erc-fill-wrap-nudge'."
+enables when this option is `erc-fill-wrap' or when the module
+`fill-wrap' is active.  Use `erc-fill-static-center' to specify
+an initial \"prefix\" width and `erc-fill-wrap-margin-width'
+instead of `erc-fill-column' for influencing initial message
+width.  For adjusting these during a session, see the commands
+`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'."
   :type '(choice (const :tag "Variable Filling" erc-fill-variable)
                  (const :tag "Static Filling" erc-fill-static)
                  (const :tag "Dynamic word-wrap" erc-fill-wrap)
@@ -403,15 +405,19 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
 (define-erc-module fill-wrap nil
   "Fill style leveraging `visual-line-mode'.
 This module displays nicks overhanging leftward to a common
-offset, as determined by the option `erc-fill-static-center'.  To
-use it, either include `fill-wrap' in `erc-modules' or set
-`erc-fill-function' to `erc-fill-wrap'.  Most users will want to
-enable the `scrolltobottom' module as well.  Once active, use
+offset, as determined by the option `erc-fill-static-center'.
+And it \"wraps\" messages at a common margin width, as determined
+by the option `erc-fill-wrap-margin-width'.  To use it, either
+include `fill-wrap' in `erc-modules' or set `erc-fill-function'
+to `erc-fill-wrap'.  Most users will want to enable the
+`scrolltobottom' module as well.  Once active, use
 \\[erc-fill-wrap-nudge] to adjust the width of the indent and the
 stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for
 cycling between logical- and screen-line oriented command
-movement.  Also see related options `erc-fill-line-spacing' and
-`erc-fill-wrap-merge'.
+movement.  Similarly, use \\[erc-fill-wrap-refill-buffer] to fix
+alignment problems after running certain commands, like
+`text-scale-adjust'.  Also see related stylistic options
+`erc-fill-line-spacing' and `erc-fill-wrap-merge'.
 
 This module imposes various restrictions on the appearance of
 timestamps.  Most notably, it insists on displaying them in the
@@ -565,6 +571,78 @@ See `erc-fill-wrap-mode' for details."
                                        'erc-fill--wrap-value))
           wrap-prefix (space :width erc-fill--wrap-value))))))
 
+(defvar erc-fill--wrap-rejigger-last-message nil
+  "Temporary working instance of `erc-fill--wrap-last-msg'.")
+
+(defun erc-fill--wrap-rejigger-region (start finish on-next repairp)
+  "Recalculate `line-prefix' from START to FINISH.
+After refilling each message, call ON-NEXT with no args.  But
+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))
+  (let (erc-fill--wrap-rejigger-last-message)
+    (while-let
+        (((< (point) finish))
+         (beg (if (get-text-property (point) 'line-prefix)
+                  (point)
+                (next-single-property-change (point) 'line-prefix)))
+         (val (get-text-property beg 'line-prefix))
+         (end (text-property-not-all beg finish 'line-prefix val)))
+      ;; 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))
+                 ((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)))
+      (let* ((pos (if (eq 'date-left (get-text-property beg 'erc-stamp-type))
+                      (field-beginning beg)
+                    beg))
+             (erc--msg-props (map-into (text-properties-at pos) 'hash-table))
+             (erc-stamp--current-time (gethash 'erc-ts erc--msg-props)))
+        (save-restriction
+          (narrow-to-region beg (1+ end))
+          (let ((erc-fill--wrap-last-msg erc-fill--wrap-rejigger-last-message))
+            (erc-fill-wrap)
+            (setq erc-fill--wrap-rejigger-last-message
+                  erc-fill--wrap-last-msg))))
+      (when on-next
+        (funcall on-next))
+      ;; Skip to end of message upon encountering accidental gaps
+      ;; introduced by third parties (or bugs).
+      (if-let (((/= ?\n (char-after end)))
+               (next (erc--get-inserted-msg-bounds 'end beg)))
+          (progn
+            (cl-assert (= ?\n (char-after next)))
+            (when repairp ; eol <= next
+              (put-text-property end (pos-eol) 'line-prefix val))
+            (goto-char next))
+        (goto-char end)))))
+
+(defun erc-fill-wrap-refill-buffer (repair)
+  "Recalculate all `fill-wrap' prefixes in the current buffer.
+With REPAIR, attempt to refresh \"speaker merges\", which may be
+necessary after revealing previously hidden text with commands
+like `erc-match-toggle-hidden-fools'."
+  (interactive "P")
+  (unless erc-fill-wrap-mode
+    (user-error "Module `fill-wrap' not active in current buffer."))
+  (save-excursion
+    (with-silent-modifications
+      (let* ((rep (make-progress-reporter
+                   "Rewrap" 0 (line-number-at-pos erc-insert-marker) 1))
+             (seen 0)
+             (callback (lambda ()
+                         (progress-reporter-update rep (cl-incf seen))
+                         (accept-process-output nil 0.000001))))
+        (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker
+                                        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)))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index 8f0c8f9ccf4..f6c4c268017 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -234,6 +234,13 @@
        (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
        (erc-fill-tests--compare "monospace-04-reset")))))
 
+(defun erc-fill-tests--simulate-refill ()
+  ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without
+  ;; a progress reporter.
+  (save-excursion
+    (with-silent-modifications
+      (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil))))
+
 (ert-deftest erc-fill-wrap--merge ()
   :tags '(:unstable)
   (unless (>= emacs-major-version 29)
@@ -245,7 +252,9 @@
      (erc-update-channel-member
       "#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t)
 
-     ;; Set this here so that the first few messages are from 1970
+     ;; Set this here so that the first few messages are from 1970.
+     ;; Following the current date stamp, the speaker isn't merged
+     ;; even though it's continued: "<bob> zero."
      (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
        (erc-fill-tests--insert-privmsg "bob" "zero.")
        (erc-fill-tests--insert-privmsg "alice" "one.")
@@ -267,7 +276,12 @@
        (erc-fill-tests--wrap-check-prefixes
         "*** " "<alice> " "<bob> "
         "<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
-       (erc-fill-tests--compare "merge-02-right")))))
+       (erc-fill-tests--compare "merge-02-right")
+
+       (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent")
+         (kill-buffer (pop erc-fill-tests--buffers))
+         (erc-fill-tests--simulate-refill) ; idempotent
+         (erc-fill-tests--compare "merge-02-right"))))))
 
 (ert-deftest erc-fill-wrap--merge-action ()
   :tags '(:unstable)