master 4b56739547c 32/37: Add erc-fill style based on visual-line-mode

[F. Jason Park]

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

    Add erc-fill style based on visual-line-mode
    
    * 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-value, erc-fill--wrap-visual-keys): New variables to
    support new local module.
    (erc-fill-wrap-visual-keys): New option to control how and where
    `visual-line-mode' keys are active.
    (erc-fill-wrap-merge): Add option for omitting a speaker's name if
    they just now spoke.  Enabled by default.
    (erc-fill--wrap-move): New helper function for fill-wrap movement
    commands.
    (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
    copy of `erc-fill-wrap-visual-keys'.
    (erc-fill-wrap-mode-map): New keymap based on `visual-line-mode-map'.
    (erc-fill--make-module-dependency-msg): Helper for
    `erc-fill-wrap-enable'.
    (erc-fill-wrap-mode, erc-fill-wrap-enable, erc-fill-wrap-disable): New
    local module.
    (erc-fill--wrap-length-function): Internal interface in the form of a
    function variable for other modules to control the fill-wrap overhang.
    (erc-fill--wrap-last-msg, erc-fill--wrap-max-lull,
    erc-fill--wrap-continued-message-p): Add items to support hiding of
    redundant speaker names in consecutive messages.
    (erc-fill--wrap-stamp-insert-prefixed-date): New function to add
    `line-prefix' property to inserted date stamp.
    (erc-fill-wrap): New function implementing the
    `erc-fill-function' (behavioral) interface.
    (erc-fill--wrap-fix): New, possibly temporary function for other
    modules to fix misalignment caused by fill-wrap.
    (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.  (Bug#60936.)
    * test/lisp/erc/resources/fill/snapshots/merge-01-start.eld: New file.
    * test/lisp/erc/resources/fill/snapshots/merge-02-right.eld: New file.
    * test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld: New file.
    * test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld: New file.
    * test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld: New file.
    * test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld: New file.
---
 lisp/erc/erc-fill.el                               | 346 ++++++++++++++++++++-
 test/lisp/erc/erc-fill-tests.el                    | 313 +++++++++++++++++++
 .../resources/fill/snapshots/merge-01-start.eld    |   1 +
 .../resources/fill/snapshots/merge-02-right.eld    |   1 +
 .../fill/snapshots/monospace-01-start.eld          |   1 +
 .../fill/snapshots/monospace-02-right.eld          |   1 +
 .../resources/fill/snapshots/monospace-03-left.eld |   1 +
 .../fill/snapshots/monospace-04-reset.eld          |   1 +
 8 files changed, 660 insertions(+), 5 deletions(-)

diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index caf401bf222..c29d292abce 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,29 @@ Static Filling with `erc-fill-static-center' of 27:
 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, 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'."
   :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."
+  "Number of columns to \"outdent\" the first line of a message.
+During early message handing, ERC prepends a span of
+non-whitespace characters to every message, such as a bracketed
+\"<nickname>\" or an `erc-notice-prefix'.  The
+`erc-fill-function' variants `erc-fill-static' and
+`erc-fill-wrap' look to this option to determine the amount of
+padding to apply to that portion until the filled (or wrapped)
+message content aligns with the indicated column.  See also
+https://en.wikipedia.org/wiki/Hanging_indent.";
   :type 'integer)
 
 (defcustom erc-fill-variable-maximum-indentation 17
@@ -155,6 +171,326 @@ You can put this on `erc-insert-modify-hook' and/or 
`erc-send-modify-hook'."
           (erc-fill-regarding-timestamp))))
     (erc-restore-text-properties)))
 
+(defvar-local erc-fill--wrap-value nil)
+(defvar-local erc-fill--wrap-visual-keys nil)
+
+(defcustom erc-fill-wrap-use-pixels t
+  "Whether to calculate padding in pixels when possible.
+A value of nil means ERC should use columns, which may happen
+regardless, depending on the Emacs version.  This option only
+matters when `erc-fill-wrap-mode' is enabled."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type 'boolean)
+
+(defcustom erc-fill-wrap-visual-keys 'non-input
+  "Whether to retain keys defined by `visual-line-mode'.
+A value of t tells ERC to use movement commands defined by
+`visual-line-mode' everywhere in an ERC buffer along with visual
+editing commands in the input area.  A value of nil means to
+never do so.  A value of `non-input' tells ERC to act like the
+value is nil in the input area and t elsewhere.  This option only
+plays a role when `erc-fill-wrap-mode' is enabled."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type '(choice (const nil) (const t) (const non-input)))
+
+(defcustom erc-fill-wrap-merge t
+  "Whether to consolidate messages from the same speaker.
+This tells ERC to omit redundant speaker labels for subsequent
+messages less than a day apart."
+  :package-version '(ERC . "5.6") ; FIXME sync on release
+  :type 'boolean)
+
+(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
+  (funcall (pcase erc-fill--wrap-visual-keys
+             ('non-input
+              (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+             ('t visual-cmd)
+             (_ normal-cmd))
+           arg))
+
+(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 we run
+  ;; `kill-line' anyway so that users can see the error.
+  (erc-fill--wrap-move #'kill-line #'kill-visual-line arg))
+
+(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))
+  (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")
+  (erc-fill--wrap-move #'move-end-of-line #'end-of-visual-line arg))
+
+(defun erc-fill-wrap-cycle-visual-movement (arg)
+  "Cycle through `erc-fill-wrap-visual-keys' styles ARG times.
+Go from nil to t to `non-input' and back around, but set internal
+state instead of mutating `erc-fill-wrap-visual-keys'.  When ARG
+is 0, reset to value of `erc-fill-wrap-visual-keys'."
+  (interactive "^p")
+  (when (zerop arg)
+    (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+  (while (not (zerop arg))
+    (cl-incf arg (- (abs arg)))
+    (setq erc-fill--wrap-visual-keys (pcase erc-fill--wrap-visual-keys
+                                       ('nil t)
+                                       ('t 'non-input)
+                                       ('non-input nil))))
+  (message "erc-fill-wrap movement: %S" erc-fill--wrap-visual-keys))
+
+(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 a" #'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)
+
+(defvar erc-match-mode)
+(defvar erc-button-mode)
+(defvar erc-match--hide-fools-offset-bounds)
+
+(defun erc-fill--make-module-dependency-msg (module)
+  (concat "Enabling default global module `" module "' needed by local"
+          " module `fill-wrap'.  This will impact \C-]all\C-] ERC"
+          " sessions.  Add `" module "' to `erc-modules' to avoid this"
+          " warning.  See Info:\"(erc) Modules\" for more."))
+
+;;;###autoload(put 'fill-wrap 'erc--feature 'erc-fill)
+(define-erc-module fill-wrap nil
+  "Fill style leveraging `visual-line-mode'.
+This module displays nickname labels for speakers as overhanging
+leftward (and thus right-aligned) to a common offset, as
+determined by the option `erc-fill-static-center'.  It depends on
+the `fill' and `button' modules and assumes the option
+`erc-insert-timestamp-function' is `erc-insert-timestamp-right'
+or `erc-insert-timestamp-left-and-right' (recommended) so that it
+can display right-hand stamps in the right margin.  A value of
+`erc-insert-timestamp-left' is unsupported.  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' (recommended).  You can also manually invoke one
+of the minor-mode toggles as usual."
+  ((let (msg)
+     (unless erc-fill-mode
+       (unless (memq 'fill erc-modules)
+         (setq msg
+               ;; FIXME use `erc-button--display-error-notice-with-keys'
+               ;; when bug#60933 is ready.
+               (erc-fill--make-module-dependency-msg "fill")))
+       (erc-fill-mode +1))
+     (when erc-fill-wrap-merge
+       (require 'erc-button)
+       (unless erc-button-mode
+         (unless (memq 'button erc-modules)
+           (setq msg (concat msg (and msg " ")
+                             (erc-fill--make-module-dependency-msg "button"))))
+         (erc-with-server-buffer
+           (erc-button-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-visual-keys (alist-get 'erc-fill--wrap-visual-keys
+                                                   vars)
+             erc-fill--wrap-value (alist-get 'erc-fill--wrap-value vars)))
+     (add-function :filter-args (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))
+     (when (or (bound-and-true-p erc-match-mode) (memq 'match erc-modules))
+       (require 'erc-match)
+       (setq erc-match--hide-fools-offset-bounds t))
+     (setq erc-fill--wrap-value
+           (or erc-fill--wrap-value erc-fill-static-center))
+     (visual-line-mode +1)
+     (unless (local-variable-p 'erc-fill--wrap-visual-keys)
+       (setq erc-fill--wrap-visual-keys erc-fill-wrap-visual-keys))
+     (when msg
+       (erc-display-error-notice nil msg))))
+  ((when erc-stamp--display-margin-mode
+     (erc-stamp--display-margin-mode -1))
+   (kill-local-variable 'erc-fill--wrap-value)
+   (kill-local-variable 'erc-fill-function)
+   (kill-local-variable 'erc-fill--wrap-visual-keys)
+   (remove-function (local 'erc-stamp--insert-date-function)
+                    #'erc-fill--wrap-stamp-insert-prefixed-date)
+   (visual-line-mode -1))
+  'local)
+
+(defvar-local erc-fill--wrap-length-function nil
+  "Function to determine length of overhanging characters.
+It should return an EXPR as defined by the Info node `(elisp)
+Pixel Specification'.  This value should represent the width of
+the overhang with all faces applied, including any enclosing
+brackets (which are not normally fontified) and a trailing space.
+It can also return nil to tell ERC to fall back to the default
+behavior of taking the length from the first \"word\".  This
+variable can be converted to a public one if needed by third
+parties.")
+
+(defvar-local erc-fill--wrap-last-msg nil)
+(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
+
+(defun erc-fill--wrap-continued-message-p ()
+  (prog1 (and-let*
+             ((m (or erc-fill--wrap-last-msg
+                     (setq erc-fill--wrap-last-msg (point-min-marker))
+                     nil))
+              ((< (1+ (point-min)) (- (point) 2)))
+              (props (save-restriction
+                       (widen)
+                       (when (eq 'erc-timestamp (field-at-pos m))
+                         (set-marker m (field-end m)))
+                       (and (eq 'PRIVMSG (get-text-property m 'erc-command))
+                            (not (eq (get-text-property m 'font-lock-face)
+                                     'erc-action-face))
+                            (cons (get-text-property m 'erc-timestamp)
+                                  (get-text-property (1+ m) 'erc-data)))))
+              (ts (pop props))
+              ((not (time-less-p (erc-stamp--current-time) ts)))
+              ((time-less-p (time-subtract (erc-stamp--current-time) ts)
+                            erc-fill--wrap-max-lull))
+              (nick  (buffer-substring-no-properties
+                      (1+ (point-min)) (- (point) 2)))
+              ((equal (car props) (erc-downcase nick)))))
+    (set-marker erc-fill--wrap-last-msg (point-min))))
+
+(defun erc-fill--wrap-stamp-insert-prefixed-date (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))
+  args)
+
+(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)
+                     (cond ((and erc-fill-wrap-merge
+                                 (erc-fill--wrap-continued-message-p))
+                            (put-text-property (point-min) (point)
+                                               'display "")
+                            0)
+                           ((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)))))
+                           (t (- (point) (point-min))))))))
+      ;; Leaving out the final newline doesn't seem to affect anything.
+      (erc-put-text-properties (point-min) (point-max)
+                               '(line-prefix wrap-prefix) nil
+                               `((space :width (- erc-fill--wrap-value ,len))
+                                 (space :width erc-fill--wrap-value))))))
+
+;; 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.  Another use
+;; case would be to fix lines affected by toggling a display-oriented
+;; mode, like `display-line-numbers-mode'.
+
+(defun erc-fill--wrap-fix (&optional value)
+  "Re-wrap from `point-min' to `point-max'.
+That is, recalculate the width of all accessible lines and reset
+local prefix VALUE when non-nil."
+  (save-excursion
+    (when value
+      (setq erc-fill--wrap-value 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 (line-beginning-position) (line-end-position))
+          (erc-fill-wrap))))))
+
+(defun erc-fill--wrap-nudge (arg)
+  (when (zerop arg)
+    (setq arg (- erc-fill-static-center erc-fill--wrap-value)))
+  (cl-incf erc-fill--wrap-value arg)
+  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'.
+
+   \\`=' Increase indentation by one column
+   \\`-' Decrease indentation by one column
+   \\`0' Reset indentation to the default
+   \\`+' Shift right margin rightward (shrink) by one column
+   \\`_' Shift right margin leftward (grow) by one column
+   \\`)' Reset the right margin to the default
+
+Note that misalignment may occur when messages contain
+decorations applied by third-party modules.  See
+`erc-fill--wrap-fix' for a temporary workaround."
+  (interactive "p")
+  (unless erc-fill--wrap-value
+    (cl-assert (not erc-fill-wrap-mode))
+    (user-error "Minor mode `erc-fill-wrap-mode' disabled"))
+  (unless (get-buffer-window)
+    (user-error "Command called in an undisplayed buffer"))
+  (let* ((total (erc-fill--wrap-nudge arg))
+         (win-ratio (/ (float (- (window-point) (window-start)))
+                       (- (window-end nil t) (window-start)))))
+    (when (zerop arg)
+      (setq arg 1))
+    (erc-compat-call
+     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))
+                         (recenter (round (* win-ratio (window-height))))))))
+       (dolist (key '(?\) ?_ ?+))
+         (let ((a (pcase key
+                    (?\) 0)
+                    (?_ (- (abs arg)))
+                    (?+ (abs arg)))))
+           (define-key map (vector (list key))
+                       (lambda ()
+                         (interactive)
+                         (erc-stamp--adjust-right-margin (- a))
+                         (recenter (round (* win-ratio (window-height))))))))
+       map)
+     t
+     (lambda ()
+       (message "Fill prefix: %d (%+d col%s)"
+                erc-fill--wrap-value total (if (> (abs total) 1) "s" "")))
+     "Use %k for further adjustment"
+     1)
+    (recenter (round (* win-ratio (window-height))))))
+
 (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..f249be8fb86
--- /dev/null
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -0,0 +1,313 @@
+;;; 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:
+
+;; FIXME these tests are brittle and error prone.  Replace with
+;; scenarios.
+
+;;; Code:
+(require 'ert-x)
+(require 'erc-fill)
+
+(defvar erc-fill-tests--buffers nil)
+(defvar erc-fill-tests--time-vals (lambda () 0))
+
+(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
+  (declare (indent 1))
+  (let ((msg (erc-format-privmessage speaker
+                                     (apply #'concat msg-parts) nil t)))
+    (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
+    (erc-display-message nil nil (current-buffer) msg)))
+
+(defun erc-fill-tests--wrap-populate (test)
+  (let ((original-window-buffer (window-buffer (selected-window)))
+        (erc-stamp--tz t)
+        (erc-fill-function 'erc-fill-wrap)
+        (pre-command-hook pre-command-hook)
+        (inhibit-message noninteractive)
+        erc-insert-post-hook
+        extended-command-history
+        erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+    (cl-letf (((symbol-function 'erc-stamp--current-time)
+               (lambda () (funcall erc-fill-tests--time-vals)))
+              ((symbol-function 'erc-server-connect)
+               (lambda (&rest _)
+                 (setq erc-server-process
+                       (start-process "sleep" (current-buffer) "sleep" "1"))
+                 (set-process-query-on-exit-flag erc-server-process nil))))
+      (with-current-buffer
+          (car (push (erc-open "localhost" 6667 "tester" "Tester" 'connect
+                               nil nil nil nil nil "tester" 'foonet)
+                     erc-fill-tests--buffers))
+        (setq erc-network 'foonet
+              erc-server-connected t)
+        (with-current-buffer (erc--open-target "#chan")
+          (set-window-buffer (selected-window) (current-buffer))
+
+          (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)
+
+          (erc-display-message
+           nil 'notice (current-buffer)
+           (concat "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-fill-tests--insert-privmsg "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.")
+
+          ;; Introduce an artificial gap in properties `line-prefix' and
+          ;; `wrap-prefix' and later ensure they're not incremented twice.
+          (save-excursion
+            (forward-line -1)
+            (search-forward "? ")
+            (with-silent-modifications
+              (remove-text-properties (1- (point)) (point)
+                                      '(line-prefix t wrap-prefix t))))
+
+          (erc-fill-tests--insert-privmsg "bob"
+            "alice: Either your unparagoned mistress is dead, "
+            "or she's outprized by a trifle.")
+
+          ;; Defend against non-local exits from `ert-skip'
+          (unwind-protect
+              (funcall test)
+            (set-window-buffer (selected-window) original-window-buffer)
+            (when noninteractive
+              (while-let ((buf (pop erc-fill-tests--buffers)))
+                (kill-buffer buf))
+              (kill-buffer))))))))
+
+(defun erc-fill-tests--wrap-check-prefixes (&rest prefixes)
+  ;; Check that prefix props are applied over correct intervals.
+  (save-excursion
+    (goto-char (point-min))
+    (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 (equal (get-text-property (pos-bol) 'wrap-prefix)
+                     '(space :width erc-fill--wrap-value)))
+      (should (equal (get-text-property (pos-eol) 'wrap-prefix)
+                     '(space :width erc-fill--wrap-value))))))
+
+;; Set this variable to t to generate new snapshots after carefully
+;; reviewing the output of *each* snapshot (not just first and last).
+;; Obviously, only run one test at a time.
+(defvar erc-fill-tests--save-p nil)
+
+(defun erc-fill-tests--compare (name)
+  (when (display-graphic-p)
+    (setq name (concat name "-graphic")))
+  (let* ((dir (expand-file-name "fill/snapshots/" (ert-resource-directory)))
+         (expect-file (file-name-with-extension (expand-file-name name dir)
+                                                "eld"))
+         (erc--own-property-names
+          (seq-difference `(font-lock-face ,@erc--own-property-names)
+                          '(field display wrap-prefix line-prefix)
+                          #'eq))
+         (print-circle t)
+         (print-escape-newlines t)
+         (print-escape-nonascii t)
+         (got (erc--remove-text-properties
+               (buffer-substring (point-min) erc-insert-marker)))
+         (repr (string-replace "erc-fill--wrap-value"
+                               (number-to-string erc-fill--wrap-value)
+                               (prin1-to-string got))))
+    (with-current-buffer (generate-new-buffer name)
+      (push name erc-fill-tests--buffers)
+      (with-silent-modifications
+        (insert (setq got (read repr))))
+      (erc-mode))
+    (if erc-fill-tests--save-p
+        (with-temp-file expect-file
+          (insert repr))
+      (if (file-exists-p expect-file)
+          ;; Compare set-equal over intervals
+          (should (equal-including-properties
+                   (read repr)
+                   (read (with-temp-buffer
+                           (insert-file-contents-literally expect-file)
+                           (buffer-string)))))
+        (message "Snapshot file missing: %S" expect-file)))))
+
+;; To inspect variable pitch, set `erc-mode-hook' to
+;;
+;;   (lambda () (face-remap-add-relative 'default :family "Sans Serif"))
+;;
+;; or similar.
+
+(ert-deftest erc-fill-wrap--monospace ()
+  :tags '(:unstable)
+  (unless (>= emacs-major-version 29)
+    (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+     (should (= erc-fill--wrap-value 27))
+     (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+     (erc-fill-tests--compare "monospace-01-start")
+
+     (ert-info ("Shift right by one (plus)")
+       ;; Args are all `erc-fill-wrap-nudge' +1 because interactive "p"
+       (ert-with-message-capture messages
+         ;; M-x erc-fill-wrap-nudge RET =
+         (ert-simulate-command '(erc-fill-wrap-nudge 2))
+         (should (string-match (rx "for further adjustment") messages)))
+       (should (= erc-fill--wrap-value 29))
+       (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+       (erc-fill-tests--compare "monospace-02-right"))
+
+     (ert-info ("Shift left by five")
+       ;; "M-x erc-fill-wrap-nudge RET -----"
+       (ert-simulate-command '(erc-fill-wrap-nudge -4))
+       (should (= erc-fill--wrap-value 25))
+       (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+       (erc-fill-tests--compare "monospace-03-left"))
+
+     (ert-info ("Reset")
+       ;; M-x erc-fill-wrap-nudge RET 0
+       (ert-simulate-command '(erc-fill-wrap-nudge 0))
+       (should (= erc-fill--wrap-value 27))
+       (erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
+       (erc-fill-tests--compare "monospace-04-reset")))))
+
+(ert-deftest erc-fill-wrap--merge ()
+  :tags '(:unstable)
+  (unless (>= emacs-major-version 29)
+    (ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
+
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+     ;; Set this here so that the first few messages are from 1970
+     (let ((erc-fill-tests--time-vals (lambda () 1680332400)))
+       (erc-fill-tests--insert-privmsg "bob" "zero.")
+       (erc-fill-tests--insert-privmsg "alice" "one.")
+       (erc-fill-tests--insert-privmsg "alice" "two.")
+       (erc-fill-tests--insert-privmsg "bob" "three.")
+       (erc-fill-tests--insert-privmsg "bob" "four."))
+
+     (should (= erc-fill--wrap-value 27))
+     (erc-fill-tests--wrap-check-prefixes
+      "*** " "<alice> " "<bob> "
+      "<bob> " "<alice> " "<alice> " "<bob> " "<bob> ")
+     (erc-fill-tests--compare "merge-01-start")
+
+     (ert-info ("Shift right by one (plus)")
+       (ert-simulate-command '(erc-fill-wrap-nudge 2))
+       (should (= erc-fill--wrap-value 29))
+       (erc-fill-tests--wrap-check-prefixes
+        "*** " "<alice> " "<bob> "
+        "<bob> " "<alice> " "<alice> " "<bob> " "<bob> ")
+       (erc-fill-tests--compare "merge-02-right")))))
+
+(ert-deftest erc-fill-wrap-visual-keys--body ()
+  :tags '(:unstable)
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+     (ert-info ("Value: non-input")
+       (should (eq erc-fill--wrap-visual-keys 'non-input))
+       (goto-char (point-min))
+       (should (search-forward "that he hath" nil t))
+       (execute-kbd-macro "\C-a")
+       (should-not (looking-at (rx "<alice> ")))
+       (execute-kbd-macro "\C-e")
+       (should (search-backward "tedious fool" nil t))
+       (should-not (looking-back "done to her\\."))
+       (forward-char)
+       (execute-kbd-macro "\C-e")
+       (should (search-forward "done to her." nil t)))
+
+     (ert-info ("Value: nil")
+       (execute-kbd-macro "\C-ca")
+       (should-not erc-fill--wrap-visual-keys)
+       (goto-char (point-min))
+       (should (search-forward "in debug mode" nil t))
+       (execute-kbd-macro "\C-a")
+       (should (looking-at (rx "*** ")))
+       (execute-kbd-macro "\C-e")
+       (should (eql ?\] (char-before (point)))))
+
+     (ert-info ("Value: t")
+       (execute-kbd-macro "\C-ca")
+       (should (eq erc-fill--wrap-visual-keys t))
+       (goto-char (point-min))
+       (should (search-forward "that he hath" nil t))
+       (execute-kbd-macro "\C-a")
+       (should-not (looking-at (rx "<alice> ")))
+       (should (search-backward "tedious fool" nil t))
+       (execute-kbd-macro "\C-e")
+       (should-not (looking-back (rx "done to her\\.")))
+       (should (search-forward "done to her." nil t))
+       (execute-kbd-macro "\C-a")
+       (should-not (looking-at (rx "<alice> ")))))))
+
+(ert-deftest erc-fill-wrap-visual-keys--prompt ()
+  :tags '(:unstable)
+  (erc-fill-tests--wrap-populate
+
+   (lambda ()
+     (set-window-buffer (selected-window) (current-buffer))
+     (goto-char erc-input-marker)
+     (insert "This buffer is for text that is not saved, and for Lisp "
+             "evaluation.  To create a file, visit it with C-x C-f and "
+             "enter text in its buffer.")
+
+     (ert-info ("Value: non-input")
+       (should (eq erc-fill--wrap-visual-keys 'non-input))
+       (execute-kbd-macro "\C-a")
+       (should (looking-at "This buffer"))
+       (execute-kbd-macro "\C-e")
+       (should (looking-back "its buffer\\."))
+       (execute-kbd-macro "\C-a")
+       (execute-kbd-macro "\C-k")
+       (should (eobp)))
+
+     (ert-info ("Value: nil") ; same
+       (execute-kbd-macro "\C-ca")
+       (should-not erc-fill--wrap-visual-keys)
+       (execute-kbd-macro "\C-y")
+       (should (looking-back "its buffer\\."))
+       (execute-kbd-macro "\C-a")
+       (should (looking-at "This buffer"))
+       (execute-kbd-macro "\C-k")
+       (should (eobp)))
+
+     (ert-info ("Value: non-input")
+       (execute-kbd-macro "\C-ca")
+       (should (eq erc-fill--wrap-visual-keys t))
+       (execute-kbd-macro "\C-y")
+       (execute-kbd-macro "\C-a")
+       (should-not (looking-at "This buffer"))
+       (execute-kbd-macro "\C-p")
+       (should-not (looking-back "its buffer\\."))
+       (should (search-forward "its buffer." nil t))
+       (should (search-backward "ERC> " nil t))
+       (execute-kbd-macro "\C-a")))))
+
+;;; erc-fill-tests.el ends here
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
new file mode 100644
index 00000000000..db3136a9d9e
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -0,0 +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
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld 
b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
new file mode 100644
index 00000000000..fcb9e59b757
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -0,0 +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
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
new file mode 100644
index 00000000000..67ebad542fb
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -0,0 +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
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
new file mode 100644
index 00000000000..0bf8001475d
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -0,0 +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
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
new file mode 100644
index 00000000000..7d231d19cef
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -0,0 +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
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld 
b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
new file mode 100644
index 00000000000..67ebad542fb
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -0,0 +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