[Emacs-diffs] /srv/bzr/emacs/trunk r103026: Refresh Dired and VC-dir buffers after vc-pull and vc-merge.

[Chong Yidong]

------------------------------------------------------------
revno: 103026
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-01-29 16:19:21 -0500
message:
  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.
modified:
  lisp/ChangeLog
  lisp/vc/vc-bzr.el
  lisp/vc/vc-dispatcher.el
  lisp/vc/vc-git.el
  lisp/vc/vc-hg.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-29 11:05:35 +0000
+++ b/lisp/ChangeLog    2011-01-29 21:19:21 +0000
@@ -1,3 +1,19 @@
+2011-01-29  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): Don't

=== modified file 'lisp/vc/vc-bzr.el'
--- a/lisp/vc/vc-bzr.el 2011-01-28 23:10:55 +0000
+++ b/lisp/vc/vc-bzr.el 2011-01-29 21:19:21 +0000
@@ -100,14 +100,15 @@
 `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 @@
     (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 @@
         (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 @@
         (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.

=== modified file 'lisp/vc/vc-dispatcher.el'
--- a/lisp/vc/vc-dispatcher.el  2011-01-29 03:12:32 +0000
+++ b/lisp/vc/vc-dispatcher.el  2011-01-29 21:19:21 +0000
@@ -382,7 +382,33 @@
        (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,

=== modified file 'lisp/vc/vc-git.el'
--- a/lisp/vc/vc-git.el 2011-01-29 03:12:32 +0000
+++ b/lisp/vc/vc-git.el 2011-01-29 21:19:21 +0000
@@ -607,9 +607,8 @@
 
 (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 @@
     ;; 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 @@
         (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
 

=== modified file 'lisp/vc/vc-hg.el'
--- a/lisp/vc/vc-hg.el  2011-01-29 03:12:32 +0000
+++ b/lisp/vc/vc-hg.el  2011-01-29 21:19:21 +0000
@@ -610,8 +610,18 @@
       (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 @@
             (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