Commit 659114fd authored by Chong Yidong's avatar Chong Yidong

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.
parent bc68bd39
......@@ -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
......
2011-01-29 Chong Yidong <cyd@stupidchicken.com>
* 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 <cyd@stupidchicken.com>
* vc/vc-dispatcher.el (vc-do-async-command): New function.
......
......@@ -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")
......
......@@ -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)
......
......@@ -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
......
......@@ -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.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment