From: Tino Calancha <tino.calancha@gmail.com>
To: Juri Linkov <juri@linkov.net>
Cc: 46374@debbugs.gnu.org,
"stefan monnier" <monnier@iro.umontreal.ca>,
"Quách Mỹ Uyên Nhi" <uyennhi.qm@gmail.com>
Subject: 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 [thread overview]
Message-ID: <87mtv6yloe.fsf@gmail.com> (raw)
In-Reply-To: <87r1kpemnr.fsf@mail.linkov.net> (Juri Linkov's message of "Mon, 08 Mar 2021 19:28:00 +0200")
Juri Linkov <juri@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---
next prev parent reply other threads:[~2021-03-14 12:17 UTC|newest]
Thread overview: 44+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-02-07 22:32 bug#46374: 28.0.50; Ask me to save buffers only if they are under callers dir Tino Calancha
2021-02-08 15:07 ` Eli Zaretskii
2021-02-08 15:47 ` Stefan Monnier
2021-02-09 17:50 ` Juri Linkov
2021-03-07 20:34 ` Tino Calancha
2021-03-07 21:08 ` Juri Linkov
[not found] ` <1952f2d9-51b6-a4ba-6c9e-98594222f017@gmail.com>
2021-03-08 17:28 ` Juri Linkov
2021-03-14 12:17 ` Tino Calancha [this message]
2021-03-15 17:10 ` Juri Linkov
2021-03-16 17:49 ` Juri Linkov
2021-03-16 22:54 ` Stefan Monnier
2021-03-16 23:37 ` bug#46374: [External] : " Drew Adams
2021-03-17 17:12 ` Juri Linkov
2021-03-17 17:10 ` Juri Linkov
2021-03-21 17:59 ` Tino Calancha
2021-03-21 20:10 ` Juri Linkov
2021-04-18 14:27 ` Tino Calancha
2021-04-24 22:13 ` Juri Linkov
2021-04-28 19:31 ` Tino Calancha
2021-04-28 19:51 ` Juri Linkov
2021-04-28 20:35 ` Tino Calancha
2021-04-29 9:17 ` Eli Zaretskii
2021-05-18 17:46 ` Tino Calancha
2021-04-29 16:04 ` Juri Linkov
[not found] ` <82abe5b9-7d42-b05d-26a5-fd63e1f59e3a@gmail.com>
2021-08-13 7:11 ` Juri Linkov
[not found] ` <3c7dc42a-e484-8068-d28d-49677f0b4a7@gmail.com>
2021-08-13 16:08 ` Juri Linkov
2021-04-29 9:16 ` Eli Zaretskii
2021-05-18 18:04 ` Tino Calancha
2021-05-18 18:23 ` Eli Zaretskii
2021-05-18 18:47 ` Tino Calancha
2021-08-28 16:25 ` bug#46374: Regression: erronous calls to PRED switch major-mode of unrelated modified buffers Hauke Rehfeld
2021-08-29 16:38 ` Juri Linkov
2021-08-30 7:28 ` Juri Linkov
2021-08-30 11:43 ` Hauke Rehfeld
2021-08-30 16:04 ` Hauke Rehfeld
2021-08-31 7:02 ` Juri Linkov
2021-09-05 10:09 ` bug#46374: 28.0.50; Ask me to save buffers only if they are under callers dir Tino Calancha
2021-09-05 16:21 ` Juri Linkov
2021-10-10 17:38 ` Juri Linkov
[not found] ` <jwv5yqwrgru.fsf-monnier+emacs@gnu.org>
2022-01-06 19:09 ` bug#46374: Regression: erronous calls to PRED switch major-mode of unrelated modified buffers Juri Linkov
2022-01-06 20:17 ` Eli Zaretskii
2022-01-06 20:28 ` Juri Linkov
2022-01-07 14:45 ` Eli Zaretskii
2022-01-10 3:18 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87mtv6yloe.fsf@gmail.com \
--to=tino.calancha@gmail.com \
--cc=46374@debbugs.gnu.org \
--cc=juri@linkov.net \
--cc=monnier@iro.umontreal.ca \
--cc=uyennhi.qm@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).