Subject: bug#77042: 31.0.50; `string-pixel-width' could return wrong results with alternative properties

From: David Ponce <[email-masked]>
Date: Sun, 16 Mar 2025 11:31:21 +0100

On 2025-03-16 08:31, Eli Zaretskii wrote:
>> Date: Sat, 15 Mar 2025 23:43:33 +0100
>> From:  David Ponce via "Bug reports for GNU Emacs,
>>   the Swiss army knife of text editors" <[email-masked]>
>>
>> (let ((text0 (propertize "This text" 'face 'variable-pitch))
>>         (text1 (propertize "This text" 'my-face 'variable-pitch)))
>>     (with-temp-buffer
>>       (setq-local char-property-alias-alist '((face my-face)))
>>       (list
>>        (string-pixel-width text0 (current-buffer))
>>        (string-pixel-width text1 (current-buffer)))))
>>
>> Normally the result should be a list of two identical numbers.  But,
>> on my config, the result is (89 117) instead of expected (89 89).
>>
>> This problem is similar to the already solved case with
>> `face-remapping-alist', as is the solution.
>>                           
>> I propose the attached patch to fix this and slightly simplify the
>> code.  On my configuration, the new code has no significant impact on
>> performance.
> 
> Thanks, please see some comments below.
> 
>> +      ;; Setup current buffer to correctly compute pixel width.
>> +      (when buffer
>> +        (if (local-variable-p 'face-remapping-alist buffer)
>> +            (setq-local face-remapping-alist
>> +                        (buffer-local-value 'face-remapping-alist
>> +                                            buffer)))
>> +        (if (local-variable-p 'char-property-alias-alist buffer)
>> +            (setq-local char-property-alias-alist
>> +                        (buffer-local-value 'char-property-alias-alist
>> +                                            buffer))))
> 
> What about default-text-properties? shouldn't it get the same
> treatment?

Yes, you are right.  I updated the patch to include this case and a
new test.

2025-03-16  David Ponce  <[email-masked]>

	Fix possible wrong result of `string-pixel-width' with alternate
	and default properties.  Create 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.

	* test/lisp/misc-tests.el: Add tests for `string-pixel-width'.

> 
>> -      (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)
>> +      (add-text-properties (point-min) (point-max)
>> +                           '( display-line-numbers-disable t
>> +                              line-prefix "" wrap-prefix ""))
> 
> What is the rationale for this hunk?  Was there any problem with the
> original code?

No problem.  But the new code is simpler and should be more efficient.
To disable `display-line-numbers', `line-prefix' and `wrap-prefix', an
unique call to `add-text-properties' can achieve the same result as
the previous implementation which called `add-text properties', then
`remove-text-properties', then `setq' twice.

> 
> In any case, please don't leave a space after an opening parenthesis.

Sorry, I thought it was correct to add a space after the opening
parenthesis to correctly indent a lisp data expression.  I rewrote the
expression to avoid this.

Regarding the proposed tests, I noticed that those involving faces
always pass when run in batch, but work as expected interactively.
Probably because face attributes don't make sense in batch mode?

I mentioned this point in a comment before such tests, because I don't
know if it is possible to limit them to be run interactively.

Thank you for your review and help!
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 4ce7bd00f31..6414ecab394 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -389,8 +389,8 @@ with-work-buffer
 ;;;###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 @@ string-pixel-width
     ;; 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 @@ string-pixel-width
       ;; (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
diff --git a/test/lisp/misc-tests.el b/test/lisp/misc-tests.el
index 29bf2f02d0c..5b1343148af 100644
--- a/test/lisp/misc-tests.el
+++ b/test/lisp/misc-tests.el
@@ -178,6 +178,70 @@ misc--duplicate-dwim
             (should (equal (point) (+ 14 vdelta hdelta)))
             (should (equal (mark) (+ 2 hdelta)))))))))
 
+;; Check that `string-pixel-width' returns a consistent result in the
+;; various situations that can lead to erroneous results.
+(ert-deftest misc-test-string-pixel-width-char-property-alias-alist ()
+  "Test `string-pixel-width' with `char-property-alias-alist'."
+  (with-temp-buffer
+    (let ((text0 (propertize "This text"
+                             'display "xxxx"
+                             'face 'variable-pitch))
+          (text1 (propertize "This text"
+                             'my-display "xxxx"
+                             'my-face 'variable-pitch)))
+      (setq-local char-property-alias-alist '((display my-display)
+                                              (face my-face)))
+      (should (= (string-pixel-width text0 (current-buffer))
+                 (string-pixel-width text1 (current-buffer)))))))
+
+;; This test never fails in batch mode.
+(ert-deftest misc-test-string-pixel-width-face-remapping-alist ()
+  "Test `string-pixel-width' with `face-remapping-alist'."
+  (with-temp-buffer
+    (setq-local face-remapping-alist '((variable-pitch . default)))
+    (let ((text0 (propertize "This text" 'face 'default))
+          (text1 (propertize "This text" 'face 'variable-pitch)))
+      (should (= (string-pixel-width text0 (current-buffer))
+                 (string-pixel-width text1 (current-buffer)))))))
+
+(ert-deftest misc-test-string-pixel-width-default-text-properties ()
+  "Test `string-pixel-width' with `default-text-properties'."
+  (with-temp-buffer
+    (setq-local default-text-properties '(display "XXXX"))
+    (let ((text0 (propertize "This text" 'display "XXXX"))
+          (text1 "This text"))
+      (should (= (string-pixel-width text0 (current-buffer))
+                 (string-pixel-width text1 (current-buffer)))))))
+
+(ert-deftest misc-test-string-pixel-width-line-and-wrap-prefix ()
+  "Test `string-pixel-width' with `line-prefix' and `wrap-prefix'."
+  (let ((lp (default-value 'line-prefix))
+        (wp (default-value 'line-prefix))
+        (text (make-string 2000 ?X))
+        w0 w1)
+    (unwind-protect
+        (progn
+          (setq-default line-prefix nil wrap-prefix nil)
+          (setq w0 (string-pixel-width text))
+          (setq-default line-prefix "PPPP" wrap-prefix "WWWW")
+          (setq w1 (string-pixel-width text)))
+      (setq-default line-prefix lp wrap-prefix wp))
+    (should (= w0 w1))))
+
+;; This test never fails in batch mode.
+(ert-deftest misc-test-string-pixel-width-display-line-numbers ()
+  "Test `string-pixel-width' with `display-line-numbers'."
+  (let ((dln (default-value 'display-line-numbers))
+        (text "This text")
+        w0 w1)
+    (unwind-protect
+        (progn
+          (setq-default display-line-numbers nil)
+          (setq w0 (string-pixel-width text))
+          (setq-default display-line-numbers t)
+          (setq w1 (string-pixel-width text)))
+      (setq-default display-line-numbers dln))
+    (should (= w0 w1))))
 
 (provide 'misc-tests)
 ;;; misc-tests.el ends here