bug#71605: 30.0.50; [PATCH] Support variable-width text in 'visual-wrap-prefix-mode'

[Jim Porter <jporterbugs@gmail.com>]

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

On 6/20/2024 12:01 PM, Jim Porter wrote:
> On 6/20/2024 11:08 AM, Eli Zaretskii wrote:
>> Does this mean we can close this bug, or is there anything else to do
>> here?
> 
> I need to implement a new version of my patch that uses :align-to and 
> such. So there are still things to do in this bug, but the :align-to 
> issue that was blocking progress on this bug is now resolved.

After some time away from this bug, I've made a new version of this 
patch which uses ':align-to' to line up the wrapped lines. All of the 
text properties in this patch use widths defined in terms of the average 
width for the current face (using a spec like "(N . width)"), which I 
think should work correctly in all situations.

I've also set the min-width of the first-line prefix to ensure 
everything lines up just right. That makes it easier to line things up 
this way, rather than my previous brittle attempts at computing the 
exact pixel width of the first-line prefix (that width can change for 
all sorts of reasons).

Also attached is a test script I wrote to preview the effects of the 
patch. If you pass an additional numeric argument on the command line 
when loading it, it will set 'visual-wrap-extra-indent' so you can see 
how that affects things.

[-- Attachment #2: 0001-Add-support-for-variable-pitch-fonts-in-visual-wrap-.patch --]
[-- Type: text/plain, Size: 10149 bytes --]

From 1509d9bf0acfab6ea486b96cd6765fc95ccf2b2b Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 27 Jul 2024 20:48:38 -0700
Subject: [PATCH] Add support for variable-pitch fonts in
 'visual-wrap-prefix-mode'

* lisp/emacs-lisp/subr-x.el (string-pixel-width): Allow passing BUFFER
to use the face remappings from that buffer when calculating the width.

* lisp/visual-wrap.el (visual-wrap--prefix): Rename to...
(visual-wrap--adjust-prefix): ... this, and support PREFIX as a number.
(visual-wrap-fill-context-prefix): Make obsolete in favor of...
(visual-wrap--content-prefix): ... this.
(visual-wrap-prefix-function): Extract inside of loop into...
(visual-wrap--apply-to-line): ... this.

* doc/lispref/display.texi (Size of Displayed Text): Update
documentation for 'string-pixel-width'.

* etc/NEWS: Announce this change.
---
 doc/lispref/display.texi  |   6 +-
 etc/NEWS                  |  11 ++++
 lisp/emacs-lisp/subr-x.el |  11 +++-
 lisp/visual-wrap.el       | 114 ++++++++++++++++++++++++++------------
 4 files changed, 102 insertions(+), 40 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 195464ef7f5..d28ff9ead26 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2385,9 +2385,11 @@ Size of Displayed Text
 meaning as with @code{window-text-pixel-size}.
 @end defun
 
-@defun string-pixel-width string
+@defun string-pixel-width string &optional buffer
 This is a convenience function that uses @code{window-text-pixel-size}
-to compute the width of @var{string} (in pixels).
+to compute the width of @var{string} (in pixels).  If @var{buffer} is
+non-@code{nil}, use any face remappings (@pxref{Face Remapping}) from
+that buffer when computing the width of @var{string}.
 @end defun
 
 @defun line-pixel-height
diff --git a/etc/NEWS b/etc/NEWS
index c907ec40fa1..0c6cd9771e1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -52,6 +52,12 @@ usual minibuffer history commands.  Each command has a separate history.
 *** New language-environment and input method for Tifinagh.
 The Tifinagh script is used to write the Berber languages.
 
+---
+** 'visual-wrap-prefix-mode' now supports variable-pitch fonts.
+When using 'visual-wrap-prefix-mode' in buffers with variable-pitch
+fonts, the wrapped text will now be lined up correctly so that it's
+exactly below the text after the prefix on the first line.
+
 \f
 * Changes in Specialized Modes and Packages in Emacs 31.1
 
@@ -194,6 +200,11 @@ authorize the invoked D-Bus method (for example via polkit).
 ** The customization group 'wp' has been removed.
 It has been obsolete since Emacs 26.1.  Use the group 'text' instead.
 
++++
+** New optional BUFFER argument for 'string-pixel-width'.
+If supplied, 'string-pixel-width' will use any face remappings from
+BUFFER when computing the string's width.
+
 \f
 * Changes in Emacs 31.1 on Non-Free Operating Systems
 
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index e725c490aba..058c06bc5f6 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -337,8 +337,10 @@ named-let
       . ,aargs)))
 
 ;;;###autoload
