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

From: [email-masked] (GNU bug Tracking System)
Date: Thu, 20 Mar 2025 12:59:02 +0000

Your bug report

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

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
77042: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=77042
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#77042: 31.0.50; `string-pixel-width' could return wrong results with alternative properties
From: Eli Zaretskii <[email-masked]>
To: David Ponce <[email-masked]>
Cc: [email-masked]
Date: Thu, 20 Mar 2025 14:57:51 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

> Date: Sun, 16 Mar 2025 11:31:21 +0100
> Cc: [email-masked]
> From: David Ponce <[email-masked]>
> 
> Thank you for your review and help!

Thanks, I installed the patch on the master branch, and I'm therefore
closing this bug.

Subject: 31.0.50; `string-pixel-width' could return wrong results with alternative properties
From: David Ponce <[email-masked]>
To: [email-masked]
Date: Sat, 15 Mar 2025 23:43:33 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Hello,

During some experiments to use `char-property-alias-alist', I
discovered that `string-pixel-width' could return wrong results with
alternative properties that affect how the string is displayed.

Here is a simple recipe to eval in the *scratch* buffer, that
illustrates the issue:

(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.

The patch also includes several tests of `string-pixel-width' that
could be added to test/lisp/misc-test.el.  As expected with the
current implementation, all tests pass but the test
`misc-test-string-pixel-width-char-property-alias-alist'.  With the
patch applied, all tests pass:

-----------------------
emacs -batch -l ./test/lisp/misc-tests.el -f ert-run-tests-batch-and-exit

    [...]
    passed   6/11  misc-test-string-pixel-width-char-property-alias-alist (0.001030 sec)
    passed   7/11  misc-test-string-pixel-width-display-line-numbers (0.000057 sec)
    passed   8/11  misc-test-string-pixel-width-face-remapping-alist (0.000065 sec)
    passed   9/11  misc-test-string-pixel-width-line-and-wrap-prefix (0.000240 sec)
    [...]
-----------------------

Here is a possible Change log:

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

	Fix possible wrong result of `string-pixel-width' with alternate
	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' local to the passed buffer, to
	correctly compute pixel width.

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

Thanks
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 4ce7bd00f31..fc9e008102c 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 and alternative
+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,16 @@ 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
+        (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))))
       ;; Avoid deactivating the region as side effect.
       (let (deactivate-mark)
         (insert string))
@@ -412,13 +417,9 @@ string-pixel-width
       ;; buffers (e.g. globally), it breaks width calculation
       ;; (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)
+      (add-text-properties (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..fb824c1a730 100644
--- a/test/lisp/misc-tests.el
+++ b/test/lisp/misc-tests.el
@@ -178,6 +178,57 @@ misc--duplicate-dwim
             (should (equal (point) (+ 14 vdelta hdelta)))
             (should (equal (mark) (+ 2 hdelta)))))))))
 
+(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)))))))
+
+(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-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))))
+
+(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