bug#72689: 31.0.50; Proposal to improve string-pixel-width

[David Ponce via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 516 bytes --]

On 18/08/2024 11:15 AM, Eli Zaretskii wrote:
[...]> I think you understood the issue, and just creating a new buffer if
> the "normal" one is "taken" should be good enough.  I don't expect
> this situation to be a frequent one, so creating too many buffers
> should not be a danger.

Thanks!  Please, find attached a revised V01 patch that implements
your suggestion.  I finally opted to keep only one function,
because setting a few buffer-local variables on each call has not a
significant impact on performance.


[-- Attachment #2: improve-string-pixel-width-V01.patch --]
[-- Type: text/x-patch, Size: 3914 bytes --]

2024-08-19  David Ponce  <da_vid@orange.fr>

	Tweak the implementation of string-pixel-width to run faster and
	use less memory.  Also cater for the case where more than one
	execution thread calls the function (bug#72689).

	* subr-x.el (string--pixel-width-buffer): New variable.
	(string--pixel-width): Use it.  Create a new working buffer when
	parallel run is detected.  Prefer `remove-text-properties' to
	`propertize' to avoid creating a new string on each call.

diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 058c06bc5f6..b688d179da4 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -336,6 +336,8 @@ named-let
       (cl-labels ((,name ,fargs . ,body)) #',name)
       . ,aargs)))
 
+(defvar string--pixel-width-buffer nil)
+
 ;;;###autoload
 (defun string-pixel-width (string &optional buffer)
   "Return the width of STRING in pixels.
@@ -346,21 +348,45 @@ string-pixel-width
       0
     ;; Keeping a work buffer around is more efficient than creating a
     ;; new temporary buffer.
-    (with-current-buffer (get-buffer-create " *string-pixel-width*")
-      ;; If `display-line-numbers' is enabled in internal buffers
-      ;; (e.g. globally), it breaks width calculation (bug#59311)
-      (setq-local display-line-numbers nil)
-      (delete-region (point-min) (point-max))
-      ;; 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)))))
+    (with-current-buffer
+        (or (if (buffer-live-p string--pixel-width-buffer)
+                ;; Check if work buffer is not used by
+                ;; another parallel run (bug#72689).  That
+                ;; is, if `string--pixel-width-buffer' has no
+                ;; buffer-local value, in which case the function
+                ;; `buffer-local-value' returns its global value,
+                ;; equal to the work buffer.  Otherwise, when the
+                ;; work buffer is "busy", the buffer-local value of
+                ;; `string--pixel-width-buffer' is nil.
+                (buffer-local-value 'string--pixel-width-buffer
+                                    string--pixel-width-buffer))
+            ;; Create a new work buffer if current is "busy".
+            (setq string--pixel-width-buffer
+                  (generate-new-buffer " *string-pixel-width*" t)))
+      ;; Mark buffer as "busy".
+      (setq-local string--pixel-width-buffer nil)
+      (unwind-protect
+          (progn
+            ;; If `display-line-numbers' is enabled in internal
+            ;; buffers (e.g. globally), it breaks width calculation
+            ;; (bug#59311).  Disable `line-prefix' and `wrap-prefix',
+            ;; for the same reason.
+            (setq display-line-numbers nil
+                  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))
+            (erase-buffer)
+            (insert string)
+            ;; 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))
+            (car (buffer-text-pixel-size nil nil t)))
+        ;; Mark buffer as free to use.
+        (kill-local-variable 'string--pixel-width-buffer)))))
 
 ;;;###autoload
 (defun string-glyph-split (string)