From: Michal Nazarewicz <mpn@google.com>
To: emacs-devel@gnu.org
Subject: [PATCH] files.el: avoid asking whether to kill Emacs multiple times
Date: Thu, 29 Jan 2015 15:06:49 +0100 [thread overview]
Message-ID: <1422540409-4134-1-git-send-email-mpn@google.com> (raw)
From: Michal Nazarewicz <mina86@mina86.com>
* lisp/files.el (save-buffers-kill-emacs): If `confirm-kill-emacs' is
set, but user has just been asked whether they really want to kill Emacs
(for example with a ‘Modified buffers exist; exit anyway?’ prompt) , do
not ask them for another confirmation. However, apply this exception
only if `confirm-kill-emacs' is 'yes-or-no-p or 'y-or-n-p, otherwise this
change might errenously prevent some user defined function from being
run (adding such a function to `kill-emacs-query-functions' is probably
better option, but we don’t want to break any usage even if it’s
incorrect).
---
lisp/files.el | 64 ++++++++++++++++++++++++++++++++---------------------------
1 file changed, 35 insertions(+), 29 deletions(-)
diff --git a/lisp/files.el b/lisp/files.el
index e9632ed..7d94bc1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -6590,35 +6590,41 @@ (defun save-buffers-kill-emacs (&optional arg)
if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
(interactive "P")
(save-some-buffers arg t)
- (and (or (not (memq t (mapcar (function
- (lambda (buf) (and (buffer-file-name buf)
- (buffer-modified-p buf))))
- (buffer-list))))
- (yes-or-no-p "Modified buffers exist; exit anyway? "))
- (or (not (fboundp 'process-list))
- ;; process-list is not defined on MSDOS.
- (let ((processes (process-list))
- active)
- (while processes
- (and (memq (process-status (car processes)) '(run stop open listen))
- (process-query-on-exit-flag (car processes))
- (setq active t))
- (setq processes (cdr processes)))
- (or (not active)
- (with-current-buffer-window
- (get-buffer-create "*Process List*") nil
- #'(lambda (window _value)
- (with-selected-window window
- (unwind-protect
- (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
- (when (window-live-p window)
- (quit-restore-window window 'kill)))))
- (list-processes t)))))
- ;; Query the user for other things, perhaps.
- (run-hook-with-args-until-failure 'kill-emacs-query-functions)
- (or (null confirm-kill-emacs)
- (funcall confirm-kill-emacs "Really exit Emacs? "))
- (kill-emacs)))
+ (let (asked)
+ (and
+ (or (not (memq t (mapcar (function
+ (lambda (buf) (and (buffer-file-name buf)
+ (buffer-modified-p buf))))
+ (buffer-list))))
+ (progn (setq asked t)
+ (yes-or-no-p "Modified buffers exist; exit anyway? ")))
+ (or (not (fboundp 'process-list))
+ ;; process-list is not defined on MSDOS.
+ (let ((processes (process-list))
+ active)
+ (while processes
+ (and (memq (process-status (car processes)) '(run stop open listen))
+ (process-query-on-exit-flag (car processes))
+ (setq active t))
+ (setq processes (cdr processes)))
+ (or (not active)
+ (with-current-buffer-window
+ (get-buffer-create "*Process List*") nil
+ #'(lambda (window _value)
+ (with-selected-window window
+ (unwind-protect
+ (progn
+ (setq asked t)
+ (yes-or-no-p "Active processes exist; kill them and exit anyway? "))
+ (when (window-live-p window)
+ (quit-restore-window window 'kill)))))
+ (list-processes t)))))
+ ;; Query the user for other things, perhaps.
+ (run-hook-with-args-until-failure 'kill-emacs-query-functions)
+ (or (null confirm-kill-emacs)
+ (and asked (memq confirm-kill-emacs '(yes-or-no-p y-or-n-p)))
+ (funcall confirm-kill-emacs "Really exit Emacs? "))
+ (kill-emacs))))
(defun save-buffers-kill-terminal (&optional arg)
"Offer to save each buffer, then kill the current connection.
--
2.2.0.rc0.207.ga3a616c
next reply other threads:[~2015-01-29 14:06 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-01-29 14:06 Michal Nazarewicz [this message]
2015-01-29 14:35 ` [PATCH] files.el: avoid asking whether to kill Emacs multiple times Drew Adams
2015-01-29 15:54 ` Stefan Monnier
2015-01-29 16:01 ` David Kastrup
2015-01-30 1:39 ` [PATCHv2] " Michal Nazarewicz
2015-01-30 6:11 ` Stefan Monnier
2015-01-30 10:43 ` Michal Nazarewicz
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=1422540409-4134-1-git-send-email-mpn@google.com \
--to=mpn@google.com \
--cc=emacs-devel@gnu.org \
/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).