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: 6428 bytes --]

On 6/17/2024 4:37 AM, Eli Zaretskii wrote:
>> Date: Sun, 16 Jun 2024 19:56:44 -0700
>> From: Jim Porter <jporterbugs@gmail.com>
>> The attached patch adds a display spec in this case so that the text
>> lines up perfectly.
> 
> Can you explain the idea of the patch?  I don't think I understand why
> you use '(space :width)' rather than '(space :align-to)'.

I tried using :align-to, and it doesn't seem to take effect for the 
'wrap-prefix' text property. I haven't looked closely at why that 
doesn't work, but even if it did, I think it might make things more 
complex than they already are.

I'll try to describe the current process:

1. 'visual-wrap-prefix-mode' goes a line at a time, finding the 
first-line prefix (for a bulleted item, this is something like "* ").
2. Then it constructs the wrap-prefix string (for a bulleted item, 
something like "  "; for other items it might be the same as the 
first-line prefix).
3. Finally, it applies the the wrap-prefix to the entire line it's 
examining.

The problem comes up for variable-pitch fonts, where "* " and "  " have 
different pixel widths. Before my patch, this results in the second line 
not lining up correctly. See the attached image for an example.

My patch just sets a display-spec on the "  " to make it have the same 
pixel-width as "* ". Then it all lines up.

If I understand your :align-to suggestion, setting :align-to on 
everything after the "* " bullet could work in theory, but I don't know 
what value you could set there to make everything correct. If it's a 
fixed number of pixels, then scaling up the text could mean the "* " 
becomes too wide for the space we reserved for it, and then things would 
probably look wrong. If it's based on the canonical character width, 
that might work so long as that updates when needed, but it might still 
look off depending on how the canonical width and the pixel width 
compare. (Ideally, we'd align to the exact pixel-width of "* " or 
whatever the first-line prefix is.) I couldn't get :align-to to work in 
the first place though so this is all hypothetical...

>> There's currently one problem though: I'm not sure
>> how to regenerate the wrap prefix automatically if the face changes.
>> It's not hard to handle for 'text-scale-adjust', but I don't know how to
>> handle 'global-text-scale-adjust' (or other things that could change the
>> face[1]).
>>
>> Does anyone have any ideas for this part?
> 
> Perhaps we could provide a function "face-change (&optional frame)"
> which would access the frame's face_change flag and the global
> face_change flag.  Then you could test those in a post-command-hook or
> somesuch.  (However, using :align-to, if feasible, sounds like a
> better solution to me.)

The 'face-change' idea could work, or here's another possibility: what 
about using :relative-width? If I set that correctly, then the 
pixel-size should adjust as the text scales. It wouldn't handle the case 
where the actual font changes though. It would also have some loss of 
precision, but I tested out a hacky patch using :relative-width and it 
looks good in practice.

>> -@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 the face remappings from that buffer when
>> +determining the width (@pxref{Face Remapping}).
> 
> An alternative would be to provide a face to use.
> 
> In any case, using BUFFER only for face-remapping-alist is only a
> small part of what a buffer can do to a string: there's the major mode
> with its fontifications and whatnot.

Yeah, I'm not entirely happy with this BUFFER argument either. I don't 
think we need to worry about fontification in this case though, since 
you can pass in a fontified string.

Maybe this should take the face-remapping-alist directly? Or maybe we 
should pass in a window? The latter might be better for handling things 
like frame-specific font settings. (Although as Po Lu points out, 
frame-specific fonts are challenging to handle correctly here.)

>> +(defun visual-wrap--adjust-display-width (fcp n)
>> +  (when-let ((display (get-text-property 0 'display fcp))
>> +             ((eq (car-safe display) 'space))
> 
> Doesn't this only work with very simple 'display' specs?  The 'space'
> part could be in some place deep in the spec, not just the second
> symbol.

Yeah, though the FCP argument is always the prefix we constructed, so we 
know what the display-spec looks like if it's present. The extra checks 
are just my natural paranoia. I've added a comment here explaining though.

>>   (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'."
>> -  (let* ((fcp
>> -          ;; `fill-context-prefix' ignores prefixes that look like
>> -          ;; paragraph starts, in order to avoid inadvertently
>> -          ;; creating a new paragraph while filling, but here we're
>> -          ;; only dealing with single-line "paragraphs" and we don't
>> -          ;; actually modify the buffer, so this restriction doesn't
>> -          ;; make much sense (and is positively harmful in
>> -          ;; taskpaper-mode where paragraph-start matches everything).
>> -          (or (let ((paragraph-start regexp-unmatchable))
>> -                    (fill-context-prefix beg end))
>> -                  ;; Note: fill-context-prefix may return nil; See:
>> -                  ;; http://article.gmane.org/gmane.emacs.devel/156285
>> -              ""))
> 
> The comment above and the URL it included are deleted: is that because
> they are no longer relevant?  If not, maybe move them with the code,
> so that the information is not lost.

Correct, they're no longer relevant. I extracted the logic that we need 
out of 'fill-content-prefix' and into 'visual-wrap--content-prefix'. The 
former didn't behave quite the way we wanted (hence all the comments), 
and it made handling the display-spec parts of my patch even harder, so 
I just took the relevant logic out and made a function that does exactly 
what we want. I've added more detail to the commit message explaining 
the change.

[-- Attachment #2: misaligned.png --]
[-- Type: image/png, Size: 24816 bytes --]

[-- Attachment #3: 0001-Add-support-for-variable-width-text-in-visual-wrap-p.patch --]
[-- Type: text/plain, Size: 9981 bytes --]

From 120748358b6a717c740e8d4f139ce62a30be7606 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 16 Jun 2024 15:21:52 -0700
Subject: [PATCH 1/2] Add support for variable-width text in
 'visual-wrap-prefix-mode'

This uses a display spec to set the width correctly when indenting with
spaces.

* lisp/emacs-lisp/subr-x.el (string-pixel-width): New argument BUFFER.

* lisp/visual-wrap.el (visual-wrap--content-prefix)
(visual-wrap--adjust-display-width): New functions.
(visual-wrap--extra-indent): Rename from 'visual-wrap--prefix' and call
'visual-wrap--adjust-display-width'.
(visual-wrap-fill-context-prefix): Support display width.  Use
'visual-wrap--content-prefix' instead of 'fill-content-prefix', which
lets us remove the old workarounds.
(visual-wrap-prefix-function): Allow 'lbp' to be at 'point-min'.
(visual-wrap-prefix-mode): Refontify when changing text scale.

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

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

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index d5c96d13e02..52957f2ad07 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -2351,9 +2351,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 the face remappings from that buffer when
+determining the width (@pxref{Face Remapping}).
 @end defun
 
 @defun line-pixel-height
diff --git a/etc/NEWS b/etc/NEWS
index b2fdbc4a88f..27a4fd11a87 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -549,7 +549,8 @@ text in any way.  The global minor mode
 buffers.
 
 (This minor mode is the 'adaptive-wrap' ELPA package renamed and
-lightly edited for inclusion in Emacs.)
+enhanced for inclusion in Emacs.  It additionally supports prefixes for
+variable-width text.)
 
 +++
 ** New user option 'gud-highlight-current-line'.
@@ -2789,6 +2790,11 @@ These functions are like 'user-uid' and 'group-gid', respectively, but
 are aware of file name handlers, so they will return the remote UID or
 GID for remote files (or -1 if the connection has no associated user).
 
++++
+** 'string-pixel-width' now accepts a BUFFER argument.
+If BUFFER is non-nil, 'string-pixel-width' will apply BUFFER's face
+remappings when computing the string's width.
+
 +++
 ** 'fset', 'defalias' and 'defvaralias' now signal an error for cyclic aliases.
 Previously, 'fset', 'defalias' and 'defvaralias' could be made to
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 699be767ee7..2cbe1beb9f1 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -333,8 +333,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
@@ -348,6 +350,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..886219cff54 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -97,38 +97,73 @@ visual-wrap--prefix-face
                                  (if (visual-wrap--face-extend-p f) f))
                                eol-face)))))))
 
-(defun visual-wrap--prefix (fcp)
+(defun visual-wrap--content-prefix (position)
+  "Get the content prefix for the line starting at POSITION.
+This is like `fill-content-prefix' but doesn't check subsequent lines
+and uses display specs to handle variable-pitch faces."
+  (save-excursion
+    (goto-char position)
+    (if (eolp) (forward-line 1))
+    ;; Move to the second line unless there is just one.
+    (move-to-left-margin)
+    (let ((prefix (fill-match-adaptive-prefix)))
+      ;; Check whether we should use our first-line content prefix.
+      (if (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)))
+	  prefix
+        ;; We want the prefix to be whitespace of the same width as the
+        ;; first-line prefix.
+        (let ((spaces (make-string (string-width prefix) ?\s)))
+          ;; If the font for our first-line prefix is variable-pitch,
+          ;; use a display spec to line the subsequent lines up
+          ;; correctly.
+          (when-let ((font (font-at position))
+                     ((memq (font-get font :spacing) '(nil 0))))
+            (put-text-property 0 (length spaces) 'display
+                               `(space :width (,(string-pixel-width
+                                                 prefix (current-buffer))))
+                               spaces))
+          spaces)))))
+
+(defun visual-wrap--adjust-display-width (fcp n)
+  (when-let ((display (get-text-property 0 'display fcp))
+             ;; If we have a display spec here, it should be what we
+             ;; specified in `visual-wrap--content-prefix', but
+             ;; double-check just to be safe.
+             ((eq (car-safe display) 'space))
+             (width (car (plist-get (cdr display) :width))))
+    (put-text-property 0 (length fcp) 'display
+                       `(space :width (,(+ width n))) fcp))
+  fcp)
+
+(defun visual-wrap--extra-indent (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)))
+      (let* ((extra (make-string visual-wrap-extra-indent ?\s))
+             (result (concat fcp extra)))
+        (visual-wrap--adjust-display-width
+         result (string-pixel-width extra (current-buffer)))))
      ((< 0 (+ visual-wrap-extra-indent fcp-len))
-      (substring fcp
-                 0
-                 (+ visual-wrap-extra-indent fcp-len)))
+      (let* ((idx (+ visual-wrap-extra-indent fcp-len))
+             (trim (substring fcp idx))
+             (result (substring fcp 0 idx)))
+        (remove-text-properties 0 (length trim) '(display) trim)
+        (visual-wrap--adjust-display-width
+         result (- (string-pixel-width trim (current-buffer))))))
      (t
       ""))))
 
 (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'."
-  (let* ((fcp
-          ;; `fill-context-prefix' ignores prefixes that look like
-          ;; paragraph starts, in order to avoid inadvertently
-          ;; creating a new paragraph while filling, but here we're
-          ;; only dealing with single-line "paragraphs" and we don't
-          ;; actually modify the buffer, so this restriction doesn't
-          ;; make much sense (and is positively harmful in
-          ;; taskpaper-mode where paragraph-start matches everything).
-          (or (let ((paragraph-start regexp-unmatchable))
-                    (fill-context-prefix beg end))
-                  ;; Note: fill-context-prefix may return nil; See:
-                  ;; http://article.gmane.org/gmane.emacs.devel/156285
-              ""))
-         (prefix (visual-wrap--prefix fcp))
+This is like `fill-context-prefix', but supporting variable-width faces
+and with the prefix length adjusted by `visual-wrap-extra-indent'."
+  (let* ((fcp (visual-wrap--content-prefix beg))
+         (prefix (visual-wrap--extra-indent fcp))
          (face (visual-wrap--prefix-face fcp beg end)))
     (if face
         (propertize prefix 'face face)
@@ -160,7 +195,8 @@ visual-wrap-prefix-function
 	 (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)))
+           (when (and dp (> lbp (point-min))
+                      (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
@@ -187,8 +223,12 @@ visual-wrap-prefix-mode
         ;; of the hook (bug#15155).
         (add-hook 'jit-lock-functions
                   #'visual-wrap-prefix-function 'append t)
-        (jit-lock-register #'visual-wrap-prefix-function))
+        (jit-lock-register #'visual-wrap-prefix-function)
+        ;; FIXME: What should we do about `global-text-scale-adjust' or
+        ;; other things that can change the text size?
+        (add-hook 'text-scale-mode-hook #'jit-lock-refontify nil t))
     (jit-lock-unregister #'visual-wrap-prefix-function)
+    (remove-hook 'text-scale-mode-hook #'jit-lock-refontify)
     (with-silent-modifications
       (save-restriction
         (widen)
-- 
2.25.1