master e193ea3c34 6/6: Allow `kill-buffer' query to save the buffer first

[Lars Ingebrigtsen]

branch: master
commit e193ea3c34b01a09806cffbca2d3b5657881419b
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow `kill-buffer' query to save the buffer first
    
    * lisp/loadup.el ("emacs-lisp/rmc"): Preload.
    
    * lisp/simple.el (kill-buffer--possibly-save): New function to
    offer to save the buffer before killing (bug#47075).
    
    * src/buffer.c (Fkill_buffer): Call the new function to query the
    user.
    (syms_of_buffer): Define symbol.
---
 lisp/loadup.el |  3 +++
 lisp/simple.el | 17 +++++++++++++++++
 src/buffer.c   | 10 +++++++---
 3 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/lisp/loadup.el b/lisp/loadup.el
index 1d834da5b2..21a87dbd77 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -397,6 +397,9 @@
       (message "Warning: Change in load-path due to site-load will be \
 lost after dumping")))
 
+;; Used by `kill-buffer', for instance.
+(load "emacs-lisp/rmc")
+
 ;; Make sure default-directory is unibyte when dumping.  This is
 ;; because we cannot decode and encode it correctly (since the locale
 ;; environment is not, and should not be, set up).  default-directory
diff --git a/lisp/simple.el b/lisp/simple.el
index f2b3d82a7a..653cffae62 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10560,6 +10560,23 @@ If the buffer doesn't exist, create it first."
   (interactive)
   (pop-to-buffer-same-window (get-scratch-buffer-create)))
 
+(defun kill-buffer--possibly-save (buffer)
+  (let ((response
+         (cadr
+          (read-multiple-choice
+           (format "Buffer %s modified; kill anyway?"
+                   (buffer-name))
+           '((?y "yes" "kill buffer without saving")
+             (?n "no" "exit without doing anything")
+             (?s "save and then kill" "save the buffer and then kill it"))
+           nil nil (not use-short-answers)))))
+    (if (equal response "no")
+        nil
+      (unless (equal response "yes")
+        (with-current-buffer buffer
+          (save-buffer)))
+      t)))
+
 
 
 (provide 'simple)
diff --git a/src/buffer.c b/src/buffer.c
index 7adcd22d88..509ce51b55 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1809,10 +1809,12 @@ cleaning up all windows currently displaying the buffer 
to be killed. */)
     /* Query if the buffer is still modified.  */
     if (INTERACTIVE && modified)
       {
-       AUTO_STRING (format, "Buffer %s modified; kill anyway? ");
-       tem = do_yes_or_no_p (CALLN (Fformat, format, BVAR (b, name)));
-       if (NILP (tem))
+       /* Ask whether to kill the buffer, and exit if the user says
+          "no".  */
+       if (NILP (call1 (Qkill_buffer__possibly_save, buffer)))
          return unbind_to (count, Qnil);
+       /* Recheck modified.  */
+       modified = BUF_MODIFF (b) > BUF_SAVE_MODIFF (b);
       }
 
     /* Delete the autosave file, if requested. */
@@ -6474,5 +6476,7 @@ will run for `clone-indirect-buffer' calls as well.  */);
 
   DEFSYM (Qautosaved, "autosaved");
 
+  DEFSYM (Qkill_buffer__possibly_save, "kill-buffer--possibly-save");
+
   Fput (intern_c_string ("erase-buffer"), Qdisabled, Qt);
 }