bug#60936: 30.0.50; ERC >5.5: Add erc-fill style based on visual-line-mode

["J.P." <jp@neverwas.me>]

[-- Attachment #1: Type: text/plain, Size: 222 bytes --]

v3. Accommodate variable-pitch faces on graphical displays. Use
`defvar-keymap', now available in the latest Compat.

Screenshot:
https://debbugs.gnu.org/cgi/bugreport.cgi?msg=11;filename=fill-wrap-vp.png;bug=60936;att=1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0000-v2-v3.diff --]
[-- Type: text/x-patch, Size: 11902 bytes --]

From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 25 Jan 2023 05:51:53 -0800
Subject: [PATCH 0/4] *** NOT A PATCH ***

*** BLURB HERE ***

F. Jason Park (4):
  [5.6] Adjust some old text properties in ERC buffers
  [5.6] Leverage display properties better in erc-stamp
  [5.6] Convert erc-fill minor mode into a proper module
  [5.6] Add erc-fill style based on visual-line-mode

 lisp/erc/erc-common.el           |   1 +
 lisp/erc/erc-fill.el             | 281 ++++++++++++++++++++++++++++---
 lisp/erc/erc-stamp.el            |  66 +++++++-
 lisp/erc/erc.el                  |   3 +-
 test/lisp/erc/erc-fill-tests.el  | 162 ++++++++++++++++++
 test/lisp/erc/erc-stamp-tests.el | 178 ++++++++++++++++++++
 6 files changed, 656 insertions(+), 35 deletions(-)
 create mode 100644 test/lisp/erc/erc-fill-tests.el
 create mode 100644 test/lisp/erc/erc-stamp-tests.el

Interdiff:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 6a461786be1..a05f2a558f8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
 ;; `erc-fill-mode' to switch it on.  Customize `erc-fill-function' to
 ;; change the style.
 
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
 ;;; Code:
 
 (require 'erc)
@@ -228,20 +231,15 @@ erc-fill-wrap-cycle-visual-movement
                                     ('display nil))))
   (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement))
 
-;; We could just override `visual-line-mode-map' locally, but that
-;; seems pretty hacky.
-(defvar erc-fill-wrap-mode-map
-  (let ((map (make-sparse-keymap)))
-    (set-keymap-parent map visual-line-mode-map)
-    (define-key map [remap kill-line] #'erc-fill--wrap-kill-line)
-    (define-key map [remap move-end-of-line] #'erc-fill--wrap-end-of-line)
-    (define-key map [remap move-beginning-of-line]
-                #'erc-fill--wrap-beginning-of-line)
-    ;; This is redundant anyway (right?).
-    (define-key map "\C-c\C-a" #'erc-fill-wrap-cycle-visual-movement)
-    ;; Not sure if this is dumb because `erc-bol' takes no args.
-    (define-key map [remap erc-bol] #'erc-fill--wrap-beginning-of-line)
-    map))
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+  :doc "Keymap for ERC's `fill-wrap' module."
+  :parent visual-line-mode-map
+  "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+  "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+  "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+  "C-c c" #'erc-fill-wrap-cycle-visual-movement
+  ;; Not sure if this is problematic because `erc-bol' takes no args.
+  "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
 
 (define-erc-module fill-wrap nil
   "Fill style leveraging `visual-line-mode'.
@@ -295,6 +293,10 @@ erc-fill--wrap-length-function
 nickname, including any enclosing brackets, or nil, to fall back
 to the default behavior of taking the length from the first word.")
 
+(defvar erc-fill--wrap-use-pixels t)
+(declare-function buffer-text-pixel-size "xdisp"
+                  (&optional buffer-or-name window x-limit y-limit))
+
 (defun erc-fill-wrap ()
   "Use text props to mimic the effect of `erc-fill-static'.
 See `erc-fill-wrap-mode' for details."
@@ -302,13 +304,20 @@ erc-fill-wrap
     (erc-fill-wrap-mode +1))
   (save-excursion
     (goto-char (point-min))
-    (let ((len (or (and erc-fill--wrap-length-function
-                        (funcall erc-fill--wrap-length-function))
-                   (progn (skip-syntax-forward "^-")
-                          (- (point) (point-min))))))
+    (let* ((len (or (and erc-fill--wrap-length-function
+                         (funcall erc-fill--wrap-length-function))
+                    (progn
+                      (skip-syntax-forward "^-")
+                      (forward-char)
+                      (if (and erc-fill--wrap-use-pixels
+                               (fboundp 'buffer-text-pixel-size))
+                          (save-restriction
+                            (narrow-to-region (point-min) (point))
+                            (list (car (buffer-text-pixel-size))))
+                        (- (point) (point-min)))))))
       (erc-put-text-properties (point-min) (point-max)
                                '(line-prefix wrap-prefix) nil
-                               `((space :width ,(- erc-fill--wrap-value 1 len))
+                               `((space :width (- ,erc-fill--wrap-value ,len))
                                  ,erc-fill--wrap-prefix)))))
 
 ;; This is an experimental helper for third-party modules.  You could,
@@ -344,7 +353,7 @@ erc-fill--wrap-nudge
         (cl-incf erc-fill--wrap-value arg)
         (while (setq p (next-single-property-change p 'line-prefix))
           (when-let ((v (get-text-property p 'line-prefix)))
-            (cl-incf (caddr v) arg)
+            (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
             (when-let
                 ((e (text-property-not-all p (point-max) 'line-prefix v)))
               (goto-char e)))))))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..cf243ef43c7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,162 @@
+;;; erc-fill-tests.el --- Tests for erc-fill  -*- 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)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+  (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+        (id (erc-networks--id-create 'foonet))
+        (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+        (erc-server-users (make-hash-table :test 'equal))
+        (erc-fill-function 'erc-fill-wrap)
+        (erc-modules '(fill stamp))
+        (msg "Hello World")
+        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+    (when (bound-and-true-p erc-button-mode)
+      (push 'erc-button-add-buttons erc-insert-modify-hook))
+    (erc-mode)
+    (setq erc-server-process proc erc-networks--id id)
+
+    (with-current-buffer (get-buffer-create "#chan")
+      (erc-mode)
+      (erc-munge-invisibility-spec)
+      (setq erc-server-process proc
+            erc-networks--id id
+            erc-channel-users (make-hash-table :test 'equal)
+            erc--target (erc--target-from-string "#chan")
+            erc-default-recipients (list "#chan"))
+      (erc--initialize-markers (point) nil)
+
+      (erc-update-channel-member
+       "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+      (erc-update-channel-member
+       "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+      (setq msg "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.")
+
+      (erc-display-message nil 'notice (current-buffer) msg)
+      (setq msg "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.")
+
+      (erc-display-message
+       nil nil (current-buffer)
+       (erc--format-privmsg "alice" msg nil t nil))
+      (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+
+      (erc-display-message
+       nil nil (current-buffer)
+       (erc--format-privmsg "bob" msg nil t nil))
+
+      (funcall test)
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+  :tags '(:unstable)
+
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+
+     ;; Prefix props are applied properly and faces are accounted
+     ;; for when determining widths.
+     (goto-char (point-min))
+     (should (search-forward "<a" nil t))
+     (should (get-text-property (pos-bol) 'line-prefix))
+     (should (get-text-property (pos-eol) 'line-prefix))
+     (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                    '(space :width 27)))
+     (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                    '(space :width 27)))
+     (should (pcase (get-text-property (point) 'line-prefix)
+               (`(space :width (- 27 (,w)))
+                (should (= w (string-pixel-width "<alice> "))))))
+
+     (erc-fill--wrap-nudge 2)
+
+     (should (search-forward "<b" nil t))
+     (should (get-text-property (pos-bol) 'line-prefix))
+     (should (get-text-property (pos-eol) 'line-prefix))
+     (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                    '(space :width 29)))
+     (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                    '(space :width 29)))
+     (should (pcase (get-text-property (point) 'line-prefix)
+               (`(space :width (- 29 (,w)))
+                (should (= w (string-pixel-width "<bob> ")))))))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+  :tags '(:unstable)
+  (unless (and (not noninteractive) (display-graphic-p))
+    (ert-skip "Test needs interactive graphical Emacs"))
+
+  (with-selected-frame (make-frame '((name . "other")))
+    (set-face-attribute 'default (selected-frame)
+                        :family "Sans Serif"
+                        :foundry 'unspecified
+                        :font 'unspecified)
+
+    (erc-fill-tests--wrap-populate
+
+     (lambda ()
+
+       ;; Prefix props are applied properly and faces are accounted
+       ;; for when determining widths.
+       (goto-char (point-min))
+       (should (search-forward "<a" nil t))
+       (should (get-text-property (pos-bol) 'line-prefix))
+       (should (get-text-property (pos-eol) 'line-prefix))
+       (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                      '(space :width 27)))
+       (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                      '(space :width 27)))
+       (should (pcase (get-text-property (point) 'line-prefix)
+                 (`(space :width (- 27 (,w)))
+                  (should (> w (string-pixel-width "<alice> "))))))
+
+       (erc-fill--wrap-nudge 2)
+
+       (should (search-forward "<b" nil t))
+       (should (get-text-property (pos-bol) 'line-prefix))
+       (should (get-text-property (pos-eol) 'line-prefix))
+       (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                      '(space :width 29)))
+       (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                      '(space :width 29)))
+       (should (pcase (get-text-property (point) 'line-prefix)
+                 (`(space :width (- 29 (,w)))
+                  (should (> w (string-pixel-width "<bob> "))))))
+
+       ;; FIXME figure out how to get rid of this "void variable
+       ;; `erc--results-ewoc'" error, which seems related to operating
+       ;; in this second frame.
+       ;;
+       ;; As a kludge, checking if point made it to the prompt can
+       ;; serve as visual confirmation that the test passed.
+       (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-5.6-Adjust-some-old-text-properties-in-ERC-buffers.patch --]
[-- Type: text/x-patch, Size: 1697 bytes --]

From 80dccfa483020177c3e705f3c59c4875a635a568 Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Thu, 16 Jun 2022 01:20:49 -0700
Subject: [PATCH 1/4] [5.6] Adjust some old text properties in ERC buffers

TODO: because these have been around forever, we should mention
their deletion in the misc-library section of ERC-NEWS for 5.6.

* lisp/erc/erc.el (erc-display-message): Remove the confusing
`rear-sticky' text property, which has been around since 2002.
(erc-display-prompt): Make the `field' text property more meaningful
to aid in searching, although this makes the `erc-prompt' property
somewhat redundant.
---
 lisp/erc/erc.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ff1820cfaf2..4bc9fc20f8a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2867,7 +2867,6 @@ erc-display-message
         (erc-display-line string buffer)
       (unless (erc-hide-current-message-p parsed)
         (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
-        (erc-put-text-property 0 (length string) 'rear-sticky t string)
 	(when (erc-response.tags parsed)
 	  (erc-put-text-property 0 (length string) 'tags (erc-response.tags parsed)
 				 string))
@@ -4296,7 +4295,7 @@ erc-display-prompt
         (setq prompt (propertize prompt
                                  'rear-nonsticky t
                                  'erc-prompt t
-                                 'field t
+                                 'field 'erc-prompt
                                  'front-sticky t
                                  'read-only t))
         (erc-put-text-property 0 (1- (length prompt))
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0002-5.6-Leverage-display-properties-better-in-erc-stamp.patch --]
[-- Type: text/x-patch, Size: 13826 bytes --]

From 5e9422dc39c61af03dd3ca24d419927f2f07c8bd Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Wed, 24 Nov 2021 05:35:35 -0800
Subject: [PATCH 2/4] [5.6] Leverage display properties better in erc-stamp

(erc-timestamp-use-align-to): Enhance meaning of option to accept
numeric value for dynamically aligned right-side stamps.  Use
`graphic-display-p' to determine default value even though, as stated
in the manual, terminal Emacs also supports the "space" display spec.
(erc-timestamp--display-margin-mode): Add internal minor mode to help
other modules quickly ensure stamps are showing correctly.
(erc-stamp--inherited-props): Add internal const to hold properties
that should be inherited from message being inserted.
(erc-insert-aligned): Deprecate function and remove from primary
client code path.
(erc-insert-timestamp-right): Account for new display-related values
of `erc-timestamp-use-align-to'.

* test/lisp/erc/erc-stamp-tests.el: New file.
---
 lisp/erc/erc-stamp.el            |  66 ++++++++++--
 test/lisp/erc/erc-stamp-tests.el | 178 +++++++++++++++++++++++++++++++
 2 files changed, 236 insertions(+), 8 deletions(-)
 create mode 100644 test/lisp/erc/erc-stamp-tests.el

diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 0aa1590f801..e9592448a33 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -217,14 +217,44 @@ erc-timestamp-right-column
 	  (integer :tag "Column number")
 	  (const :tag "Unspecified" nil)))
 
-(defcustom erc-timestamp-use-align-to (eq window-system 'x)
+(defcustom erc-timestamp-use-align-to (and (display-graphic-p) t)
   "If non-nil, use the :align-to display property to align the stamp.
 This gives better results when variable-width characters (like
 Asian language characters and math symbols) precede a timestamp.
 
+This option only matters when `erc-insert-timestamp-function' is
+set to `erc-insert-timestamp-right' or that option's default,
+`erc-insert-timestamp-left-and-right'.  If the value is a
+positive integer, alignment occurs that many columns from the
+right edge.  If the value is `margin', the stamp appears in the
+right margin when visible.
+
 A side effect of enabling this is that there will only be one
 space before a right timestamp in any saved logs."
-  :type 'boolean)
+  :type '(choice boolean integer (const margin))
+  :package-version '(ERC . "5.4.1")) ; FIXME update when merging
+
+;; If people want to use this directly, we can offer an option to set
+;; the margin's width.
+(define-minor-mode erc-timestamp--display-margin-mode
+  "Internal minor mode for built-in modules integrating with `stamp'."
+  :interactive nil
+  (if-let ((erc-timestamp--display-margin-mode)
+           (width (if erc-timestamp-last-inserted-right
+                      (length erc-timestamp-last-inserted-right)
+                    (1+ (length (erc-format-timestamp
+                                 (current-time)
+                                 erc-timestamp-format-right))))))
+      (progn
+        (setq right-margin-width width
+              right-fringe-width 0)
+        (unless noninteractive
+          (set-window-margins nil left-margin-width width)
+          (set-window-fringes nil left-fringe-width 0)))
+    (kill-local-variable 'right-margin-width)
+    (unless noninteractive
+      (set-window-margins nil nil)
+      (set-window-fringes nil nil))))
 
 (defun erc-insert-timestamp-left (string)
   "Insert timestamps at the beginning of the line."
@@ -243,6 +273,7 @@ erc-insert-aligned
 
 If `erc-timestamp-use-align-to' is t, use the :align-to display
 property to get to the POSth column."
+  (declare (obsolete "inlined and removed from client code path" "30.1"))
   (if (not erc-timestamp-use-align-to)
       (indent-to pos)
     (insert " ")
@@ -253,6 +284,8 @@ erc-insert-aligned
 ;; Silence byte-compiler
 (defvar erc-fill-column)
 
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+
 (defun erc-insert-timestamp-right (string)
   "Insert timestamp on the right side of the screen.
 STRING is the timestamp to insert.  This function is a possible
@@ -304,12 +337,29 @@ erc-insert-timestamp-right
       ;; some margin of error if what is displayed on the line differs
       ;; from the number of characters on the line.
       (setq col (+ col (ceiling (/ (- col (- (point) (line-beginning-position))) 1.6))))
-      (if (< col pos)
-	  (erc-insert-aligned string pos)
-	(newline)
-	(indent-to pos)
-	(setq from (point))
-	(insert string))
+      ;; For compatibility reasons, the `erc-timestamp' field includes
+      ;; intervening white space unless a hard break is warranted.
+      (pcase erc-timestamp-use-align-to
+        ((and 't (guard (< col pos)))
+         (insert " ")
+         (put-text-property from (point) 'display `(space :align-to ,pos)))
+        ((pred integerp) ; (cl-type (integer 0 *))
+         (insert " ")
+         (when (eq ?\s (aref string 0))
+           (setq string (substring string 1)))
+         (let ((s (+ erc-timestamp-use-align-to (string-width string))))
+           (put-text-property from (point) 'display
+                              `(space :align-to (- right ,s)))))
+        ('margin
+         (put-text-property 0 (length string)
+                            'display `((margin right-margin) ,string)
+                            string))
+        ((guard (>= col pos)) (newline) (indent-to pos) (setq from (point)))
+        (_ (indent-to pos)))
+      (insert string)
+      (dolist (p erc-stamp--inherited-props)
+        (when-let ((v (get-text-property (1- from) p)))
+          (put-text-property from (point) p v)))
       (erc-put-text-property from (point) 'field 'erc-timestamp)
       (erc-put-text-property from (point) 'rear-nonsticky t)
       (when erc-timestamp-intangible
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
new file mode 100644
index 00000000000..4994feefd4e
--- /dev/null
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -0,0 +1,178 @@
+;;; erc-stamp-tests.el --- Tests for erc-stamp.  -*- 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)
+(require 'erc-stamp)
+(require 'erc-goodies) ; for `erc-make-read-only'
+
+;; These display-oriented tests are brittle because many factors
+;; influence how text properties are applied.  We should just
+;; rework these into full scenarios.
+
+(defun erc-stamp-tests--insert-right (test)
+  (let ((val (list 0 0))
+        (erc-insert-modify-hook '(erc-add-timestamp))
+        (erc-insert-post-hook '(erc-make-read-only)) ; see comment above
+        (erc-timestamp-only-if-changed-flag nil)
+        ;;
+        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+
+    (advice-add 'erc-format-timestamp :filter-args
+                (lambda (args) (cons (cl-incf (cadr val) 60) (cdr args)))
+                '((name . ert-deftest--erc-timestamp-use-align-to)))
+
+    (with-current-buffer (get-buffer-create "*erc-stamp-tests--insert-right*")
+      (erc-mode)
+      (erc-munge-invisibility-spec)
+      (setq erc-server-process (start-process "p" (current-buffer)
+                                              "sleep" "1")
+            erc-input-marker (make-marker)
+            erc-insert-marker (make-marker))
+      (set-process-query-on-exit-flag erc-server-process nil)
+      (set-marker erc-insert-marker (point-max))
+      (erc-display-prompt)
+
+      (funcall test)
+
+      (when noninteractive
+        (kill-buffer)))
+
+    (advice-remove 'erc-format-timestamp
+                   'ert-deftest--erc-timestamp-use-align-to)))
+
+(ert-deftest erc-timestamp-use-align-to--nil ()
+  (erc-stamp-tests--insert-right
+   (lambda ()
+
+     (ert-info ("nil, normal")
+       (let ((erc-timestamp-use-align-to nil))
+         (erc-display-message nil 'notice (current-buffer) "begin"))
+       (goto-char (point-min))
+       (should (search-forward-regexp
+                (rx "begin" (+ "\t") (* " ") " [") nil t))
+       ;; Field includes intervening spaces
+       (should (eql ?n (char-before (field-beginning (point)))))
+       ;; Timestamp extends to the end of the line
+       (should (eql ?\n (char-after (field-end (point))))))
+
+     ;; The option `erc-timestamp-right-column' is normally nil by
+     ;; default, but it's a convenient stand in for a sufficiently
+     ;; small `erc-fill-column' (we can force a line break without
+     ;; involving that module).
+     (should-not erc-timestamp-right-column)
+
+     (ert-info ("nil, overlong (hard wrap)")
+       (let ((erc-timestamp-use-align-to nil)
+             (erc-timestamp-right-column 20))
+         (erc-display-message nil 'notice (current-buffer)
+                              "twenty characters"))
+       (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+       ;; Field excludes leading whitespace (arguably undesirable).
+       (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+       ;; Timestamp extends to the end of the line.
+       (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--t ()
+  (erc-stamp-tests--insert-right
+   (lambda ()
+
+     (ert-info ("t, normal")
+       (let ((erc-timestamp-use-align-to t))
+         (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+           (erc-display-message nil nil (current-buffer) msg)))
+       (goto-char (point-min))
+       ;; Exactly two spaces, one from format, one added by erc-stamp.
+       (should (search-forward "msg one  [" nil t))
+       ;; Field covers space between.
+       (should (eql ?e (char-before (field-beginning (point)))))
+       (should (eql ?\n (char-after (field-end (point))))))
+
+     (ert-info ("t, overlong (hard wrap)")
+       (let ((erc-timestamp-use-align-to t)
+             (erc-timestamp-right-column 20))
+         (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+           (erc-display-message nil nil (current-buffer) msg)))
+       ;; Indented to pos (this is arguably a bug).
+       (should (search-forward-regexp (rx bol (+ "\t") (* " ") " [") nil t))
+       ;; Field starts *after* leading space (arguably bad).
+       (should (eql ?\[ (char-after (1+ (field-beginning (point))))))
+       (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--integer ()
+  (erc-stamp-tests--insert-right
+   (lambda ()
+
+     (ert-info ("integer, normal")
+       (let ((erc-timestamp-use-align-to 1))
+         (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+           (erc-display-message nil nil (current-buffer) msg)))
+       (goto-char (point-min))
+       ;; Space not added because included in format string.
+       (should (search-forward "msg one [" nil t))
+       ;; Field covers space between.
+       (should (eql ?e (char-before (field-beginning (point)))))
+       (should (eql ?\n (char-after (field-end (point))))))
+
+     (ert-info ("integer, overlong (hard wrap)")
+       (let ((erc-timestamp-use-align-to 1)
+             (erc-timestamp-right-column 20))
+         (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+           (erc-display-message nil nil (current-buffer) msg)))
+       ;; No hard wrap
+       (should (search-forward "oooo [" nil t))
+       ;; Field starts at leading space.
+       (should (eql ?\s (char-after (field-beginning (point)))))
+       (should (eql ?\n (char-after (field-end (point)))))))))
+
+(ert-deftest erc-timestamp-use-align-to--margin ()
+  (erc-stamp-tests--insert-right
+   (lambda ()
+     (erc-timestamp--display-margin-mode +1)
+
+     (ert-info ("margin, normal")
+       (let ((erc-timestamp-use-align-to 'margin))
+         (let ((msg (erc-format-privmessage "bob" "msg one" nil t)))
+           (put-text-property 0 (length msg) 'wrap-prefix 10 msg)
+           (erc-display-message nil nil (current-buffer) msg)))
+       (goto-char (point-min))
+       ;; Space not added (treated as opaque string).
+       (should (search-forward "msg one [" nil t))
+       ;; Field covers stamp alone
+       (should (eql ?e (char-before (field-beginning (point)))))
+       ;; Vanity props extended
+       (should (get-text-property (field-beginning (point)) 'wrap-prefix))
+       (should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
+       (should (get-text-property (1- (field-end (point))) 'wrap-prefix))
+       (should (eql ?\n (char-after (field-end (point))))))
+
+     (ert-info ("margin, overlong (hard wrap)")
+       (let ((erc-timestamp-use-align-to 'margin)
+             (erc-timestamp-right-column 20))
+         (let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
+           (erc-display-message nil nil (current-buffer) msg)))
+       ;; No hard wrap
+       (should (search-forward "oooo [" nil t))
+       ;; Field starts at leading space.
+       (should (eql ?\s (char-after (field-beginning (point)))))
+       (should (eql ?\n (char-after (field-end (point)))))))))
+
+;;; erc-stamp-tests.el ends here
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0003-5.6-Convert-erc-fill-minor-mode-into-a-proper-module.patch --]
[-- Type: text/x-patch, Size: 2444 bytes --]

From 35d1b98e38a2848f3cef3297131a379b1690e6ea Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 02:38:12 -0700
Subject: [PATCH 3/4] [5.6] Convert erc-fill minor mode into a proper module

* lisp/erc/erc-fill.el (erc-fill-mode, erc-fill-enable,
erc-fill-disable): Use API to create these.
(erc-fill-static): Save restriction instead of caller's match data.
---
 lisp/erc/erc-fill.el | 34 +++++++++++-----------------------
 1 file changed, 11 insertions(+), 23 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e10b7d790f6..caf401bf222 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -38,30 +38,18 @@ erc-fill
   :group 'erc)
 
 ;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
-(define-minor-mode erc-fill-mode
-  "Toggle ERC fill mode.
-With a prefix argument ARG, enable ERC fill mode if ARG is
-positive, and disable it otherwise.  If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
+(define-erc-module fill nil
+  "Manage filling in ERC buffers.
 ERC fill mode is a global minor mode.  When enabled, messages in
 the channel buffers are filled."
-  :global t
-  (if erc-fill-mode
-      (erc-fill-enable)
-    (erc-fill-disable)))
-
-(defun erc-fill-enable ()
-  "Setup hooks for `erc-fill-mode'."
-  (interactive)
-  (add-hook 'erc-insert-modify-hook #'erc-fill)
-  (add-hook 'erc-send-modify-hook #'erc-fill))
-
-(defun erc-fill-disable ()
-  "Cleanup hooks, disable `erc-fill-mode'."
-  (interactive)
-  (remove-hook 'erc-insert-modify-hook #'erc-fill)
-  (remove-hook 'erc-send-modify-hook #'erc-fill))
+  ;; FIXME ensure a consistent ordering relative to hook members from
+  ;; other modules.  Ideally, this module's processing should happen
+  ;; after "morphological" modifications to a message's text but
+  ;; before superficial decorations.
+  ((add-hook 'erc-insert-modify-hook #'erc-fill)
+   (add-hook 'erc-send-modify-hook #'erc-fill))
+  ((remove-hook 'erc-insert-modify-hook #'erc-fill)
+   (remove-hook 'erc-send-modify-hook #'erc-fill)))
 
 (defcustom erc-fill-prefix nil
   "Values used as `fill-prefix' for `erc-fill-variable'.
@@ -130,7 +118,7 @@ erc-fill
 
 (defun erc-fill-static ()
   "Fills a text such that messages start at column `erc-fill-static-center'."
-  (save-match-data
+  (save-restriction
     (goto-char (point-min))
     (looking-at "^\\(\\S-+\\)")
     (let ((nick (match-string 1)))
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0004-5.6-Add-erc-fill-style-based-on-visual-line-mode.patch --]
[-- Type: text/x-patch, Size: 20685 bytes --]

From 19ddf027ab3cbfde020e43cdb2bcece828c6638f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Fri, 13 Jan 2023 00:00:56 -0800
Subject: [PATCH 4/4] [5.6] Add erc-fill style based on visual-line-mode

* lisp/erc/erc-common.el (erc--features-to-modules): Add mapping for
local module `fill-wrap'.
* lisp/erc/erc-fill.el (erc-fill-function): Add new value,
`erc-fill-wrap'.
(erc-fill-static-center): Extend meaning of option to also affect
`erc-wrap-mode'.
(erc-fill-wrap-mode, erc-fill--wrap-prefix, erc-fill--wrap-value,
erc-fill--wrap-movement): New minor mode and variables to support it.
(erc-fill-wrap-movement): New option to control how where
`visual-line-mode' keys are active.
(erc-fill--wrap-kill-line, erc-fill--wrap-beginning-of-line,
erc-fill--wrap-end-of-line): New movement commands.
(erc-fill-wrap-cycle-visual-movement): New command to cycle local
value of `erc-fill-wrap-movement'.
(erc-fill-wrap-mode-map): New map based on `visual-line-mode-map'.
(erc-fill-wrap): New function implementing
`erc-fill-function' (behavioral) interface.
(erc-fill-wrap-nudge, erc-fill--wrap-nudge): New command and helper
for growing and shrinking visual fill prefix.
* test/lisp/erc/erc-fill-tests.el: New file.
---
 lisp/erc/erc-common.el          |   1 +
 lisp/erc/erc-fill.el            | 247 +++++++++++++++++++++++++++++++-
 test/lisp/erc/erc-fill-tests.el | 162 +++++++++++++++++++++
 3 files changed, 408 insertions(+), 2 deletions(-)
 create mode 100644 test/lisp/erc/erc-fill-tests.el

diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 994555acecf..aae8280baa9 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -95,6 +95,7 @@ erc--features-to-modules
     (erc-join autojoin)
     (erc-page page ctcp-page)
     (erc-sound sound ctcp-sound)
+    (erc-fill fill-wrap)
     (erc-stamp stamp timestamp)
     (erc-services services nickserv))
   "Migration alist mapping a library feature to module names.
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..a05f2a558f8 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -28,6 +28,9 @@
 ;; `erc-fill-mode' to switch it on.  Customize `erc-fill-function' to
 ;; change the style.
 
+;; TODO: redo `erc-fill-wrap-nudge' using transient after ERC drops
+;; support for Emacs 27.
+
 ;;; Code:
 
 (require 'erc)
@@ -79,16 +82,27 @@ erc-fill-function
 These two styles are implemented using `erc-fill-variable' and
 `erc-fill-static'.  You can, of course, define your own filling
 function.  Narrowing to the region in question is in effect while your
-function is called."
+function is called.
+
+A third style resembles static filling but \"wraps\" instead of
+fills, courtesy of `visual-line-mode' mode, which ERC
+automatically enables when this option is `erc-fill-wrap' or
+`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'."
   :type '(choice (const :tag "Variable Filling" erc-fill-variable)
                  (const :tag "Static Filling" erc-fill-static)
+                 (const :tag "Dynamic word-wrap" erc-fill-wrap)
                  function))
 
 (defcustom erc-fill-static-center 27
   "Column around which all statically filled messages will be centered.
 This column denotes the point where the ` ' character between
 <nickname> and the entered text will be put, thus aligning nick
-names right and text left."
+names right and text left.
+
+Also used by the `erc-fill-function' variant `erc-fill-wrap' for
+its initial leading \"prefix\" width."
   :type 'integer)
 
 (defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +169,235 @@ erc-fill-variable
           (erc-fill-regarding-timestamp))))
     (erc-restore-text-properties)))
 
+(defvar-local erc-fill--wrap-prefix nil)
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-movement nil)
+
+(defcustom erc-fill-wrap-movement t
+  "Whether to override keys defined by `visual-line-mode'.
+A value of `display' means to favor default `erc-mode' keys when
+point is in the input area."
+  :package-version '(ERC . "5.5") ; FIXME sync on release
+  :type '(choice boolean (const display :tag "Display area"
+                                :doc "Use `erc-mode' keys in input area")))
+
+(defun erc-fill--wrap-kill-line (arg)
+  "Defer to `kill-line' or `kill-visual-line'."
+  (interactive "P")
+  ;; ERC buffers are read-only outside of the input area, but users
+  ;; still need to see the message.
+  (pcase erc-fill--wrap-movement
+    ('display (if (>= (point) erc-input-marker)
+                  (kill-line arg)
+                (kill-visual-line arg)))
+    ('t (kill-visual-line arg))
+    (_ (kill-line arg))))
+
+(defun erc-fill--wrap-beginning-of-line (arg)
+  "Defer to `move-beginning-of-line' or `beginning-of-visual-line'."
+  (interactive "^p")
+  (pcase erc-fill--wrap-movement
+    ('display (if (>= (point) erc-input-marker)
+                  (move-beginning-of-line arg)
+                (beginning-of-visual-line arg)))
+    ('t (beginning-of-visual-line arg))
+    (_ (move-beginning-of-line arg)))
+  (when (get-text-property (point) 'erc-prompt)
+    (goto-char erc-input-marker)))
+
+(defun erc-fill--wrap-end-of-line (arg)
+  "defer to `move-end-of-line' or `end-of-visual-line'."
+  (interactive "^p")
+  (pcase erc-fill--wrap-movement
+    ('display (if (>= (point) erc-input-marker)
+                  (move-end-of-line arg)
+                (end-of-visual-line arg)))
+    ('t (end-of-visual-line arg))
+    (_ (move-end-of-line arg))))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+  "Cycle through `erc-fill-wrap-movement' styles ARG times.
+Go from nil to t to `display' and back around, but set internal
+state instead of mutating `erc-fill-wrap-movement'.  When ARG is
+0, reset to value of `erc-fill-wrap-movement'."
+  (interactive "^p")
+  (when (zerop arg)
+    (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+  (while (not (zerop arg))
+    (cl-incf arg (- (abs arg)))
+    (setq erc-fill--wrap-movement (pcase erc-fill--wrap-movement
+                                    ('nil t)
+                                    ('t 'display)
+                                    ('display nil))))
+  (message "erc-fill-wrap-movement: %S" erc-fill--wrap-movement))
+
+(defvar-keymap erc-fill-wrap-mode-map ; Compat 29
+  :doc "Keymap for ERC's `fill-wrap' module."
+  :parent visual-line-mode-map
+  "<remap> <kill-line>" #'erc-fill--wrap-kill-line
+  "<remap> <move-end-of-line>" #'erc-fill--wrap-end-of-line
+  "<remap> <move-beginning-of-line>" #'erc-fill--wrap-beginning-of-line
+  "C-c c" #'erc-fill-wrap-cycle-visual-movement
+  ;; Not sure if this is problematic because `erc-bol' takes no args.
+  "<remap> <erc-bol>" #'erc-fill--wrap-beginning-of-line)
+
+(define-erc-module fill-wrap nil
+  "Fill style leveraging `visual-line-mode'.
+This local module depends on the global `fill' module.  To use
+it, either include `fill-wrap' in `erc-modules' or set
+`erc-fill-function' to `erc-fill-wrap'.  You can also manually
+invoke one of the minor-mode toggles."
+  ((let (msg)
+     (unless erc-fill-mode
+       (unless (memq 'fill erc-modules)
+         (setq msg
+               (concat "WARNING: enabling default global module `fill' needed "
+                       " by local module `fill-wrap'.  This will impact all"
+                       " ERC sessions.  Add `fill' to `erc-modules' to avoid "
+                       " this warning. See Info:\"(erc) Modules\" for more.")))
+       (erc-fill-mode +1))
+     ;; Set local value of user option (can we avoid this somehow?)
+     (unless (eq erc-fill-function #'erc-fill-wrap)
+       (setq-local erc-fill-function #'erc-fill-wrap))
+     (when-let* ((vars (or erc--server-reconnecting erc--target-priors))
+                 ((alist-get 'erc-fill-wrap-mode vars)))
+       (setq erc-fill--wrap-movement (alist-get 'erc-fill--wrap-movement vars)
+             erc-fill--wrap-prefix (alist-get 'erc-fill--wrap-prefix vars)
+             erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+     (when (eq erc-timestamp-use-align-to 'margin)
+       (erc-timestamp--display-margin-mode +1))
+     (setq erc-fill--wrap-value
+           (or erc-fill--wrap-value erc-fill-static-center)
+           ;;
+           erc-fill--wrap-prefix
+           (or erc-fill--wrap-prefix
+               (list 'space :width erc-fill--wrap-value)))
+     (visual-line-mode +1)
+     (unless (local-variable-p 'erc-fill--wrap-movement)
+       (setq erc-fill--wrap-movement erc-fill-wrap-movement))
+     (when msg
+       (erc-display-error-notice nil msg))))
+  ((when erc-timestamp--display-margin-mode
+     (erc-timestamp--display-margin-mode -1))
+   (kill-local-variable 'erc-button--add-nickname-face-function)
+   (kill-local-variable 'erc-fill--wrap-prefix)
+   (kill-local-variable 'erc-fill--wrap-value)
+   (kill-local-variable 'erc-fill-function)
+   (kill-local-variable 'erc-fill--wrap-movement)
+   (visual-line-mode -1))
+  'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+  "Function to determine length of perceived nickname.
+It should return an integer representing the length of the
+nickname, including any enclosing brackets, or nil, to fall back
+to the default behavior of taking the length from the first word.")
+
+(defvar erc-fill--wrap-use-pixels t)
+(declare-function buffer-text-pixel-size "xdisp"
+                  (&optional buffer-or-name window x-limit y-limit))
+
+(defun erc-fill-wrap ()
+  "Use text props to mimic the effect of `erc-fill-static'.
+See `erc-fill-wrap-mode' for details."
+  (unless erc-fill-wrap-mode
+    (erc-fill-wrap-mode +1))
+  (save-excursion
+    (goto-char (point-min))
+    (let* ((len (or (and erc-fill--wrap-length-function
+                         (funcall erc-fill--wrap-length-function))
+                    (progn
+                      (skip-syntax-forward "^-")
+                      (forward-char)
+                      (if (and erc-fill--wrap-use-pixels
+                               (fboundp 'buffer-text-pixel-size))
+                          (save-restriction
+                            (narrow-to-region (point-min) (point))
+                            (list (car (buffer-text-pixel-size))))
+                        (- (point) (point-min)))))))
+      (erc-put-text-properties (point-min) (point-max)
+                               '(line-prefix wrap-prefix) nil
+                               `((space :width (- ,erc-fill--wrap-value ,len))
+                                 ,erc-fill--wrap-prefix)))))
+
+;; This is an experimental helper for third-party modules.  You could,
+;; for example, use this to automatically resize the prefix to a
+;; fraction of the window's width on some event change.
+
+(defun erc-fill--wrap-fix (&optional value)
+  "Re-wrap from `point-min' to `point-max'.
+Reset prefix to VALUE, when given."
+  (save-excursion
+    (when value
+      (setq erc-fill--wrap-value value
+            erc-fill--wrap-prefix (list 'space :width value)))
+    (let ((inhibit-field-text-motion t)
+          (inhibit-read-only t))
+      (goto-char (point-min))
+      (while (and (zerop (forward-line))
+                  (< (point) (min (point-max) erc-insert-marker)))
+        (save-restriction
+          (narrow-to-region (pos-bol) (pos-eol))
+          (erc-fill-wrap))))))
+
+(defun erc-fill--wrap-nudge (arg)
+  (save-excursion
+    (save-restriction
+      (widen)
+      (let ((inhibit-field-text-motion t)
+            (inhibit-read-only t) ; necessary?
+            (p (goto-char (point-min))))
+        (when (zerop arg)
+          (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+        (cl-incf (caddr erc-fill--wrap-prefix) arg)
+        (cl-incf erc-fill--wrap-value arg)
+        (while (setq p (next-single-property-change p 'line-prefix))
+          (when-let ((v (get-text-property p 'line-prefix)))
+            (cl-incf (nth 1 (nth 2 v)) arg) ; (space :width (- *this* len))
+            (when-let
+                ((e (text-property-not-all p (point-max) 'line-prefix v)))
+              (goto-char e)))))))
+  arg)
+
+(defun erc-fill-wrap-nudge (arg)
+  "Adjust `erc-fill-wrap' by ARG columns.
+Offer to repeat command in a manner similar to
+`text-scale-adjust'.  Note that misalignment may occur when
+messages contain decorations applied by third-party modules.
+See `erc-fill--wrap-fix' for a workaround."
+  (interactive "p")
+  (unless erc-fill--wrap-value
+    (cl-assert (not erc-fill-wrap-mode))
+    (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+  (let ((total (erc-fill--wrap-nudge arg))
+        (start (window-start))
+        (marker (set-marker (make-marker) (point))))
+    (when (zerop arg)
+      (setq arg 1))
+    (set-transient-map
+     (let ((map (make-sparse-keymap)))
+       (dolist (key '(?+ ?= ?- ?0))
+         (let ((a (pcase key
+                    (?0 0)
+                    (?- (- (abs arg)))
+                    (_ (abs arg)))))
+           (define-key map (vector (list key))
+                       (lambda ()
+                         (interactive)
+                         (cl-incf total (erc-fill--wrap-nudge a))
+                         (set-window-start (selected-window) start)
+                         (goto-char marker)))))
+       map)
+     t
+     (lambda ()
+       (set-marker marker nil)
+       (message "Fill prefix: %d (%+d col%s)"
+                erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+     "Use %k for further adjustment"
+     1)
+    (goto-char marker)
+    (set-window-start (selected-window) start)))
+
 (defun erc-fill-regarding-timestamp ()
   "Fills a text such that messages start at column `erc-fill-static-center'."
   (fill-region (point-min) (point-max) t t)
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
new file mode 100644
index 00000000000..cf243ef43c7
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,162 @@
+;;; erc-fill-tests.el --- Tests for erc-fill  -*- 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)
+(require 'erc-fill)
+
+(defun erc-fill-tests--wrap-populate (test)
+  (let ((proc (start-process "sleep" (current-buffer) "sleep" "1"))
+        (id (erc-networks--id-create 'foonet))
+        (erc-insert-modify-hook '(erc-fill erc-add-timestamp))
+        (erc-server-users (make-hash-table :test 'equal))
+        (erc-fill-function 'erc-fill-wrap)
+        (erc-modules '(fill stamp))
+        (msg "Hello World")
+        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+    (when (bound-and-true-p erc-button-mode)
+      (push 'erc-button-add-buttons erc-insert-modify-hook))
+    (erc-mode)
+    (setq erc-server-process proc erc-networks--id id)
+
+    (with-current-buffer (get-buffer-create "#chan")
+      (erc-mode)
+      (erc-munge-invisibility-spec)
+      (setq erc-server-process proc
+            erc-networks--id id
+            erc-channel-users (make-hash-table :test 'equal)
+            erc--target (erc--target-from-string "#chan")
+            erc-default-recipients (list "#chan"))
+      (erc--initialize-markers (point) nil)
+
+      (erc-update-channel-member
+       "#chan" "alice" "alice" t nil nil nil nil nil "fake" "~u" nil nil t)
+
+      (erc-update-channel-member
+       "#chan" "bob" "bob" t nil nil nil nil nil "fake" "~u" nil nil t)
+      (setq msg "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.")
+
+      (erc-display-message nil 'notice (current-buffer) msg)
+      (setq msg "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.")
+
+      (erc-display-message
+       nil nil (current-buffer)
+       (erc--format-privmsg "alice" msg nil t nil))
+      (setq msg "alice: Either your unparagoned mistress is dead,\
+ or she's outprized by a trifle.")
+
+      (erc-display-message
+       nil nil (current-buffer)
+       (erc--format-privmsg "bob" msg nil t nil))
+
+      (funcall test)
+      (when noninteractive
+        (kill-buffer)))))
+
+(ert-deftest erc-fill-wrap--monospace ()
+  :tags '(:unstable)
+
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+
+     ;; Prefix props are applied properly and faces are accounted
+     ;; for when determining widths.
+     (goto-char (point-min))
+     (should (search-forward "<a" nil t))
+     (should (get-text-property (pos-bol) 'line-prefix))
+     (should (get-text-property (pos-eol) 'line-prefix))
+     (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                    '(space :width 27)))
+     (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                    '(space :width 27)))
+     (should (pcase (get-text-property (point) 'line-prefix)
+               (`(space :width (- 27 (,w)))
+                (should (= w (string-pixel-width "<alice> "))))))
+
+     (erc-fill--wrap-nudge 2)
+
+     (should (search-forward "<b" nil t))
+     (should (get-text-property (pos-bol) 'line-prefix))
+     (should (get-text-property (pos-eol) 'line-prefix))
+     (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                    '(space :width 29)))
+     (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                    '(space :width 29)))
+     (should (pcase (get-text-property (point) 'line-prefix)
+               (`(space :width (- 29 (,w)))
+                (should (= w (string-pixel-width "<bob> ")))))))))
+
+(ert-deftest erc-fill-wrap--variable-pitch ()
+  :tags '(:unstable)
+  (unless (and (not noninteractive) (display-graphic-p))
+    (ert-skip "Test needs interactive graphical Emacs"))
+
+  (with-selected-frame (make-frame '((name . "other")))
+    (set-face-attribute 'default (selected-frame)
+                        :family "Sans Serif"
+                        :foundry 'unspecified
+                        :font 'unspecified)
+
+    (erc-fill-tests--wrap-populate
+
+     (lambda ()
+
+       ;; Prefix props are applied properly and faces are accounted
+       ;; for when determining widths.
+       (goto-char (point-min))
+       (should (search-forward "<a" nil t))
+       (should (get-text-property (pos-bol) 'line-prefix))
+       (should (get-text-property (pos-eol) 'line-prefix))
+       (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                      '(space :width 27)))
+       (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                      '(space :width 27)))
+       (should (pcase (get-text-property (point) 'line-prefix)
+                 (`(space :width (- 27 (,w)))
+                  (should (> w (string-pixel-width "<alice> "))))))
+
+       (erc-fill--wrap-nudge 2)
+
+       (should (search-forward "<b" nil t))
+       (should (get-text-property (pos-bol) 'line-prefix))
+       (should (get-text-property (pos-eol) 'line-prefix))
+       (should (equal (get-text-property (pos-bol) 'wrap-prefix)
+                      '(space :width 29)))
+       (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                      '(space :width 29)))
+       (should (pcase (get-text-property (point) 'line-prefix)
+                 (`(space :width (- 29 (,w)))
+                  (should (> w (string-pixel-width "<bob> "))))))
+
+       ;; FIXME figure out how to get rid of this "void variable
+       ;; `erc--results-ewoc'" error, which seems related to operating
+       ;; in this second frame.
+       ;;
+       ;; As a kludge, checking if point made it to the prompt can
+       ;; serve as visual confirmation that the test passed.
+       (goto-char (point-max))))))
+
+;;; erc-fill-tests.el ends here
-- 
2.38.1