GNU bug report logs - #46374
28.0.50; Ask me to save buffers only if they are under callers dir

Previous Next

Full log

Message #26 received at 46374 <at> debbugs.gnu.org (full text, mbox):

From: Tino Calancha <tino.calancha <at> gmail.com>
To: Juri Linkov <juri <at> linkov.net>
Cc: 46374 <at> debbugs.gnu.org, stefan monnier <monnier <at> iro.umontreal.ca>,
 Quách Mỹ Uyên Nhi <uyennhi.qm <at> gmail.com>
Subject: Re: bug#46374: 28.0.50; Ask me to save buffers only if they are
 under callers dir
Date: Sun, 14 Mar 2021 13:17:05 +0100

Juri Linkov <juri <at> linkov.net> writes:

> This means reusing the existing save-some-buffers-default-predicate
> would be still preferable that guarantees backward-compatibility.
> When it's customized to a predicate to filter out non-current subdirs,
> then such call '(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))'
> still overrides the customized value.  This is the right thing to do.

OK, back to my original implementation (i.e., adding a new option
to `save-some-buffers-default-predicate`).

I have been playing with the followig patch this morning.
- it only adds a new option 'project-root
- in case there is not a root there, then `default-directory` is taken
  (this is a requirement from the OP, that ie me :-)
- this patch doesn't interfere with the 2nd argument of `save-some-buffers'.

Please, try it:

--8<-----------------------------cut here---------------start------------->8---
diff --git a/lisp/files.el b/lisp/files.el
index dada69c145..d890e5b7b7 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5517,7 +5517,9 @@ save-some-buffers-default-predicate
   :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)
+                 (const :tag "Project root" project-root)
+                 function)
   :version "26.1")
 
 (defun save-some-buffers (&optional arg pred)
@@ -5546,9 +5548,22 @@ save-some-buffers
 See `save-some-buffers-action-alist' if you want to
 change the additional actions you can take on files."
   (interactive "P")
-  (unless pred
-    (setq pred save-some-buffers-default-predicate))
-  (let* ((switched-buffer nil)
+  (let* ((project-dir (or (and (project-current) (project-root (project-current)))
+                          default-directory))
+         (effective-pred
+          (or pred
+              (if (eq 'project-root save-some-buffers-default-predicate)
+                  (lambda () (file-in-directory-p default-directory project-dir))
+                save-some-buffers-default-predicate)))
+         (switched-buffer nil)
+         (non-visiting-buffers-ok (not (null pred)))
+         (buffer-name-matches-filename-p
+          (lambda (buffer)
+            "Return non-nil if BUFFER name is similar to its file name."
+            (let ((file-basename (file-name-nondirectory (buffer-file-name buffer))))
+              (or (equal (buffer-name buffer) file-basename)
+                  (string-match-p (format "\\<%s<[^>]*>\\'" (regexp-quote file-basename))
+                                  (buffer-name buffer))))))
          (save-some-buffers--switch-window-callback
           (lambda (buffer)
             (setq switched-buffer buffer)))
@@ -5578,36 +5593,19 @@ save-some-buffers
                          (buffer-file-name buffer)
                          (with-current-buffer buffer
                            (or (eq buffer-offer-save 'always)
-                               (and pred buffer-offer-save
-                                    (> (buffer-size) 0)))))
-                        (or (not (functionp pred))
-                            (with-current-buffer buffer (funcall pred)))
+                               (and non-visiting-buffers-ok buffer-offer-save (> (buffer-size) 0)))))
+                        (or (not (functionp effective-pred))
+                            (with-current-buffer buffer (funcall effective-pred)))
                         (if arg
                             t
                           (setq queried t)
-                          (if (buffer-file-name buffer)
-                              (if (or
-                                   (equal (buffer-name buffer)
-                                          (file-name-nondirectory
-                                           (buffer-file-name buffer)))
-                                   (string-match
-                                    (concat "\\<"
-                                            (regexp-quote
-                                             (file-name-nondirectory
-                                              (buffer-file-name buffer)))
-                                            "<[^>]*>\\'")
-                                    (buffer-name buffer)))
-                                  ;; The buffer name is similar to the
-                                  ;; file name.
-                                  (format "Save file %s? "
-                                          (buffer-file-name buffer))
-                                ;; The buffer and file names are
-                                ;; dissimilar; display both.
-                                (format "Save file %s (buffer %s)? "
-                                        (buffer-file-name buffer)
-                                        (buffer-name buffer)))
-                            ;; No file name
-                            (format "Save buffer %s? " (buffer-name buffer))))))
+                          (cond ((null (buffer-file-name buffer))
+                                 (format "Save buffer %s? " (buffer-name buffer)))
+                                ((funcall buffer-name-matches-filename-p buffer)
+                                 (format "Save file %s? " (buffer-file-name buffer)))
+                                (t (format "Save file %s (buffer %s)? "
+                                           (buffer-file-name buffer)
+                                           (buffer-name buffer)))))))
                  (lambda (buffer)
                    (with-current-buffer buffer
                      (save-buffer)))

--8<-----------------------------cut here---------------end--------------->8---

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.