Provide help when doing (shell-command "... &") on buffer collisions

* lisp/simple.el (shell-command--same-buffer-confirm): New
function (bug#13649).
(shell-command): Use it to provide fuller help.

diff --git a/lisp/simple.el b/lisp/simple.el
index 75720d895cc49e303c200484d02f40b7afbd5119..1ff101cfcd1eb722441a996432f197b605bcd5c1 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4296,25 +4296,21 @@ impose the use of a shell (with its need to quote arguments)."
                  (cond
                   ((eq async-shell-command-buffer 'confirm-kill-process)
                    ;; If will kill a process, query first.
-                   (if (yes-or-no-p "A command is running in the default buffer.  Kill it? ")
-                       (kill-process proc)
-                     (user-error "Shell command in progress")))
+                    (shell-command--same-buffer-confirm "Kill it")
+                   (kill-process proc))
                   ((eq async-shell-command-buffer 'confirm-new-buffer)
                    ;; If will create a new buffer, query first.
-                   (if (yes-or-no-p "A command is running in the default buffer.  Use a new buffer? ")
-                        (setq buffer (generate-new-buffer bname))
-                     (user-error "Shell command in progress")))
+                    (shell-command--same-buffer-confirm "Use a new buffer")
+                    (setq buffer (generate-new-buffer bname)))
                   ((eq async-shell-command-buffer 'new-buffer)
                    ;; It will create a new buffer.
                     (setq buffer (generate-new-buffer bname)))
                   ((eq async-shell-command-buffer 'confirm-rename-buffer)
                    ;; If will rename the buffer, query first.
-                   (if (yes-or-no-p "A command is running in the default buffer.  Rename it? ")
-                       (progn
-                         (with-current-buffer buffer
-                           (rename-uniquely))
-                          (setq buffer (get-buffer-create bname)))
-                     (user-error "Shell command in progress")))
+                    (shell-command--same-buffer-confirm "Rename it")
+                   (with-current-buffer buffer
+                     (rename-uniquely))
+                    (setq buffer (get-buffer-create bname)))
                   ((eq async-shell-command-buffer 'rename-buffer)
                    ;; It will rename the buffer.
                    (with-current-buffer buffer
@@ -4362,6 +4358,24 @@ impose the use of a shell (with its need to quote arguments)."
            (shell-command-on-region (point) (point) command
                                     output-buffer nil error-buffer)))))))
 
+(defun shell-command--same-buffer-confirm (action)
+  (let ((help-form
+         (format
+          "There's a command already running in the default buffer,
+so we can't start a new one in the same one.
+
+Answering \"yes\" will %s.
+
+Answering \"no\" will exit without doing anything, and won't
+start the new command.
+
+Also see the `async-shell-command-buffer' variable."
+          (downcase action))))
+    (unless (yes-or-no-p
+             (format "A command is running in the default buffer.  %s? "
+                     action))
+      (user-error "Shell command in progress"))))
+
 (defun max-mini-window-lines (&optional frame)
   "Compute maximum number of lines for echo area in FRAME.
 As defined by `max-mini-window-height'.  FRAME defaults to the