>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