[Emacs-diffs] /srv/bzr/emacs/trunk r109253: * lisp/simple.el (async-shell-command-buffer): New defcustom.

[Juri Linkov]

------------------------------------------------------------
revno: 109253
fixes bug: http://debbugs.gnu.org/4719
committer: Juri Linkov <address@hidden>
branch nick: trunk
timestamp: Sun 2012-07-29 03:03:26 +0300
message:
  * lisp/simple.el (async-shell-command-buffer): New defcustom.
  (shell-command): Use it.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/simple.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2012-07-28 16:35:52 +0000
+++ b/etc/NEWS  2012-07-29 00:03:26 +0000
@@ -360,6 +360,12 @@
 if the command ends in `;' (when operating on multiple files).
 Otherwise, it executes the command on each file in parallel.
 
+** Shell
+
+*** New option `async-shell-command-buffer' specifies what buffer to use
+for a new asynchronous shell command when the default output buffer
+`*Async Shell Command*' is already taken by another running command.
+
 ** FFAP
 
 *** The option `ffap-url-unwrap-remote' can now be a list of strings,

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-07-28 16:57:57 +0000
+++ b/lisp/ChangeLog    2012-07-29 00:03:26 +0000
@@ -1,3 +1,8 @@
+2012-07-29  Juri Linkov  <address@hidden>
+
+       * simple.el (async-shell-command-buffer): New defcustom.
+       (shell-command): Use it.  (Bug#4719)
+
 2012-07-28  Eli Zaretskii  <address@hidden>
 
        * international/mule-cmds.el (set-locale-environment): In a

=== modified file 'lisp/simple.el'
--- a/lisp/simple.el    2012-07-28 10:38:55 +0000
+++ b/lisp/simple.el    2012-07-29 00:03:26 +0000
@@ -2264,6 +2264,33 @@
           (or hist 'shell-command-history)
           args)))
 
+(defcustom async-shell-command-buffer 'confirm-new-buffer
+  "What to do when the output buffer is used by another shell command.
+This option specifies how to resolve the conflict where a new command
+wants to direct its output to the buffer `*Async Shell Command*',
+but this buffer is already taken by another running shell command.
+
+The value `confirm-kill-process' is used to ask for confirmation before
+killing the already running process and running a new process
+in the same buffer, `confirm-new-buffer' for confirmation before running
+the command in a new buffer with a name other than the default buffer name,
+`new-buffer' for doing the same without confirmation,
+`confirm-rename-buffer' for confirmation before renaming the existing
+output buffer and running a new command in the default buffer,
+`rename-buffer' for doing the same without confirmation."
+  :type '(choice (const :tag "Confirm killing of running command"
+                       confirm-kill-process)
+                (const :tag "Confirm creation of a new buffer"
+                       confirm-new-buffer)
+                (const :tag "Create a new buffer"
+                       new-buffer)
+                (const :tag "Confirm renaming of existing buffer"
+                       confirm-rename-buffer)
+                (const :tag "Rename the existing buffer"
+                       rename-buffer))
+  :group 'shell
+  :version "24.2")
+
 (defun async-shell-command (command &optional output-buffer error-buffer)
   "Execute string COMMAND asynchronously in background.
 
@@ -2418,12 +2445,40 @@
                    proc)
                ;; Remove the ampersand.
                (setq command (substring command 0 (match-beginning 0)))
-               ;; If will kill a process, query first.
+               ;; Ask the user what to do with already running process.
                (setq proc (get-buffer-process buffer))
-               (if proc
-                   (if (yes-or-no-p "A command is running.  Kill it? ")
+               (when proc
+                 (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)
                      (error "Shell command in progress")))
+                  ((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
+                                     (or output-buffer "*Async Shell 
Command*")))
+                     (error "Shell command in progress")))
+                  ((eq async-shell-command-buffer 'new-buffer)
+                   ;; It will create a new buffer.
+                   (setq buffer (generate-new-buffer
+                                 (or output-buffer "*Async Shell Command*"))))
+                  ((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
+                                       (or output-buffer "*Async Shell 
Command*"))))
+                     (error "Shell command in progress")))
+                  ((eq async-shell-command-buffer 'rename-buffer)
+                   ;; It will rename the buffer.
+                   (with-current-buffer buffer
+                     (rename-uniquely))
+                   (setq buffer (get-buffer-create
+                                 (or output-buffer "*Async Shell 
Command*"))))))
                (with-current-buffer buffer
                  (setq buffer-read-only nil)
                  ;; Setting buffer-read-only to nil doesn't suffice