RFC: DWIM for killing *shell* and a more process-query-on-exit

[Daniel Colascione]

Some terminal emulators ask for confirmation when closing a window only
when that window hosts a foreground process group different from the one
originally launched.  This feature seems useful for Emacs too.

This patch 1) obsoletes the {set-,}process-query-on-exit-flag, 2) adds a
more flexible mechanism that replaces the flag with a function, and 3)
makes shell-mode use this mechanism to dynamically decide whether it's
worth asking the user to kill a process.

What do you think about the mechanism and about changing the default
behavior?

diff --git a/lisp/shell.el b/lisp/shell.el
index f71d140..6eb409a 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -309,6 +309,19 @@ for Shell mode only."
                 (const :tag "on" t))
   :group 'shell)

+(defcustom shell-ask-when-killing-buffer 'when-running-job
+  "When should shell ask for confirmation when killing a buffer?
+`t' means to always ask before killing a live process.  `nil'
+means to always kill without prompting.  `when-running-job' means
+to ask for confirmation only when killing a shell process
+running a child --- that is, only when `process-running-child-p'
+returns non-nil."
+  :type '(choice
+          (const :tag "never" nil)
+          (const :tag "when running a subprocess" 'when-running-job)
+          (other :tag "always" t))
+  :group 'shell)
+
 (defvar shell-dirstack nil
   "List of directories saved by pushd in this buffer's shell.
 Thus, this does not include the shell's current directory.")
@@ -645,6 +658,13 @@ Sentinels will always get the two parameters
PROCESS and EVENT."
       (with-current-buffer buf
         (insert (format "\nProcess %s %s\n" process event))))))

+(defun shell--check-query-on-exit (process)
+  "Return whether we should ask user before killing PROCESS."
+  (cond ((not shell-ask-when-killing-buffer) nil)
+        ((eq shell-ask-when-killing-buffer 'when-running-job)
+         (process-running-child-p process))
+        (t t)))
+
 ;;;###autoload
 (defun shell (&optional buffer)
   "Run an inferior shell, with I/O through BUFFER (which defaults to
`*shell*').
@@ -732,7 +752,10 @@ Otherwise, one argument `-i' is passed to the shell.
             (if (file-exists-p startfile) startfile)
             (if (and xargs-name (boundp xargs-name))
                 (symbol-value xargs-name)
-              '("-i")))
+               '("-i")))
+      (set-process-query-on-exit
+       (get-buffer-process (current-buffer))
+       'shell--check-query-on-exit)
       (shell-mode)))
   buffer)

diff --git a/lisp/subr.el b/lisp/subr.el
index 163a1c4..a3e0511 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1953,9 +1953,23 @@ process."

 ;; compatibility

+(defun process-query-on-exit-flag (process)
+  "Return whether it is safe to kill PROCESS without asking user.
+Return the result of `process-query-on-exit', unless that result
+is a function.  In that case, call the function and return
+its result."
+  (let ((query-on-exit (process-query-on-exit process)))
+    (if (functionp query-on-exit)
+        (funcall query-on-exit process)
+      query-on-exit)))
+
+(define-obsolete-function-alias
+  'set-process-query-on-exit-flag
+  'set-process-query-on-exit "25.1")
+
 (make-obsolete
  'process-kill-without-query
- "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
+ "use `process-query-on-exit' or `set-process-query-on-exit'."
  "22.1")
 (defun process-kill-without-query (process &optional _flag)
   "Say no query needed if PROCESS is running when Emacs is exited.
diff --git a/src/process.c b/src/process.c
index 2800fa5..9b2ad11 100644
--- a/src/process.c
+++ b/src/process.c
@@ -703,6 +703,7 @@ make_process (Lisp_Object name)
   p = allocate_process ();
   /* Initialize Lisp data.  Note that allocate_process initializes all
      Lisp data to nil, so do it only for slots which should not be nil.  */
+  p->query_on_exit = Qt;
   pset_status (p, Qrun);
   pset_mark (p, Fmake_marker ());

@@ -1156,28 +1157,31 @@ This function returns FLAG.  */)
   return flag;
 }

