Refresh Dired and VC-dir buffers after vc-pull and vc-merge.

* vc/vc-dispatcher.el (vc-set-async-update): New function for
updating Dired or VC-dir buffers after async command completes.

* vc/vc-bzr.el (vc-bzr-async-command): Return the process buffer.
(vc-bzr-pull, vc-bzr-merge-branch): Use vc-set-async-update.

* vc/vc-git.el (vc-git-merge-branch): Add FETCH_HEAD to branch
completions if it exists.  Use vc-set-async-update.
(vc-git-pull): Use vc-set-async-update.

* vc/vc-hg.el (vc-hg-pull): Fix default-contents arg to
read-shell-command.  Use vc-set-async-update.
(vc-hg-merge-branch): Use vc-set-async-update.

5 files changed, 86 insertions, 20 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9ca1dd55250..c9bdafebe8a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,19 @@
+2011-01-29  Chong Yidong  <cyd@stupidchicken.com>
+
+        * vc/vc-dispatcher.el (vc-set-async-update): New function for
+        updating Dired or VC-dir buffers after async command completes.
+
+        * vc/vc-bzr.el (vc-bzr-async-command): Return the process buffer.
+        (vc-bzr-pull, vc-bzr-merge-branch): Use vc-set-async-update.
+
+        * vc/vc-git.el (vc-git-merge-branch): Add FETCH_HEAD to branch
+        completions if it exists.  Use vc-set-async-update.
+        (vc-git-pull): Use vc-set-async-update.
+
+        * vc/vc-hg.el (vc-hg-pull): Fix default-contents arg to
+        read-shell-command.  Use vc-set-async-update.
+        (vc-hg-merge-branch): Use vc-set-async-update.
+
 2011-01-29  Daiki Ueno  <ueno@unixuser.org>
 
         * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): Don't
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 31893645a62..9f86a28a575 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -100,14 +100,15 @@ 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*\"."
+\"*vc-bzr : ROOT*\".  Return this buffer."
   (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)))
