master b930a698f2b 1/2: New macro `with-work-buffer'.

[Eli Zaretskii]

branch: master
commit b930a698f2ba4e8b5878a4b604098e1201796b7f
Author: David Ponce <da_vid@orange.fr>
Commit: Eli Zaretskii <eliz@gnu.org>

    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'.
---
 etc/NEWS                  |  7 +++++++
 lisp/emacs-lisp/subr-x.el | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+)

diff --git a/etc/NEWS b/etc/NEWS
index faf9a963d39..dc70eb25de7 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -321,6 +321,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.