-DEFUN ("set-process-query-on-exit-flag",
-       Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
+DEFUN ("set-process-query-on-exit",
+       Fset_process_query_on_exit, Sset_process_query_on_exit,
        2, 2, 0,
-       doc: /* Specify if query is needed for PROCESS when Emacs is exited.
-If the second argument FLAG is non-nil, Emacs will query the user before
-exiting or killing a buffer if PROCESS is running.  This function
-returns FLAG.  */)
+       doc: /* Specify if query is needed for PROCESS when Emacs is
+exited.  If the second argument FLAG is non-nil, Emacs will query the
+user before exiting or killing a buffer if PROCESS is running.
+This function returns FLAG.  If FLAG is actually a function, Emacs
+calls it with a single argument, the process, to decide whether the
+process can be killed without user interaction.  This function should
+execute quickly and not interact with the user.  */)
   (register Lisp_Object process, Lisp_Object flag)
 {
   CHECK_PROCESS (process);
-  XPROCESS (process)->kill_without_query = NILP (flag);
+  XPROCESS (process)->query_on_exit = flag;
   return flag;
 }

-DEFUN ("process-query-on-exit-flag",
-       Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
+DEFUN ("process-query-on-exit",
+       Fprocess_query_on_exit, Sprocess_query_on_exit,
        1, 1, 0,
-       doc: /* Return the current value of query-on-exit flag for
PROCESS.  */)
+       doc: /* Return the current query-on-exit value for PROCESS.  */)
   (register Lisp_Object process)
 {
   CHECK_PROCESS (process);
-  return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
+  return XPROCESS (process)->query_on_exit;
 }

 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
@@ -1449,7 +1453,7 @@ usage: (make-process &rest ARGS)  */)
   pset_command (XPROCESS (proc), Fcopy_sequence (command));

   if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
-    XPROCESS (proc)->kill_without_query = 1;
+    XPROCESS (proc)->query_on_exit = tem;
   if (tem = Fplist_get (contact, QCstop), !NILP (tem))
     pset_command (XPROCESS (proc), Qt);

@@ -2653,7 +2657,7 @@ usage:  (make-serial-process &rest ARGS)  */)
   pset_filter (p, Fplist_get (contact, QCfilter));
   pset_log (p, Qnil);
   if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
-    p->kill_without_query = 1;
+    p->query_on_exit = tem;
   if (tem = Fplist_get (contact, QCstop), !NILP (tem))
     pset_command (p, Qt);
   eassert (! p->pty_flag);
@@ -3433,7 +3437,7 @@ usage: (make-network-process &rest ARGS)  */)
   pset_filter (p, filter);
   pset_log (p, Fplist_get (contact, QClog));
   if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
-    p->kill_without_query = 1;
+    p->query_on_exit = tem;
   if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
     pset_command (p, Qt);
   p->pid = 0;
@@ -7444,8 +7448,8 @@ The variable takes effect when `start-process' is
called.  */);
   defsubr (&Sprocess_sentinel);
   defsubr (&Sset_process_window_size);
   defsubr (&Sset_process_inherit_coding_system_flag);
-  defsubr (&Sset_process_query_on_exit_flag);
-  defsubr (&Sprocess_query_on_exit_flag);
+  defsubr (&Sset_process_query_on_exit);
+  defsubr (&Sprocess_query_on_exit);
   defsubr (&Sprocess_contact);
   defsubr (&Sprocess_plist);
   defsubr (&Sset_process_plist);
diff --git a/src/process.h b/src/process.h
index 36979dc..4ba2fb6 100644
--- a/src/process.h
+++ b/src/process.h
@@ -105,6 +105,9 @@ struct Lisp_Process
     Lisp_Object gnutls_cred_type;
 #endif

+    /* Value of the process query-on-exit flag or function.  */
+    Lisp_Object query_on_exit;
+
     /* After this point, there are no Lisp_Objects any more.  */
     /* alloc.c assumes that `pid' is the first such non-Lisp slot.  */

@@ -139,9 +142,6 @@ struct Lisp_Process
     unsigned int adaptive_read_buffering : 2;
     /* Skip reading this process on next read.  */
     bool_bf read_output_skip : 1;
-    /* True means kill silently if Emacs is exited.
-       This is the inverse of the `query-on-exit' flag.  */
-    bool_bf kill_without_query : 1;
     /* True if communicating through a pty.  */
     bool_bf pty_flag : 1;
     /* Flag to set coding-system of the process buffer from the

signature.asc
Description: OpenPGP digital signature