From: David Ponce <da_vid@orange.fr>
Date: Thu, 22 Aug 2024 14:56:11 +0000 (+0200)
Subject: New macro `with-work-buffer'.
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e005637c815db584b3d557c7577aba25e016c619;p=emacs.git

New macro `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.  (Bug#72689)

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

(cherry picked from commit b930a698f2ba4e8b5878a4b604098e1201796b7f)
---

diff --git a/etc/NEWS b/etc/NEWS
index de0ec192ba4..23608073270 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -275,6 +275,13 @@ 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',
+except that it does not allocate a new temporary buffer on each call,
+but tries to reuse those previously allocated (up to a number defined by
+the new 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 @@ This construct can only be used with lexical binding."
       (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.