+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
`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"
(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.
(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)
(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.
(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,
(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")
;; 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.
(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
(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
(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
projects / emacs.git / commitdiff