From: Juri Linkov <juri@linkov.net>
Date: Sun, 10 Oct 2021 17:38:12 +0000 (+0300)
Subject: Add symbol property 'save-some-buffers-function' (bug#46374)
X-Git-Tag: emacs-28.0.90~332
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=575e626105b506b008eb9b0a03bb27aeecee54d4;p=emacs.git

Add symbol property 'save-some-buffers-function' (bug#46374)

* lisp/files.el (save-some-buffers-root): Put non-nil
symbol property 'save-some-buffers-function'.
(save-some-buffers): Check pred for the
symbol property 'save-some-buffers-function'.
(save-some-buffers-default-predicate): Mention
symbol property 'save-some-buffers-function'.
---

diff --git a/lisp/files.el b/lisp/files.el
index 64c69e685c8..7f9e9f5bbcb 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5745,7 +5745,9 @@ This allows you to stop `save-some-buffers' from asking
 about certain files that you'd usually rather not save.
 
 This function is called (with no parameters) from the buffer to
-be saved."
+be saved.  When the function's symbol has the property
+`save-some-buffers-function', the higher-order function is supposed
+to return a predicate used to check buffers."
   :group 'auto-save
   ;; FIXME nil should not be a valid option, let alone the default,
   ;; eg so that add-function can be used.
@@ -5765,6 +5767,7 @@ of the directory that was default during command invocation."
                        (project-root (project-current)))
                   default-directory)))
     (lambda () (file-in-directory-p default-directory root))))
+(put 'save-some-buffers-root 'save-some-buffers-function t)
 
 (defun save-some-buffers (&optional arg pred)
   "Save some modified file-visiting buffers.  Asks user about each one.
@@ -5796,9 +5799,10 @@ change the additional actions you can take on files."
     (setq pred save-some-buffers-default-predicate))
   ;; Allow `pred' to be a function that returns a predicate
   ;; with lexical bindings in its original environment (bug#46374).
-  (let ((pred-fun (and (functionp pred) (funcall pred))))
-    (when (functionp pred-fun)
-      (setq pred pred-fun)))
+  (when (and (symbolp pred) (get pred 'save-some-buffers-function))
+    (let ((pred-fun (and (functionp pred) (funcall pred))))
+      (when (functionp pred-fun)
+        (setq pred pred-fun))))
   (let* ((switched-buffer nil)
          (save-some-buffers--switch-window-callback
           (lambda (buffer)