+           vc-bzr-program bzr-command args)
+    buffer))
 
 ;;;###autoload
 (defconst vc-bzr-admin-dirname ".bzr"
@@ -297,14 +298,15 @@ prompt for the Bzr command to run."
     (when (or prompt (not (or bound parent)))
       (setq args (split-string
                   (read-shell-command
-                   "Run Bzr (like this): "
+                   "Bzr pull command: "
                    (concat vc-bzr-program " " command)
                    'vc-bzr-history)
                   " " t))
       (setq vc-bzr-program (car  args)
             command        (cadr args)
             args           (cddr args)))
-    (apply 'vc-bzr-async-command command args)))
+    (vc-set-async-update
+     (apply 'vc-bzr-async-command command args))))
 
 (defun vc-bzr-merge-branch ()
   "Merge another Bzr branch into the current one.
@@ -328,7 +330,7 @@ default if it is available."
          (cmd
           (split-string
            (read-shell-command
-            "Run Bzr (like this): "
+            "Bzr merge command: "
             (concat vc-bzr-program " merge --pull"
                     (if location (concat " " location) ""))
             'vc-bzr-history)
@@ -336,7 +338,8 @@ default if it is available."
          (vc-bzr-program (car  cmd))
          (command        (cadr cmd))
          (args           (cddr cmd)))
-    (apply 'vc-bzr-async-command command args)))
+    (vc-set-async-update
+     (apply 'vc-bzr-async-command command args))))
 
 (defun vc-bzr-status (file)
   "Return FILE status according to Bzr.
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 53b0d9ef8b3..c4e0dbfadac 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -382,7 +382,33 @@ Display the buffer in some window, but don't select it."
         (apply 'vc-do-command t 'async command nil args)))
     (setq window (display-buffer buffer))
     (if window
-        (set-window-start window new-window-start))))
+        (set-window-start window new-window-start))
+    buffer))
+
+(defun vc-set-async-update (process-buffer)
+  "Set a `vc-exec-after' action appropriate to the current buffer.
+This action will update the current buffer after the current
+asynchronous VC command has completed.  PROCESS-BUFFER is the
+buffer for the asynchronous VC process.
+
+If the current buffer is a VC Dir buffer, call `vc-dir-refresh'.
+If the current buffer is a Dired buffer, revert it."
+  (let* ((buf (current-buffer))
+         (tick (buffer-modified-tick buf)))
+    (cond
+     ((derived-mode-p 'vc-dir-mode)
+      (with-current-buffer process-buffer
+        (vc-exec-after
+         `(if (buffer-live-p ,buf)
+              (with-current-buffer ,buf
+                (vc-dir-refresh))))))
+     ((derived-mode-p 'dired-mode)
+      (with-current-buffer process-buffer
+        (vc-exec-after
+         `(and (buffer-live-p ,buf)
+               (= (buffer-modified-tick ,buf) ,tick)
+               (with-current-buffer ,buf
+                 (revert-buffer)))))))))
 
 ;; 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,
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 592fc77e2e3..de729c969ae 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -607,9 +607,8 @@ The car of the list is the current branch."
 
 (defun vc-git-pull (prompt)
   "Pull changes into the current Git branch.
-Normally, this runs \"git pull\".If there is no default
-location from which to pull or update, or if PROMPT is non-nil,
-prompt for the Git command to run."
+Normally, this runs \"git pull\".  If PROMPT is non-nil, prompt
+for the Git command to run."
   (let* ((root (vc-git-root default-directory))
          (buffer (format "*vc-git : %s*" (expand-file-name root)))
          (command "pull")
@@ -618,14 +617,15 @@ prompt for the Git command to run."
     ;; If necessary, prompt for the exact command.
     (when prompt
       (setq args (split-string
-                  (read-shell-command "Run Git (like this): "
+                  (read-shell-command "Git pull command: "
                                       "git pull"
                                       'vc-git-history)
                   " " t))
       (setq git-program (car  args)
             command     (cadr args)
             args        (cddr args)))
-    (apply 'vc-do-async-command buffer root git-program command args)))
+    (apply 'vc-do-async-command buffer root git-program command args)
+    (vc-set-async-update buffer)))
 
 (defun vc-git-merge-branch ()
   "Merge changes into the current Git branch.
@@ -634,9 +634,17 @@ This prompts for a branch to merge from."
          (buffer (format "*vc-git : %s*" (expand-file-name root)))
          (branches (cdr (vc-git-branches)))
          (merge-source
-          (completing-read "Merge from branch: " branches nil t)))
+          (completing-read "Merge from branch: "
+                           (if (or (member "FETCH_HEAD" branches)
+                                   (not (file-readable-p
+                                         (expand-file-name ".git/FETCH_HEAD"
+                                                           root))))
+                               branches
+                             (cons "FETCH_HEAD" branches))
+                           nil t)))
     (apply 'vc-do-async-command buffer root "git" "merge"
-           (list merge-source))))
+           (list merge-source))
+    (vc-set-async-update buffer)))
 
 ;;; HISTORY FUNCTIONS
 
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 8acff1ee2ca..7a0b8540ca3 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -610,8 +610,18 @@ REV is the revision to check out into WORKFILE."
       (error "No log entries selected for push"))))
 
 (defun vc-hg-pull (prompt)
+  "Issue a Mercurial pull command.
+If called interactively with a set of marked Log View buffers,
+call \"hg pull -r REVS\" to pull in the specified revisions REVS.
+
+With a prefix argument or if PROMPT is non-nil, prompt for a
+specific Mercurial pull command.  The default is \"hg pull -u\",
+which fetches changesets from the default remote repository and
+then attempts to update the working directory."
   (interactive "P")
   (let (marked-list)
+    ;; The `vc-hg-pull' command existed before the `pull' VC action
+    ;; was implemented.  Keep it for backward compatibility.
     (if (and (called-interactively-p 'interactive)
              (setq marked-list (log-view-get-marked)))
         (apply #'vc-hg-command
@@ -624,26 +634,29 @@ REV is the revision to check out into WORKFILE."
              (buffer (format "*vc-hg : %s*" (expand-file-name root)))
              (command "pull")
              (hg-program "hg")
-             ;; Todo: maybe check if we're up-to-date before updating
-             ;; the working copy to the latest state.
+             ;; Fixme: before updating the working copy to the latest
+             ;; state, should check if it's visiting an old revision.
              (args '("-u")))
         ;; If necessary, prompt for the exact command.
         (when prompt
           (setq args (split-string
-                      (read-shell-command "Run Hg (like this): " "hg -u"
+                      (read-shell-command "Run Hg (like this): " "hg pull -u"
                                           'vc-hg-history)
                       " " t))
           (setq hg-program (car  args)
                 command    (cadr args)
                 args       (cddr args)))
         (apply 'vc-do-async-command buffer root hg-program
-               command args)))))
+               command args)
+        (vc-set-async-update buffer)))))
 
 (defun vc-hg-merge-branch ()
-  "Merge incoming changes into the current Mercurial working directory."
+  "Merge incoming changes into the current working directory.
+This runs the command \"hg merge\"."
   (let* ((root (vc-hg-root default-directory))
          (buffer (format "*vc-hg : %s*" (expand-file-name root))))
-    (apply 'vc-do-async-command buffer root "hg" '("merge"))))
+    (apply 'vc-do-async-command buffer root "hg" '("merge"))
+    (vc-set-async-update buffer)))
 
 ;;; Internal functions