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

From: David Ponce <[email-masked]>
Date: Thu, 22 Aug 2024 16:56:11 +0200

On 22/08/2024 12:59 PM, Eli Zaretskii wrote:
>> Date: Thu, 22 Aug 2024 11:48:48 +0200
>> Cc: [email-masked]
>> From: David Ponce <[email-masked]>
>>
>>> Thanks, LGTM.
>>>
>>>> Should I prepare a patch of subr-x.el to include both the proposed
>>>> `work-buffer' API, and an implementation of `string-pixel-width' using
>>>> it?
>>>
>>> Yes, please.  And the macro itself needs a NEWS entry, I think.
>>
>> Thanks.  I will prepare a patch and a NEWS entry for the new
>> `with-work-buffer' macro ASAP.
>>
>> Could you please review this last version of the work-buffer API,
>> which introduce the variable `work-buffer-limit' to limit the number
>> of work buffers?
> 
> LGTM, thanks.

Thanks.  Please find attached 2 patches:

1. with-work-buffer.patch to introduce the new macro with-work-buffer.

2. string-pixel-width.patch to improve `string-pixel-width'.
2024-08-22  David Ponce  <[email-masked]>

	New macro `with-work-buffer'.

	* etc/NEWS: Announce 'with-work-buffer'.

	* lisp/emacs-lisp/subr-x.el (work-buffer--list)
	(work-buffer-limit): New variables.
	(work-buffer--get, work-buffer--release): New function.
	(with-work-buffer): New macro.

diff --git a/etc/NEWS b/etc/NEWS
index 8cd21f5fb74..d6440540b45 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -257,6 +257,14 @@ language A.
 If supplied, 'string-pixel-width' will use any face remappings from
 BUFFER when computing the string's width.
 
+---
+*** New macro 'with-work-buffer'.
+This macro is similar to the already existing macro `with-temp-buffer'.
+However, contrary to the latter, `with-work-buffer' does not allocate a
+new temporary buffer on each call, but try to reuse those previously
+allocated (up to a number defined by the variable `work-buffer-limit'
+which defaults to 10).
+
 +++
 ** 'date-to-time' now defaults to local time.
 The function now assumes local time instead of Universal Time when
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 058c06bc5f6..3347c802f68 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -336,6 +336,53 @@ named-let
       (cl-labels ((,name ,fargs . ,body)) #',name)
       . ,aargs)))
 
+(defvar work-buffer--list nil)
+(defvar work-buffer-limit 10
+  "Maximum number of reusable work buffers.
+When this limit is exceeded, newly allocated work buffers are
+automatically killed, which means that in a such case
+`with-work-buffer' becomes equivalent to `with-temp-buffer'.")
+
+(defsubst work-buffer--get ()
+  "Get a work buffer."
+  (let ((buffer (pop work-buffer--list)))
+    (if (buffer-live-p buffer)
+        buffer
+      (generate-new-buffer " *work*" t))))
+
+(defun work-buffer--release (buffer)
+  "Release work BUFFER."
+  (if (buffer-live-p buffer)
+      (with-current-buffer buffer
+        ;; Flush BUFFER before making it available again, i.e. clear
+        ;; its contents, remove all overlays and buffer-local
+        ;; variables.  Is it enough to safely reuse the buffer?
+        (erase-buffer)
+        (delete-all-overlays)
+        (let (change-major-mode-hook)
+          (kill-all-local-variables t))
+        ;; Make the buffer available again.
+        (push buffer work-buffer--list)))
+  ;; If the maximum number of reusable work buffers is exceeded, kill
+  ;; work buffer in excess, taking into account that the limit could
+  ;; have been let-bound to temporarily increase its value.
+  (when (> (length work-buffer--list) work-buffer-limit)
+    (mapc #'kill-buffer (nthcdr work-buffer-limit work-buffer--list))
+    (setq work-buffer--list (ntake work-buffer-limit work-buffer--list))))
+
+;;;###autoload
+(defmacro with-work-buffer (&rest body)
+  "Create a work buffer, and evaluate BODY there like `progn'.
+Like `with-temp-buffer', but reuse an already created temporary
+buffer when possible, instead of creating a new one on each call."
+  (declare (indent 0) (debug t))
+  (let ((work-buffer (make-symbol "work-buffer")))
+    `(let ((,work-buffer (work-buffer--get)))
+       (with-current-buffer ,work-buffer
+         (unwind-protect
+             (progn ,@body)
+           (work-buffer--release ,work-buffer))))))
+
 ;;;###autoload
 (defun string-pixel-width (string &optional buffer)
   "Return the width of STRING in pixels.
2024-08-22  David Ponce  <[email-masked]>

	Tweak the implementation of string-pixel-width to run faster and
	use less memory.  Also cater for the case where this function is
	called in parallel (bug#72689).

	* lisp/emacs-lisp/subr-x.el (string-pixel-width): Use
	`with-work-macro'.  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 3347c802f68..83528f5c5dd 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -393,20 +393,24 @@ 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)
+    (with-work-buffer
+      ;; 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))
-      (insert (propertize string 'line-prefix nil 'wrap-prefix nil))
+      (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)))))
 
 ;;;###autoload