From 696a271601457f63dd7127261242e21432713402 Mon Sep 17 00:00:00 2001 From: Jim Porter 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