-(defun string-pixel-width (string)
-  "Return the width of STRING in pixels."
+(defun string-pixel-width (string &optional buffer)
+  "Return the width of STRING in pixels.
+If BUFFER is non-nil, use the face remappings from that buffer when
+determining the width."
   (declare (important-return-value t))
   (if (zerop (length string))
       0
@@ -352,6 +354,11 @@ string-pixel-width
       ;; Disable line-prefix and wrap-prefix, for the same reason.
       (setq line-prefix nil
 	    wrap-prefix nil)
+      (if buffer
+          (setq-local face-remapping-alist
+                      (with-current-buffer buffer
+                        face-remapping-alist))
+        (kill-local-variable 'face-remapping-alist))
       (insert (propertize string 'line-prefix nil 'wrap-prefix nil))
       (car (buffer-text-pixel-size nil nil t)))))
 
diff --git a/lisp/visual-wrap.el b/lisp/visual-wrap.el
index d95cf4bb569..d2ceb0b17ca 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -97,24 +97,86 @@ visual-wrap--prefix-face
                                  (if (visual-wrap--face-extend-p f) f))
                                eol-face)))))))
 
-(defun visual-wrap--prefix (fcp)
-  (let ((fcp-len (string-width fcp)))
-    (cond
-     ((= 0 visual-wrap-extra-indent)
-      fcp)
-     ((< 0 visual-wrap-extra-indent)
-      (concat fcp (make-string visual-wrap-extra-indent ?\s)))
-     ((< 0 (+ visual-wrap-extra-indent fcp-len))
-      (substring fcp
-                 0
-                 (+ visual-wrap-extra-indent fcp-len)))
-     (t
-      ""))))
+(defun visual-wrap--adjust-prefix (prefix)
+  "Adjust PREFIX with `visual-wrap-extra-indent'."
+  (if (numberp prefix)
+      (+ visual-wrap-extra-indent prefix)
+    (let ((prefix-len (string-width prefix)))
+      (cond
+       ((= 0 visual-wrap-extra-indent)
+        prefix)
+       ((< 0 visual-wrap-extra-indent)
+        (concat prefix (make-string visual-wrap-extra-indent ?\s)))
+       ((< 0 (+ visual-wrap-extra-indent prefix-len))
+        (substring prefix
+                   0 (+ visual-wrap-extra-indent prefix-len)))
+       (t
+        "")))))
+
+(defun visual-wrap--apply-to-line (position)
+  "Apply visual-wrapping properties to the logical line starting at POSITION."
+  (save-excursion
+    (goto-char position)
+    (let* ((first-line-prefix (fill-match-adaptive-prefix))
+           (next-line-prefix (visual-wrap--content-prefix
+                              first-line-prefix position)))
+      (when next-line-prefix
+        (when (numberp next-line-prefix)
+          (put-text-property
+           position (+ position (length first-line-prefix)) 'display
+           `(min-width ((,next-line-prefix . width)))))
+        (setq next-line-prefix (visual-wrap--adjust-prefix next-line-prefix))
+        (put-text-property
+         position (line-end-position) 'wrap-prefix
+         (if (numberp next-line-prefix)
+             `(space :align-to (,next-line-prefix . width))
+           next-line-prefix))))))
+
+(defun visual-wrap--content-prefix (prefix position)
+  "Get the next-line prefix for the specified first-line PREFIX.
+POSITION is the position in the buffer where PREFIX is located.
+
+This returns a string prefix to use for subsequent lines; an integer,
+indicating the number of canonical-width spaces to use; or nil, if
+PREFIX was empty."
+  (cond
+   ((string= prefix "")
+    nil)
+   ((string-match (rx bos (+ blank) eos) prefix)
+    ;; If the first-line prefix is all spaces, return its width in
+    ;; characters.  This way, we can set the prefix for all lines to use
+    ;; the canonical-width of the font, which helps for variable-pitch
+    ;; fonts where space characters are usually quite narrow.
+    (string-width prefix))
+   ((or (and adaptive-fill-first-line-regexp
+             (string-match adaptive-fill-first-line-regexp prefix))
+        (and comment-start-skip
+             (string-match comment-start-skip prefix)))
+    ;; If we want to repeat the first-line prefix on subsequent lines,
+    ;; return its string value.  However, we remove any `wrap-prefix'
+    ;; property that might have been added earlier.  Otherwise, we end
+    ;; up with a string containing a `wrap-prefix' string containing a
+    ;; `wrap-prefix' string...
+    (remove-text-properties 0 (length prefix) '(wrap-prefix) prefix)
+    prefix)
+   (t
+    ;; Otherwise, we want the prefix to be whitespace of the same width
+    ;; as the first-line prefix.  If possible, compute the real pixel
+    ;; width of the first-line prefix in canonical-width characters.
+    ;; This is useful if the first-line prefix uses some very-wide
+    ;; characters.
+    (if-let ((font (font-at position))
+             (info (query-font font)))
+        (max (string-width prefix)
+             (ceiling (string-pixel-width prefix (current-buffer))
+                      (aref info 7)))
+      (string-width prefix)))))
 
 (defun visual-wrap-fill-context-prefix (beg end)
   "Compute visual wrap prefix from text between BEG and END.
 This is like `fill-context-prefix', but with prefix length adjusted
 by `visual-wrap-extra-indent'."
+  (declare (obsolete nil "31.1"))
   (let* ((fcp
           ;; `fill-context-prefix' ignores prefixes that look like
           ;; paragraph starts, in order to avoid inadvertently
@@ -128,7 +190,7 @@ visual-wrap-fill-context-prefix
                   ;; Note: fill-context-prefix may return nil; See:
                   ;; http://article.gmane.org/gmane.emacs.devel/156285
               ""))
-         (prefix (visual-wrap--prefix fcp))
+         (prefix (visual-wrap--adjust-prefix fcp))
          (face (visual-wrap--prefix-face fcp beg end)))
     (if face
         (propertize prefix 'face face)
@@ -147,28 +209,8 @@ visual-wrap-prefix-function
   (forward-line 0)
   (setq beg (point))
   (while (< (point) end)
-    (let ((lbp (point)))
-      (put-text-property
-       (point) (progn (search-forward "\n" end 'move) (point))
-       'wrap-prefix
-       (let ((pfx (visual-wrap-fill-context-prefix
-		   lbp (point))))
-	 ;; Remove any `wrap-prefix' property that might have been
-	 ;; added earlier.  Otherwise, we end up with a string
-	 ;; containing a `wrap-prefix' string containing a
-	 ;; `wrap-prefix' string ...
-	 (remove-text-properties
-	  0 (length pfx) '(wrap-prefix) pfx)
-         (let ((dp (get-text-property 0 'display pfx)))
-           (when (and dp (eq dp (get-text-property (1- lbp) 'display)))
-             ;; There's a `display' property which covers not just the
-             ;; prefix but also the previous newline.  So it's not
-             ;; just making the prefix more pretty and could interfere
-             ;; or even defeat our efforts (e.g. it comes from
-             ;; `adaptive-fill-mode').
-             (remove-text-properties
-	      0 (length pfx) '(display) pfx)))
-	 pfx))))
+    (visual-wrap--apply-to-line (point))
+    (forward-line))
   `(jit-lock-bounds ,beg . ,end))
 
 ;;;###autoload
-- 
2.25.1


[-- Attachment #3: wrap.el --]
[-- Type: text/plain, Size: 676 bytes --]

(switch-to-buffer (get-buffer-create "demo"))
(buffer-face-set 'variable-pitch)

(setq words "Voluptatem est nostrum impedit nesciunt eum. Recusandae voluptatem quaerat hic harum. Consequatur in fuga nihil aliquid commodi rem sunt. Aperiam odio odio amet.")

(insert words "\n\n")
(insert "  " words "\n\n")
(insert "* " words "\n\n")
(insert "## " words "\n\n")
(insert (propertize (concat "## " words "\n")
                    'face '(:background "red" :height 300)))
(goto-char (point-min))

(setq extra-indent (pop command-line-args-left))
(when extra-indent
  (setq visual-wrap-extra-indent (string-to-number extra-indent)))

(visual-line-mode)
(visual-wrap-prefix-mode)