From: Juri Linkov <juri@linkov.net>
Date: Fri, 13 Aug 2021 07:10:29 +0000 (+0300)
Subject: Add save-some-buffers-root to save-some-buffers-default-predicate (bug#46374)
X-Git-Tag: emacs-28.0.90~1529
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a9ad3d477441feefa3bf6107d58281cb64e0e78a;p=emacs.git

Add save-some-buffers-root to save-some-buffers-default-predicate (bug#46374)

* lisp/files.el (save-some-buffers-default-predicate): Add choice
'save-some-buffers-root'.
(save-some-buffers-root): New predicate function.
(save-some-buffers): Check if 'pred' returns a lexically-bound lambda,
then use it as 'pred'.

Thanks to Tino Calancha <tino.calancha@gmail.com>
---

diff --git a/etc/NEWS b/etc/NEWS
index ffe8f5b32cb..26ede715231 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -354,6 +354,11 @@ by dragging the tab lines of their topmost windows with the mouse.
 
 * Editing Changes in Emacs 28.1
 
+** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'.
+It allows to ask about saving only files under the project root
+or in subdirectories of the directory that was default during
+command invocation.
+
 ---
 ** Dragging a file to Emacs will now also push the name of the file
 onto 'file-name-history'.
diff --git a/lisp/files.el b/lisp/files.el
index 6a6d5409fa2..775d871dd7a 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5727,9 +5727,23 @@ be saved."
   :group 'auto-save
   ;; FIXME nil should not be a valid option, let alone the default,
   ;; eg so that add-function can be used.
-  :type '(choice (const :tag "Default" nil) function)
+  :type '(choice (const :tag "Default" nil)
+                 (function :tag "Only in subdirs of root"
+                           save-some-buffers-root)
+                 (function :tag "Custom function"))
   :version "26.1")
 
+(defun save-some-buffers-root ()
+  "A predicate to check whether the buffer is under the root directory.
+Can be used as a value of `save-some-buffers-default-predicate'
+to save buffers only under the project root or in subdirectories
+of the directory that was default during command invocation."
+  (let ((root (or (and (featurep 'project) (project-current)
+                       (fboundp 'project-root)
+                       (project-root (project-current)))
+                  default-directory)))
+    (lambda () (file-in-directory-p default-directory root))))
+
 (defun save-some-buffers (&optional arg pred)
   "Save some modified file-visiting buffers.  Asks user about each one.
 You can answer `y' or SPC to save, `n' or DEL not to save, `C-r'
@@ -5758,6 +5772,11 @@ change the additional actions you can take on files."
   (interactive "P")
   (unless pred
     (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)))
   (let* ((switched-buffer nil)
          (save-some-buffers--switch-window-callback
           (lambda (buffer)