From 3f6b33b089bd93ca577a3843c3b4dca723bbe94a Mon Sep 17 00:00:00 2001 From: Jim Porter 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. (cherry picked from commit f70a6ea0ea86ef461e40d20664a75a92d02679ea) --- doc/lispref/display.texi | 6 +- etc/NEWS | 12 ++++ lisp/emacs-lisp/subr-x.el | 11 +++- lisp/visual-wrap.el | 113 ++++++++++++++++++++++++++------------ 4 files changed, 102 insertions(+), 40 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 0eb25be82a7..5b0bd2d97fe 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2385,9 +2385,11 @@ The optional arguments @var{x-limit} and @var{y-limit} have the same 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 a4bed835151..af8d7fee29d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -77,6 +77,12 @@ aggressively rather than switching to some other buffer in it. *** 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. + * Changes in Specialized Modes and Packages in Emacs 31.1 @@ -239,6 +245,12 @@ language A will be applied to language B instead. This is useful for reusing font-lock rules and indentation rules of language A for language B, when language B is a strict superset of language A. + ++++ +** 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. + * 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 @@ This construct can only be used with lexical binding." . ,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 @@ This construct can only be used with lexical binding." ;; 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..cac3bc767b8 100644 --- a/lisp/visual-wrap.el +++ b/lisp/visual-wrap.el @@ -97,24 +97,85 @@ extra indent = 2 (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) + (when-let ((first-line-prefix (fill-match-adaptive-prefix)) + (next-line-prefix (visual-wrap--content-prefix + first-line-prefix position))) + (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 +189,7 @@ by `visual-wrap-extra-indent'." ;; 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 +208,8 @@ by `visual-wrap-extra-indent'." (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.39.2