1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Fix `string-pixel-width' with alternate text properties

Fix possible wrong result of `string-pixel-width' with alternate
and default properties.  Create new regression tests.
* lisp/emacs-lisp/subr-x.el (string-pixel-width): Like for
`face-remapping-alist', use in work buffer the value of
`char-property-alias-alist' and `default-text-properties'
local to the passed buffer, to correctly compute pixel width.
(Bug#77042)

* test/lisp/misc-tests.el: Add tests for `string-pixel-width'.
This commit is contained in:
David Ponce 2025-03-16 11:31:21 +01:00 committed by Eli Zaretskii
parent cace07f27d
commit b1db48c0fc
2 changed files with 76 additions and 13 deletions

View file

@ -389,8 +389,8 @@ buffer when possible, instead of creating a new one on each call."
;;;###autoload
(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.
If BUFFER is non-nil, use the face remappings, alternative and default
properties from that buffer when determining the width.
If you call this function to measure pixel width of a string
with embedded newlines, it returns the width of the widest
substring that does not include newlines."
@ -400,11 +400,14 @@ substring that does not include newlines."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-work-buffer
(if buffer
(setq-local face-remapping-alist
(with-current-buffer buffer
face-remapping-alist))
(kill-local-variable 'face-remapping-alist))
;; Setup current buffer to correctly compute pixel width.
(when buffer
(dolist (v '(face-remapping-alist
char-property-alias-alist
default-text-properties))
(if (local-variable-p v buffer)
(set (make-local-variable v)
(buffer-local-value v buffer)))))
;; Avoid deactivating the region as side effect.
(let (deactivate-mark)
(insert string))
@ -413,12 +416,8 @@ substring that does not include newlines."
;; (bug#59311). Disable `line-prefix' and `wrap-prefix',
;; for the same reason.
(add-text-properties
(point-min) (point-max) '(display-line-numbers-disable t))
;; Prefer `remove-text-properties' to `propertize' to avoid
;; creating a new string on each call.
(remove-text-properties
(point-min) (point-max) '(line-prefix nil wrap-prefix nil))
(setq line-prefix nil wrap-prefix nil)
(point-min) (point-max)
'(display-line-numbers-disable t line-prefix "" wrap-prefix ""))
(car (buffer-text-pixel-size nil nil t)))))
;;;###autoload