From a2b6e5d60b10c6baa3fbc36bfb158342c1c424ab Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sat, 29 Jan 2011 16:19:21 -0500 Subject: [PATCH] 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. --- lisp/ChangeLog | 16 ++++++++++++++++ lisp/vc/vc-bzr.el | 15 +++++++++------ lisp/vc/vc-dispatcher.el | 28 +++++++++++++++++++++++++++- lisp/vc/vc-git.el | 22 +++++++++++++++------- lisp/vc/vc-hg.el | 25 +++++++++++++++++++------ 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 + + * 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 * 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 -- 2.39.2