all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#71605: 30.0.50; [PATCH] Support variable-width text in 'visual-wrap-prefix-mode'
@ 2024-06-17  2:56 Jim Porter
  2024-06-17 11:37 ` Eli Zaretskii
  2024-06-17 14:23 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
  0 siblings, 2 replies; 24+ messages in thread
From: Jim Porter @ 2024-06-17  2:56 UTC (permalink / raw)
  To: 71605

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

(Note: I plan to merge this only after we cut the Emacs 30 release 
branch, since it seems a bit too substantial a change to sneak in right 
near the end. However, I think the patch is mostly done aside from one 
remaining issue, so any feedback is very welcome.)

'visual-wrap-prefix-mode' has one small issue: since the wrap prefix is 
just a string, the wrapped text may not line up for variable-width 
fonts. This is mainly in cases like so:

   * here is some text that
     got visually wrapped

If the "* " is variable-width, the second line will probably be indented 
wrong by a few pixels.

The attached patch adds a display spec in this case so that the text 
lines up perfectly. 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?

[1] There's 'after-setting-font-hook', but that doesn't cover everything 
either.

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

From 696a271601457f63dd7127261242e21432713402 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sun, 16 Jun 2024 15:21:52 -0700
Subject: [PATCH] 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--adjust-display-width)
(visual-wrap--content-prefix): 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.
(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       | 73 +++++++++++++++++++++++++++------------
 4 files changed, 70 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..241cd337148 100644
--- a/lisp/visual-wrap.el
+++ b/lisp/visual-wrap.el
@@ -97,38 +97,60 @@ visual-wrap--prefix-face
                                  (if (visual-wrap--face-extend-p f) f))
                                eol-face)))))))
 
-(defun visual-wrap--prefix (fcp)
+(defun visual-wrap--adjust-display-width (fcp n)
+  (when-let ((display (get-text-property 0 'display fcp))
+             ((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--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-width 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)))
+      (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
+        (propertize
+         (make-string (string-width prefix) ?\s)
+         'display `(space :width (,(string-pixel-width
+                                    prefix (current-buffer)))))))))
+
 (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 +182,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 +210,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


^ permalink raw reply related	[flat|nested] 24+ messages in thread

end of thread, other threads:[~2024-06-20 19:01 UTC | newest]

Thread overview: 24+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-06-17  2:56 bug#71605: 30.0.50; [PATCH] Support variable-width text in 'visual-wrap-prefix-mode' Jim Porter
2024-06-17 11:37 ` Eli Zaretskii
2024-06-17 17:42   ` Jim Porter
2024-06-17 18:20     ` Eli Zaretskii
2024-06-17 18:44       ` Jim Porter
2024-06-18 11:37         ` Eli Zaretskii
2024-06-18 22:17           ` Jim Porter
2024-06-19 11:45             ` Eli Zaretskii
2024-06-19 19:53               ` Jim Porter
2024-06-20  4:58                 ` Eli Zaretskii
2024-06-20  5:37                   ` Jim Porter
2024-06-20  9:58                     ` Eli Zaretskii
2024-06-20 17:36                       ` Jim Porter
2024-06-20 18:08                         ` Eli Zaretskii
2024-06-20 19:01                           ` Jim Porter
2024-06-17 14:23 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-06-17 16:13   ` Jim Porter
2024-06-17 18:17     ` Jim Porter
2024-06-17 19:55       ` Eli Zaretskii
2024-06-17 20:08         ` Jim Porter
2024-06-18  3:02           ` Jim Porter
2024-06-18  6:27             ` Jim Porter
2024-06-18 12:53               ` Eli Zaretskii
2024-06-18 12:39           ` Eli Zaretskii

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.