Convert vc-bzr-async-command into a general vc-do-async-command facility.

* vc/vc-dispatcher.el (vc-do-async-command): New function.

* vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for
vc-do-async-command.

* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers changed.

lisp/ChangeLog

+2011-01-28  Chong Yidong  <cyd@stupidchicken.com>
+
+	* vc/vc-dispatcher.el (vc-do-async-command): New function.
+
+	* vc/vc-bzr.el (vc-bzr-async-command): Convert into a wrapper for
+	vc-do-async-command.
+
+	* vc/vc-bzr.el (vc-bzr-pull, vc-bzr-merge-branch): Callers
+	changed.
+
 2011-01-28  Leo  <sdl.web@gmail.com>
 
 	* emacs-lisp/advice.el (ad-make-advised-docstring): Don't apply
-	highlighting to the "this function is advisted" message.
+	highlighting to the "this function is advised" message.
 
 	* help-mode.el (help-mode-finish): Apply highlighting here, to
 	avoid clobbering by substitute-command-keys (Bug#6304).

lisp/vc/vc-bzr.el

@@ -94,6 +94,20 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
     (apply 'vc-do-command (or buffer "*vc*") okstatus vc-bzr-program
            file-or-list bzr-command args)))
 
+(defun vc-bzr-async-command (bzr-command &rest args)
+  "Wrapper round `vc-do-async-command' using `vc-bzr-program' as COMMAND.
+Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
+`LC_MESSAGES=C' to the environment.
+Use the current Bzr root directory as the ROOT argument to
+`vc-do-async-command', and specify an output buffer named
+\"*vc-bzr : ROOT*\"."
+  (let* ((process-environment
+	  (list* "BZR_PROGRESS_BAR=none" "LC_MESSAGES=C"
+		 process-environment))
+	 (root (vc-bzr-root default-directory))
+	 (buffer (format "*vc-bzr : %s*" (expand-file-name root))))
+    (apply 'vc-do-async-command buffer root
+	   vc-bzr-program bzr-command args)))
 
 ;;;###autoload
 (defconst vc-bzr-admin-dirname ".bzr"
@@ -261,31 +275,6 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
     (when rootdir
          (file-relative-name filename* rootdir))))
 
-(defun vc-bzr-async-command (command args)
-  "Run Bzr COMMAND asynchronously with ARGS, displaying the result.
-Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME
-is the root of the current Bzr branch.  Display the buffer in
-some window, but don't select it."
-  ;; TODO: set up hyperlinks.
-  (let* ((dir default-directory)
-	 (root (vc-bzr-root default-directory))
-	 (buffer (get-buffer-create
-		  (format "*vc-bzr : %s*"
-			  (expand-file-name root)))))
-    (with-current-buffer buffer
-      (setq default-directory root)
-      (goto-char (point-max))
-      (unless (eq (point) (point-min))
-	(insert "\n"))
-      (insert "Running \"" vc-bzr-program " " command)
-      (dolist (arg args)
-	(insert " " arg))
-      (insert "\"...\n")
-      ;; Run bzr in the original working directory.
-      (let ((default-directory dir))
-	(apply 'vc-bzr-command command t 'async nil args)))
-    (display-buffer buffer)))
-
 (defun vc-bzr-pull (prompt)
   "Pull changes into the current Bzr branch.
 Normally, this runs \"bzr pull\".  However, if the branch is a
@@ -315,7 +304,7 @@ prompt for the Bzr command to run."
       (setq vc-bzr-program (car  args)
 	    command        (cadr args)
 	    args           (cddr args)))
-    (vc-bzr-async-command command args)))
+    (apply 'vc-bzr-async-command command args)))
 
 (defun vc-bzr-merge-branch ()
   "Merge another Bzr branch into the current one.
@@ -324,8 +313,8 @@ source (an upstream branch or a previous merge source) as a
 default if it is available."
   (let* ((branch-conf (vc-bzr--branch-conf default-directory))
 	 ;; "bzr merge" without an argument defaults to submit_branch,
-	 ;; then parent_location.  We extract the specific location
-	 ;; and add it explicitly to the command line.
+	 ;; then parent_location.  Extract the specific location and
+	 ;; add it explicitly to the command line.
 	 (location
 	  (cond
 	   ((string-match
@@ -347,7 +336,7 @@ default if it is available."
 	 (vc-bzr-program (car  cmd))
 	 (command        (cadr cmd))
 	 (args           (cddr cmd)))
-    (vc-bzr-async-command command args)))
+    (apply 'vc-bzr-async-command command args)))
 
 (defun vc-bzr-status (file)
   "Return FILE status according to Bzr.

lisp/vc/vc-dispatcher.el

@@ -356,6 +356,34 @@ case, and the process object in the asynchronous case."
 			      ',command ',file-or-list ',flags))
 	status))))
 
+(defun vc-do-async-command (buffer root command &rest args)
+  "Run COMMAND asynchronously with ARGS, displaying the result.
+Send the output to BUFFER, which should be a buffer or the name
+of a buffer, which is created.
+ROOT should be the directory in which the command should be run.
+Display the buffer in some window, but don't select it."
+  (let* ((dir default-directory)
+	 window new-window-start)
+    (setq buffer (get-buffer-create buffer))
+    (if (get-buffer-process buffer)
+	(error "Another VC action on %s is running" root))
+    (with-current-buffer buffer
+      (setq default-directory root)
+      (goto-char (point-max))
+      (unless (eq (point) (point-min))
+	(insert "\n"))
+      (setq new-window-start (point))
+      (insert "Running \"" command " ")
+      (dolist (arg args)
+	(insert " " arg))
+      (insert "\"...\n")
+      ;; Run in the original working directory.
+      (let ((default-directory dir))
+	(apply 'vc-do-command t 'async command nil args)))
+    (setq window (display-buffer buffer))
+    (if window
+	(set-window-start window new-window-start))))
+
 ;; These functions are used to ensure that the view the user sees is up to date
 ;; even if the dispatcher client mode has messed with file contents (as in,
 ;; for example, VCS keyword expansion).