master 1c3f6aa98f5 07/11: Measure stamps pixel-wise with erc-fill-wrap

[F. Jason Park]

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

    Measure stamps pixel-wise with erc-fill-wrap
    
    * lisp/erc/erc-fill.el (erc-fill-wrap-mode, erc-fill-wrap-enable):
    Change "how" for advice applied to `erc-stamp--insert-date-function'
    from `:filter-args' to `:after'.
    (erc-fill--wrap-stamp-insert-prefixed-date): Change signature to
    conform to `:after'-style advice.  Use `buffer-text-pixel-size' when
    desired and available for generating display spec.
    (erc-fill-wrap): Remove confusing comment.  Don't apply text props to
    newlines because there's no obvious use case for inheriting these.
    * lisp/erc/erc.el (erc-send-action, erc-display-msg): Add
    `erc-command' property (as "PRIVMSG") to inserted message, sans
    newline, so that all inserted messages in an ERC buffer contain this
    property.
    * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: Update data.
    * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: Update data.
    * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: Update.
    * test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld: Update.
    (Bug#60936)
---
 lisp/erc/erc-fill.el                               | 29 ++++++++++++++--------
 lisp/erc/erc.el                                    | 10 +++++---
 test/lisp/erc/erc-fill-tests.el                    |  6 +++--
 .../resources/fill/snapshots/merge-01-start.eld    |  2 +-
 .../resources/fill/snapshots/merge-02-right.eld    |  2 +-
 .../fill/snapshots/monospace-01-start.eld          |  2 +-
 .../fill/snapshots/monospace-02-right.eld          |  2 +-
 .../resources/fill/snapshots/monospace-03-left.eld |  2 +-
 .../fill/snapshots/monospace-04-reset.eld          |  2 +-
 .../resources/fill/snapshots/spacing-01-mono.eld   |  2 +-
 10 files changed, 37 insertions(+), 22 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 718e51a058c..306d74a0741 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -336,7 +336,7 @@ one of the minor-mode toggles if really necessary."
      erc-fill--wrap-value erc-fill-static-center)
    (setq erc-fill--function #'erc-fill-wrap)
    ;; Internal integrations.
-   (add-function :filter-args (local 'erc-stamp--insert-date-function)
+   (add-function :after (local 'erc-stamp--insert-date-function)
                  #'erc-fill--wrap-stamp-insert-prefixed-date)
    (when (or erc-stamp-mode (memq 'stamp erc-modules))
      (erc-stamp--display-margin-mode +1))
@@ -398,14 +398,24 @@ parties.")
               ((erc-nick-equal-p (car props) nick))))
     (set-marker erc-fill--wrap-last-msg (point-min))))
 
-(defun erc-fill--wrap-stamp-insert-prefixed-date (args)
+(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
   "Apply `line-prefix' property to args."
-  (let* ((ts-left (car args)))
-    (put-text-property 0 (length ts-left) 'line-prefix
-                       `(space :width
-                               (- erc-fill--wrap-value
-                                  ,(length (string-trim-left ts-left))))
-                       ts-left))
+  (let* ((ts-left (car args))
+         (start)
+         ;; Insert " " to simulate gap between <speaker> and msg beg.
+         (end (save-excursion (skip-chars-backward "\n")
+                              (setq start (pos-bol))
+                              (insert " ")
+                              (point)))
+         (width (if (and erc-fill-wrap-use-pixels
+                         (fboundp 'buffer-text-pixel-size))
+                    (save-restriction (narrow-to-region start end)
+                                      (list (car (buffer-text-pixel-size))))
+                  (length (string-trim-left ts-left)))))
+    (delete-region (1- end) end)
+    ;; Use `point-min' instead of `start' to cover leading newilnes.
+    (put-text-property (point-min) (point) 'line-prefix
+                       `(space :width (- erc-fill--wrap-value ,width))))
   args)
 
 (defun erc-fill-wrap ()
@@ -434,8 +444,7 @@ See `erc-fill-wrap-mode' for details."
                               (narrow-to-region (point-min) (point))
                               (list (car (buffer-text-pixel-size)))))
                            (t (- (point) (point-min))))))))
-      ;; Leaving out the final newline doesn't seem to affect anything.
-      (erc-put-text-properties (point-min) (point-max)
+      (erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
                                '(line-prefix wrap-prefix) nil
                                `((space :width (- erc-fill--wrap-value ,len))
                                  (space :width erc-fill--wrap-value))))))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index d68d27e76d0..c0fa48bd9bd 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2782,9 +2782,12 @@ If ARG is non-nil, show the *erc-protocol* buffer."
 (defun erc-send-action (tgt str &optional force)
   "Send CTCP ACTION information described by STR to TGT."
   (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
-  (erc-display-message
-   nil 'input (current-buffer)
-   'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))
+  (let ((erc-insert-pre-hook
+         (cons (lambda (s) ; Leave newline be.
+                 (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s))
+               erc-insert-pre-hook)))
+    (erc-display-message nil 'input (current-buffer)
+                         'ACTION ?n (erc-current-nick) ?a str ?u "" ?h "")))
 
 ;; Display interface
 
@@ -6494,6 +6497,7 @@ Return non-nil only if we actually send anything."
         (setq beg (point))
         (insert-before-markers line)
         (erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
+        (erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG)
         (insert-before-markers "\n")
         (save-restriction
           (narrow-to-region insert-position (point))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index fc33d0b9103..15a8087f848 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -109,10 +109,12 @@
     (dolist (prefix prefixes)
       (should (search-forward prefix nil t))
       (should (get-text-property (pos-bol) 'line-prefix))
-      (should (get-text-property (pos-eol) 'line-prefix))
+      (should (get-text-property (1- (pos-eol)) 'line-prefix))
+      (should-not (get-text-property (pos-eol) 'line-prefix))
       (should (equal (get-text-property (pos-bol) 'wrap-prefix)
                      '(space :width erc-fill--wrap-value)))
-      (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+      (should-not (get-text-property (pos-eol) 'wrap-prefix))
+      (should (equal (get-text-property (1- (pos-eol)) 'wrap-prefix)
                      '(space :width erc-fill--wrap-value))))))
 
 ;; Set this variable to t to generate new snapshots after carefully
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 88defb6c09e..689bacc7012 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<alic [...]
\ 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<alic [...]
\ 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 c5a9cbfc05d..9fa23a7d332 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<alic [...]
\ 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<alic [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 67ebad542fb..80c9e1d80f5 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-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" 2 21 
(erc-timestamp 0 line-prefix (space :wi [...]
\ 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" 2 20 
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index 0bf8001475d..e675695f660 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-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" 2 21 
(erc-timestamp 0 line-prefix (space :wi [...]
\ 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" 2 20 
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index 7d231d19cef..a6070c2e3ff 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.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" 2 21 
(erc-timestamp 0 line-prefix (space :wi [...]
\ 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" 2 20 
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 67ebad542fb..80c9e1d80f5 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.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" 2 21 
(erc-timestamp 0 line-prefix (space :wi [...]
\ 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" 2 20 
(erc-timestamp 0 line-prefix (space :wi [...]
\ 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 45c3883b023..2b8766c27f4 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 th [...]
\ 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 th [...]
\ No newline at end of file