From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#46374: 28.0.50; Ask me to save buffers only if they are under callers dir Date: Sun, 07 Feb 2021 23:32:07 +0100 Message-ID: <878s7z4ihk.fsf@gmail.com> Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="16860"; mail-complaints-to="usenet@ciao.gmane.io" Cc: stefan monnier , uyennhi.qm@gmail.com To: 46374@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Feb 07 23:33:14 2021 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1l8scD-0004F2-FU for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 07 Feb 2021 23:33:13 +0100 Original-Received: from localhost ([::1]:42114 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1l8scC-0005rB-G9 for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 07 Feb 2021 17:33:12 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46268) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l8sc2-0005nB-Mz for bug-gnu-emacs@gnu.org; Sun, 07 Feb 2021 17:33:02 -0500 Original-Received: from debbugs.gnu.org ([209.51.188.43]:37615) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l8sc2-0007Da-FQ for bug-gnu-emacs@gnu.org; Sun, 07 Feb 2021 17:33:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1l8sc2-0001YF-1k; Sun, 07 Feb 2021 17:33:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: monnier@iro.umontreal.ca, uyennhi.qm@gmail.com, bug-gnu-emacs@gnu.org Resent-Date: Sun, 07 Feb 2021 22:33:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 46374 X-GNU-PR-Package: emacs X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: stefan monnier , Original-Received: via spool by submit@debbugs.gnu.org id=B.16127371475922 (code B ref -1); Sun, 07 Feb 2021 22:33:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 7 Feb 2021 22:32:27 +0000 Original-Received: from localhost ([127.0.0.1]:49159 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l8sbN-0001XM-Jf for submit@debbugs.gnu.org; Sun, 07 Feb 2021 17:32:27 -0500 Original-Received: from lists.gnu.org ([209.51.188.17]:34452) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1l8sbL-0001XF-UB for submit@debbugs.gnu.org; Sun, 07 Feb 2021 17:32:21 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:46106) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1l8sbK-00055R-7Z for bug-gnu-emacs@gnu.org; Sun, 07 Feb 2021 17:32:19 -0500 Original-Received: from mail-wr1-x42b.google.com ([2a00:1450:4864:20::42b]:40983) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1l8sbG-0006pY-1Y for bug-gnu-emacs@gnu.org; Sun, 07 Feb 2021 17:32:17 -0500 Original-Received: by mail-wr1-x42b.google.com with SMTP id n6so2234462wrv.8 for ; Sun, 07 Feb 2021 14:32:12 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:date:message-id:mime-version; bh=BdyVHx8BMSFEXYxfVA9K/+uIVBju6cgJ0GimU7Gu7+s=; b=OhbB3z54EQcUcYiMOVr6S1dlCb4n1Wg5l88kpdIMAHmQAn3Xu6deFam3WX/+3um+IC kfRbpEVB3+M7HFf/kI8rhDW4GYlY+4uM29q7alcq+CbFMfNks0Rn7AZ7kK3j//uUUy9z RSeSqAT4RjcvmJwdLMTp+AygWRGTxbqBaq4Bsv+6rvF9UefvFCjOcH6LKU7M7wjAJFGF COUZv9SUZi0hi8g0GF73IO83qxwOwC2IZTkusQOI444u5eU6joTnpnQIQ9OjHxT1/Hb5 O4vs5WQn9Us0Mxg1JK9YxEP3iHA5JHrp59aGyNcth24XkXY+6xRt69TGbPTJBLD88a0Q /pog== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=BdyVHx8BMSFEXYxfVA9K/+uIVBju6cgJ0GimU7Gu7+s=; b=C0Gtl/0Rsvj9vrcrsmqLp8cObtwz+MwIgj2+WM4uMuHJXZDxrcEHrR8YjdbQfdrhoC mi83KwkpunWHSEhywOjjGtQv5fQrPUmxlrCD9PIDhVRhutz7zFYel6VPSVLWKIULpWyZ wIFWG35C80IYLYAqigJz9fQ7zrVjO28BrAS2PzndXeW9bgWv0CmkMWgFqEZwBv7AN5jb s2Ny+881F+/5xEamxN32GeK8R5Pt/c284/ZBZIviB4qUR0DviwXJx/eYvatOYauzLdJR zxRo9H0mhrEFUoodI7Lttf8dxdloyFfPYMIHHorNwYPz9Fmfp+d9q868aRE+WyX7HLN4 BGqw== X-Gm-Message-State: AOAM533ca9XK/a0MMYyVgN6Opl5YbSSr+G/lCTKcUavxDuWBCz+Mm3cd 7wCf0a2MNVUQC31t0yanxKDxy5ohB9I= X-Google-Smtp-Source: ABdhPJyEkXclcVsKpQqPzGfHX8sxqU44/hLZYqbQy/RaNbgY/2pRyZnC5ltPSPKi2Qpw6xJMQDVv5g== X-Received: by 2002:a05:6000:18a3:: with SMTP id b3mr16790532wri.373.1612737130063; Sun, 07 Feb 2021 14:32:10 -0800 (PST) Original-Received: from localhost.example.com ([31.7.242.222]) by smtp.gmail.com with ESMTPSA id b2sm4698777wrv.73.2021.02.07.14.32.08 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 07 Feb 2021 14:32:09 -0800 (PST) Received-SPF: pass client-ip=2a00:1450:4864:20::42b; envelope-from=tino.calancha@gmail.com; helo=mail-wr1-x42b.google.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:199583 Archived-At: X-Debbugs-Cc: Stefan Monnier , Severity: wishlist Severity: patch I wish, by default, to only been prompted for buffers whose default-directory is under the caller dir (except when closing Emacs). ## Description Everyday I connect via Tramp with machines at each of my properties (Hawaii, Maldives, Palawan, and a very large etc.) Then, in the same Emacs session, I connect to a host in Wall Street to see how my stock grows, making me richer. Often, a compilation buffer at New York city prompts me to save a buffer at Waikiki beach. Quite distracting! Cannot focus on my money! I found some people with related issues: https://emacs.stackexchange.com/questions/7268/package-el-asks-whether-i-want-to-save-modified-files-before-package-installatio https://emacs.stackexchange.com/questions/40593/automatically-dont-save-buffers-before-compiling ## How to reproduce Sure, I understand not all of you can possibly reproduce the above conditions. Maybe you can try the following poor man's recipe: emacs -Q ~/foo.txt ;; write something and do not save foo ;; now visit another, for instance, the Emacs source dir C-x d EMACS-SRC-DIR RET ;; call rgrep with whatever string M-x rgrep money RET *.el RET RET ;; You will be prompted to save ~/foo.txt I am aware of `grep-save-buffers', `compilation-save-buffers-predicate' and the solutions proposed in the links above. My proposal adds a new option `save-some-buffers-restrict-to-caller-subdirs'. I am already using it for a while with joy (10 bagger at GameStop using it!). --8<-----------------------------cut here---------------start------------->8--- commit 85e5399f035fb698fcfbb50ca01980fbbc68707c Author: Tino Calancha Date: Thu Feb 4 21:39:37 2021 +0100 save-some-buffers: Add option restricting to files in a caller's subdir Restrict the action to buffers with `default-directory' lying in a subdir of the `default-directory' from where the command is invoked. * lisp/files.el (save-some-buffers-restrict-to-caller-subdirs): New option. (save-some-buffers) (save-buffers-kill-emacs): Use it. * doc/emacs/files.texi (Save Commands) * doc/lispref/files.texi (Saving Buffers): Document it. * etc/NEWS (Editing Changes in Emacs 28.1): Announce this change. * lisp/progmodes/grep.el (grep-save-buffers) * lisp/progmodes/compile.el (compilation-save-buffers-predicate): Mention it in the docstring. * test/lisp/files-tests.el (files-tests--save-some-buffers): Helper function. (files-tests-with-all-permutations) (files-tests--with-buffer-offer-save): Helper macros. (files-tests-save-some-buffers) (files-tests-buffer-offer-save) (files-tests-save-buffers-kill-emacs--asks-to-save-buffers): New tests. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 6b3bc430d9..36d38218e9 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -433,9 +433,11 @@ Save Commands @noindent @vindex save-some-buffers-default-predicate +@vindex save-some-buffers-restrict-to-caller-subdirs You can customize the value of -@code{save-some-buffers-default-predicate} to control which buffers -Emacs will ask about. +@code{save-some-buffers-default-predicate} and +@code{save-some-buffers-restrict-to-caller-subdirs} to control which +buffers Emacs will ask about. @kbd{C-x C-c}, the key sequence to exit Emacs, invokes @code{save-some-buffers} and therefore asks the same questions. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 4110c51099..a9855fef2b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -371,6 +371,7 @@ Saving Buffers querying the user. @vindex save-some-buffers-default-predicate +@vindex save-some-buffers-restrict-to-caller-subdirs The optional @var{pred} argument provides a predicate that controls which buffers to ask about (or to save silently if @var{save-silently-p} is non-@code{nil}). If @var{pred} is @@ -381,8 +382,12 @@ Saving Buffers other non-file buffers---those that have a non-@code{nil} buffer-local value of @code{buffer-offer-save} (@pxref{Killing Buffers}). A user who says @samp{yes} to saving a non-file buffer is asked to specify -the file name to use. The @code{save-buffers-kill-emacs} function -passes the value @code{t} for @var{pred}. +the file name to use. The option +@code{save-some-buffers-restrict-to-caller-subdirs} restricts the +action of this command to buffers with @code{default-directory} in a +subdirectory of the caller's @code{default-directory}. The +@code{save-buffers-kill-emacs} function ignores this option and passes +the value @code{t} for @var{pred}. If the predicate is neither @code{t} nor @code{nil}, then it should be a function of no arguments. It will be called in each buffer to decide diff --git a/etc/NEWS b/etc/NEWS index b3d53bf73c..f1bd21f26a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -247,6 +247,11 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), * Editing Changes in Emacs 28.1 ++++ +** The new option 'save-some-buffers-restrict-to-caller-subdirs' +restricts the action of 'same-some-buffers' to buffers with +'default-directory' in a subdir of the callers 'default-directory'. + --- ** 'eval-expression' now no longer signals an error on incomplete expressions. Previously, typing 'M-: ( RET' would result in Emacs saying "End of diff --git a/lisp/files.el b/lisp/files.el index dada69c145..d51cd58217 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5520,6 +5520,19 @@ save-some-buffers-default-predicate :type '(choice (const :tag "Default" nil) function) :version "26.1") +(defcustom save-some-buffers-restrict-to-caller-subdirs nil + "Only save buffers under caller's default directory. +I.e., only prompt for modified buffers whose `default-directory' is in +in a subdir of the directory from where `save-some-buffers' is +invoked. +Note that `save-buffers-kill-emacs' ignores this value and prompts for +any unsaved buffer." + :group 'auto-save + :type '(choice + (const :tag "All buffers" nil) + (const :tag "Buffers under caller's default directory" t)) + :version "28.1") + (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' @@ -5543,12 +5556,35 @@ save-some-buffers to consider it or not when called with that buffer current. PRED defaults to the value of `save-some-buffers-default-predicate'. +You can restrict to modified buffers with `default-directory' under +the caller's `default-directory' with +`save-some-buffers-restrict-to-caller-subdirs'. + 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* ((caller-dir default-directory) + (maybe-save-buffer-p + (lambda (buffer) + (or (not save-some-buffers-restrict-to-caller-subdirs) + (file-in-directory-p (buffer-local-value 'default-directory buffer) + caller-dir)))) + (effective-pred + (unless (eq t pred) + (let ((def-pred save-some-buffers-default-predicate)) + (lambda () (and (funcall maybe-save-buffer-p (current-buffer)) + (if (functionp pred) (funcall pred) + (or (not (functionp def-pred)) + (funcall def-pred)))))))) + (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 +5614,20 @@ 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 + (funcall maybe-save-buffer-p buffer) (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)))))) + (when (funcall maybe-save-buffer-p 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))) @@ -7362,7 +7382,8 @@ save-buffers-kill-emacs (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. - (save-some-buffers arg t) + (let ((save-some-buffers-restrict-to-caller-subdirs nil)) + (save-some-buffers arg t)) (let ((confirm confirm-kill-emacs)) (and (or (not (memq t (mapcar (lambda (buf) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 48b5ee9973..d3d3849c83 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -790,7 +790,10 @@ compilation-save-buffers-predicate (string-prefix-p my-compilation-root (file-truename (buffer-file-name)))) to limit saving to files located under `my-compilation-root'. Note, that, in general, `compilation-directory' cannot be used instead -of `my-compilation-root' here." +of `my-compilation-root' here. + +See `save-some-buffers-restrict-to-caller-subdirs' for a consistent +way to achieve this." :type '(choice (const :tag "Default (save all file-visiting buffers)" nil) (const :tag "Save all buffers" t) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d6ee8bb423..5454d47211 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -246,7 +246,11 @@ grep-save-buffers buffer should be saved or not. E.g., one can set this to (lambda () (string-prefix-p my-grep-root (file-truename (buffer-file-name)))) -to limit saving to files located under `my-grep-root'." +to limit saving to files located under `my-grep-root'. + +Note that `my-grep-root' is only known at runtime. See +`save-some-buffers-restrict-to-caller-subdirs' for a consistent way to +achieve the same goal." :version "26.1" :type '(choice (const :tag "Ask before saving" ask) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 149cc689ae..14d6bc099d 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -1432,5 +1432,206 @@ files-tests-revert-buffer-with-fine-grain (buffer-substring (point-min) (point-max)) nil nil))))) -(provide 'files-tests) +(defun files-tests--save-some-buffers (pred caller-subdirs-only exp-1 exp-2) + "Helper function to test `save-some-buffers'. + +This function creates two visiting-file buffers, BUF-1, BUF-2 in + different directories at the same level, i.e., none of them is a + subdir of the other; then, it modifies both buffers; finally it calls + `save-some-buffers' from BUF-1 with first arg t and second arg PRED + and `save-some-buffers-restrict-to-caller-subdirs' let-bound to + CALLER-SUBDIRS-ONLY. + +EXP-1 and EXP-1 are the expected values of the modified flags of BUF-1 +and BUF-2 after the `save-some-buffers' call. + +The test is repeated with `save-some-buffers-default-predicate' +let-bound to PRED and passing nil as second arg of +`save-some-buffers'." + (let* ((dir (make-temp-file "testdir" 'dir)) + (file-1 (expand-file-name "subdir-1/file.foo" dir)) + (file-2 (expand-file-name "subdir-2/file.bar" dir)) + (inhibit-message t) + buf-1 buf-2) + (unwind-protect + (progn + (make-empty-file file-1 'parens) + (make-empty-file file-2 'parens) + (setq buf-1 (find-file file-1) + buf-2 (find-file file-2)) + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (insert "foobar\n"))) + ;; buf-2 is ignored if `save-some-buffers-restrict-to-caller-subdirs' is non-nil. + (with-current-buffer buf-1 + (let ((save-some-buffers-restrict-to-caller-subdirs caller-subdirs-only)) + (save-some-buffers t pred)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2)))) + + ;; Set both buffers as modified to repeat the test. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf (set-buffer-modified-p t))) + ;; Same result with: `save-some-buffers-default-predicate' -> pred, pred -> nil. + (with-current-buffer buf-1 + (let ((save-some-buffers-restrict-to-caller-subdirs caller-subdirs-only) + (save-some-buffers-default-predicate (and (functionp pred) pred))) + (save-some-buffers t nil)) + (should (eq exp-1 (buffer-modified-p buf-1))) + (should (eq exp-2 (buffer-modified-p buf-2))))) + ;; Clean up. + (dolist (buf (list buf-1 buf-2)) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory dir 'recursive)))) + +(ert-deftest files-tests-save-some-buffers () + "Test `save-some-buffers'. +Test the 3 cases for the second argument PRED, i.e., `nil', `t' or +predicate." + (let* ((foo-file-p (lambda () (string-suffix-p ".foo" buffer-file-name))) + (bar-file-p (lambda () (string-suffix-p ".bar" buffer-file-name))) + (args-results `((nil nil nil nil) + (nil t nil t) + (,foo-file-p nil nil t) + (,bar-file-p nil t nil) + (,foo-file-p t nil t) + (,bar-file-p t t t) + (t nil nil nil) + (t t nil t)))) + (pcase-dolist (`(,pred ,caller-subdirs-only ,exp-1 ,exp-2) args-results) + (files-tests--save-some-buffers pred caller-subdirs-only exp-1 exp-2)))) + +(defmacro files-tests--with-buffer-offer-save (buffers-offer fn-test fn-binders args-results) + "Helper macro to test `save-some-buffers' and `save-buffers-kill-emacs'. + +This macro creates several non-visiting-file buffers in different + directories at the same level, i.e., none of them is a subdir of the + other; then, it modifies the buffers and sets `buffer-offer-save' per + each buffer as specified by BUFFERS-OFFER, a list of elements + (BUFFER OFFER-SAVE). Finally it calls FN-TEST from the first + buffer. + +FN-TEST is the function to test: either `save-some-buffers' or +`save-buffers-kill-emacs'. This function is called with +`save-some-buffers-restrict-to-caller-subdirs' let-bound to a value +specified inside ARGS-RESULTS. + +FN-BINDERS is a list of elements (FUNCTION . BINDING), where FUNCTION +is a function symbol that this macro temporary binds to BINDING during +the FN-TEST call. +ARGS-RESULTS is a list of elements (FN-ARGS CALLERS-DIR RESULTS), where + FN-ARGS are the arguments for FN-TEST; + CALLERS-DIR specify the value to let-bind +`save-some-buffers-restrict-to-caller-subdirs'; + RESULTS are the expected results of the test." + (declare (debug (form symbol form form))) + (let ((dir (gensym "dir")) + (buffers (gensym "buffers"))) + `(let* ((,dir (make-temp-file "testdir" 'dir)) + (inhibit-message t) + (use-dialog-box nil) + ,buffers) + (pcase-dolist (`(,bufsym ,offer-save) ,buffers-offer) + (let* ((buf (generate-new-buffer (symbol-name bufsym))) + (subdir (expand-file-name + (format "subdir-%s" (buffer-name buf)) + ,dir))) + (make-directory subdir 'parens) + (push buf ,buffers) + (with-current-buffer buf + (cd subdir) + (setq buffer-offer-save offer-save) + (insert "foobar\n")))) + (setq ,buffers (nreverse ,buffers)) + + (let ((nb-saved-buffers 0)) + (unwind-protect + (pcase-dolist (`(,fn-test-args ,callers-dir ,expected) + ,args-results) + (setq nb-saved-buffers 0) + (with-current-buffer (car ,buffers) + (cl-letf + (,@(mapcar (lambda (pair) `((symbol-function ,(car pair)) ,(cdr pair))) + fn-binders) + (save-some-buffers-restrict-to-caller-subdirs callers-dir)) + (apply #',fn-test fn-test-args) + (should (equal nb-saved-buffers expected))))) + ;; Clean up. + (dolist (buf ,buffers) + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))) + (delete-directory ,dir 'recursive)))))) + +(defmacro files-tests-with-all-permutations (permutation list &rest body) + "Execute BODY forms for all permutation of LIST. +Execute the forms with the symbol PERMUTATION bound to the current +permutation." + (declare (indent 2) (debug (symbol form body))) + (let ((vec (gensym "vec"))) + `(let ((,vec (vconcat ,list))) + (cl-labels ((swap (,vec i j) + (let ((tmp (aref ,vec j))) + (aset ,vec j (aref ,vec i)) + (aset ,vec i tmp))) + (permute (,vec l r) + (if (= l r) + (let ((,permutation (append ,vec nil))) + ,@body) + (cl-loop for idx from l below (1+ r) do + (swap ,vec idx l) + (permute ,vec (1+ l) r) + (swap ,vec idx l))))) + (permute ,vec 0 (1- (length ,vec))))))) + +(ert-deftest files-tests-buffer-offer-save () + "Test `save-some-buffers'. +Check the expected behavior for non-visiting-file buffers with +a non-nil value of `buffer-offer-save'." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init))) + (nb-always-save + (length + (cl-remove-if-not (lambda (l) (eq 'always (cadr l))) buffers-offer-init)))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + (dolist (must-save `(nil t)) + (dolist (callers-dir `(nil t)) + (let* ((head-offer (cadar buffers-offer)) + (res (if must-save + (if callers-dir (or (and head-offer 1) 0) + nb-might-save) + (if callers-dir (or (and (eq 'always head-offer) 1) 0) + nb-always-save))) + (args-res `(((nil ,must-save) ,callers-dir ,res)))) + (files-tests--with-buffer-offer-save + buffers-offer + save-some-buffers + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n))) + args-res))))))) + +(ert-deftest files-tests-save-buffers-kill-emacs--asks-to-save-buffers () + "Test that `save-buffers-kill-emacs' asks to save buffers as expected." + (let* ((buffers-offer-init '((buf-1 t) (buf-2 always) (buf-3 nil))) + (nb-might-save + (length + (cl-remove-if (lambda (l) (null (cadr l))) buffers-offer-init)))) + (files-tests-with-all-permutations + buffers-offer + buffers-offer-init + ;; Order doesn't matter: ask to save any buffer with non-nil `buffer-offer-save'. + (files-tests--with-buffer-offer-save + buffers-offer + save-buffers-kill-emacs + ;; Increase counter and answer 'n' when prompted to save a buffer. + (('read-event . (lambda () (cl-incf nb-saved-buffers) ?n)) + ('kill-emacs . #'ignore)) ; Do not kill Emacs. + `((nil nil ,nb-might-save) (nil t ,nb-might-save)))))) + + ;;; files-tests.el ends here --8<-----------------------------cut here---------------end--------------->8--- In GNU Emacs 28.0.50 (build 2, x86_64-pc-linux-gnu, X toolkit, cairo version 1.16.0, Xaw scroll bars) of 2021-02-07 built on localhost.example.com Repository revision: 7c5938ad7d8884d03471e2395937e11611faadb9 Repository branch: master Windowing system distributor 'The X.Org Foundation', version 11.0.12010000 System Description: openSUSE Tumbleweed Configured using: 'configure --with-x-toolkit=lucid' Configured features: CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GSETTINGS HARFBUZZ JPEG LIBSELINUX LIBXML2 MODULES NOTIFY INOTIFY PDUMPER PNG SOUND THREADS TIFF TOOLKIT_SCROLL_BARS X11 XDBE XIM XPM LUCID ZLIB Important settings: value of $LANG: en_US.UTF-8 value of $XMODIFIERS: @im=ibus locale-coding-system: utf-8-unix Major mode: Lisp Interaction Minor modes in effect: tooltip-mode: t global-eldoc-mode: t eldoc-mode: t electric-indent-mode: t mouse-wheel-mode: t tool-bar-mode: t menu-bar-mode: t file-name-shadow-mode: t global-font-lock-mode: t font-lock-mode: t blink-cursor-mode: t auto-composition-mode: t auto-encryption-mode: t auto-compression-mode: t line-number-mode: t transient-mark-mode: t Load-path shadows: None found. Features: (shadow sort mail-extr emacsbug message rmc puny dired dired-loaddefs rfc822 mml easymenu mml-sec epa derived epg epg-config gnus-util rmail rmail-loaddefs auth-source cl-seq eieio eieio-core cl-macs eieio-loaddefs password-cache json map text-property-search time-date subr-x seq byte-opt gv bytecomp byte-compile cconv mm-decode mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util mail-prsvr mail-utils iso-transl tooltip eldoc electric uniquify ediff-hook vc-hooks lisp-float-type mwheel term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image regexp-opt fringe tabulated-list replace newcomment text-mode elisp-mode lisp-mode prog-mode register page tab-bar menu-bar rfn-eshadow isearch timer select scroll-bar mouse jit-lock font-lock syntax facemenu font-core term/tty-colors frame minibuffer cl-generic cham georgian utf-8-lang misc-lang vietnamese tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek romanian slovak czech european ethiopic indian cyrillic chinese composite charscript charprop case-table epa-hook jka-cmpr-hook help simple abbrev obarray cl-preloaded nadvice button loaddefs faces cus-face macroexp files window text-properties overlay sha1 md5 base64 format env code-pages mule custom widget hashtable-print-readable backquote threads dbusbind inotify dynamic-setting system-font-setting font-render-setting cairo x-toolkit x multi-tty make-network-process emacs) Memory information: ((conses 16 52136 5739) (symbols 48 6583 1) (strings 32 19227 1884) (string-bytes 1 625859) (vectors 16 12486) (vector-slots 8 169553 9399) (floats 8 23 41) (intervals 56 211 0) (buffers 984 10))