From 659114fdba7d5ea14541cdc713c7f9745eb93c46 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Fri, 28 Jan 2011 22:12:32 -0500 Subject: [PATCH] Rudimentary support for vc-pull and vc-merge in Git and Mercurial. * lisp/vc/vc.el (vc-pull): Make vc-update an alias for this, instead of the other way around. * lisp/vc/vc-git.el (vc-git-branches, vc-git-pull) (vc-git-merge-branch): New functions. (vc-git-history): New var. * lisp/vc/vc-hg.el (vc-hg-history): New var. (vc-hg-pull): Perform default pull if called via Lisp by vc-pull. (vc-hg-merge-branch): New function. --- etc/NEWS | 14 +++++------ lisp/ChangeLog | 13 ++++++++++ lisp/vc/vc-dispatcher.el | 2 +- lisp/vc/vc-git.el | 51 ++++++++++++++++++++++++++++++++++++++++ lisp/vc/vc-hg.el | 47 ++++++++++++++++++++++++++++-------- lisp/vc/vc.el | 4 ++-- 6 files changed, 111 insertions(+), 20 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index bb916628010..a20ecd4fe7f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -589,20 +589,20 @@ on a D-Bus without simultaneously registering a property or a method. ** VC and related modes *** Support for pulling on distributed version control systems. -The vc-update command now runs a "pull" operation, if it is supported. +The vc-pull command runs a "pull" operation, if it is supported. This updates the current branch from upstream. A prefix argument -means to prompt the user for command specifics, e.g. a pull location. +means to prompt the user for specifics, e.g. a pull location. -**** vc-pull is an alias for vc-update. +**** vc-update is now an alias for vc-update. -**** Currently supported by Bzr. +**** Currently supported by Bzr, Git, and Mercurial. *** Support for merging on distributed version control systems. The vc-merge command now runs a "merge" operation, if it is supported. -This merges another branch into the current one. A prefix argument -means to prompt the user for command specifics, e.g. a merge location. +This merges another branch into the current one. This command prompts +the user for specifics, e.g. a merge source. -**** Currently supported by Bzr. +**** Currently supported by Bzr, Git, and Mercurial. ** Miscellaneous diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c1477a6b8a5..41242360c60 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-01-29 Chong Yidong + + * vc/vc-hg.el (vc-hg-history): New var. + (vc-hg-pull): Perform default pull if called via Lisp by vc-pull. + (vc-hg-merge-branch): New function. + + * vc/vc.el (vc-pull): Make vc-update an alias for this, instead of + the other way around. + + * vc/vc-git.el (vc-git-branches, vc-git-pull) + (vc-git-merge-branch): New functions. + (vc-git-history): New var. + 2011-01-28 Chong Yidong * vc/vc-dispatcher.el (vc-do-async-command): New function. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 19a276b635c..53b0d9ef8b3 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -373,7 +373,7 @@ Display the buffer in some window, but don't select it." (unless (eq (point) (point-min)) (insert " \n")) (setq new-window-start (point)) - (insert "Running \"" command " ") + (insert "Running \"" command) (dolist (arg args) (insert " " arg)) (insert "\"...\n") diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index c3ffa1fcf46..592fc77e2e3 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -122,6 +122,9 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (defvar vc-git-commits-coding-system 'utf-8 "Default coding system for git commits.") +;; History of Git commands. +(defvar vc-git-history nil) + ;;; BACKEND PROPERTIES (defun vc-git-revision-granularity () 'repository) @@ -526,6 +529,21 @@ or an empty string if none." 'help-echo stash-help-echo 'face 'font-lock-variable-name-face)))))) +(defun vc-git-branches () + "Return the existing branches, as a list of strings. +The car of the list is the current branch." + (with-temp-buffer + (call-process "git" nil t nil "branch") + (goto-char (point-min)) + (let (current-branch branches) + (while (not (eobp)) + (when (looking-at "^\\([ *]\\) \\(.+\\)$") + (if (string-equal (match-string 1) "*") + (setq current-branch (match-string 2)) + (push (match-string 2) branches))) + (forward-line 1)) + (cons current-branch (nreverse branches))))) + ;;; STATE-CHANGING FUNCTIONS (defun vc-git-create-repo () @@ -587,6 +605,39 @@ or an empty string if none." (vc-git-command nil 0 file "reset" "-q" "--") (vc-git-command nil nil file "checkout" "-q" "--"))) +(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." + (let* ((root (vc-git-root default-directory)) + (buffer (format "*vc-git : %s*" (expand-file-name root))) + (command "pull") + (git-program "git") + args) + ;; If necessary, prompt for the exact command. + (when prompt + (setq args (split-string + (read-shell-command "Run Git (like this): " + "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))) + +(defun vc-git-merge-branch () + "Merge changes into the current Git branch. +This prompts for a branch to merge from." + (let* ((root (vc-git-root default-directory)) + (buffer (format "*vc-git : %s*" (expand-file-name root))) + (branches (cdr (vc-git-branches))) + (merge-source + (completing-read "Merge from branch: " branches nil t))) + (apply 'vc-do-async-command buffer root "git" "merge" + (list merge-source)))) + ;;; HISTORY FUNCTIONS (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 890d97923bc..8acff1ee2ca 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -141,6 +141,8 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;;; Properties of the backend +(defvar vc-hg-history nil) + (defun vc-hg-revision-granularity () 'repository) (defun vc-hg-checkout-model (files) 'implicit) @@ -607,16 +609,41 @@ REV is the revision to check out into WORKFILE." (mapcar (lambda (arg) (list "-r" arg)) marked-list))) (error "No log entries selected for push")))) -(defun vc-hg-pull () - (interactive) - (let ((marked-list (log-view-get-marked))) - (if marked-list - (apply #'vc-hg-command - nil 0 nil - "pull" - (apply 'nconc - (mapcar (lambda (arg) (list "-r" arg)) marked-list))) - (error "No log entries selected for pull")))) +(defun vc-hg-pull (prompt) + (interactive "P") + (let (marked-list) + (if (and (called-interactively-p 'interactive) + (setq marked-list (log-view-get-marked))) + (apply #'vc-hg-command + nil 0 nil + "pull" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) + marked-list))) + (let* ((root (vc-hg-root default-directory)) + (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. + (args '("-u"))) + ;; If necessary, prompt for the exact command. + (when prompt + (setq args (split-string + (read-shell-command "Run Hg (like this): " "hg -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))))) + +(defun vc-hg-merge-branch () + "Merge incoming changes into the current Mercurial working directory." + (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")))) ;;; Internal functions diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7f11a4b3333..be0f568d304 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2297,7 +2297,7 @@ depending on the underlying version-control system." (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") ;;;###autoload -(defun vc-update (&optional arg) +(defun vc-pull (&optional arg) "Update the current fileset or branch. On a distributed version control system, this runs a \"pull\" operation to update the current branch, prompting for an argument @@ -2337,7 +2337,7 @@ tip revision are merged into the working file." (error "VC update is unsupported for `%s'" backend))))) ;;;###autoload -(defalias 'vc-pull 'vc-update) +(defalias 'vc-update 'vc-pull) (defun vc-version-backup-file (file &optional rev) "Return name of backup file for revision REV of FILE. -- 2.39.2