Commit 2c3160c5 authored by Chong Yidong's avatar Chong Yidong
Browse files

Initial support for unified DVCS pull and merge.

* lisp/vc/vc-bzr.el (vc-bzr-admin-branchconf, vc-bzr-history): New vars.
(vc-bzr--branch-conf, vc-bzr-async-command, vc-bzr-pull)
(vc-bzr-merge-branch): New functions, implementing merge-branch
and pull operations.

* lisp/vc/vc.el (vc-merge): Use vc-BACKEND-merge-branch if available.
Accept optional prefix arg meaning to prompt for a command.
(vc-update): Use vc-BACKEND-pull if available.  Accept optional
prefix arg meaning to prompt for a command.
(vc-pull): Alias for vc-update.
parent ef6a2907
2010-11-23 Chong Yidong <cyd@stupidchicken.com>
* vc/vc.el (vc-merge): Use vc-BACKEND-merge-branch if available.
Accept optional prefix arg meaning to prompt for a command.
(vc-update): Use vc-BACKEND-pull if available. Accept optional
prefix arg meaning to prompt for a command.
(vc-pull): Alias for vc-update.
* vc/vc-bzr.el (vc-bzr-admin-branchconf, vc-bzr-history): New vars.
(vc-bzr--branch-conf, vc-bzr-async-command, vc-bzr-pull)
(vc-bzr-merge-branch): New functions, implementing merge-branch
and pull operations.
2010-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
 
* Makefile.in: Fix up last merge.
......
......@@ -115,6 +115,8 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(concat vc-bzr-admin-dirname "/branch/revision-history"))
(defconst vc-bzr-admin-lastrev
(concat vc-bzr-admin-dirname "/branch/last-revision"))
(defconst vc-bzr-admin-branchconf
(concat vc-bzr-admin-dirname "/branch/branch.conf"))
;;;###autoload (defun vc-bzr-registered (file)
;;;###autoload (if (vc-find-root file vc-bzr-admin-checkout-format-file)
......@@ -129,6 +131,13 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(let ((root (vc-find-root file vc-bzr-admin-checkout-format-file)))
(when root (vc-file-setprop file 'bzr-root root)))))
(defun vc-bzr--branch-conf (file)
"Return the Bzr branch config for file FILE, as a string."
(with-temp-buffer
(insert-file-contents
(expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file)))
(buffer-string)))
(require 'sha1) ;For sha1-program
(defun vc-bzr-sha1 (file)
......@@ -228,6 +237,9 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
"added\\|ignored\\|kind changed\\|modified\\|removed\\|renamed\\|unknown"
"Regexp matching file status words as reported in `bzr' output.")
;; History of Bzr commands.
(defvar vc-bzr-history nil)
(defun vc-bzr-file-name-relative (filename)
"Return file name FILENAME stripped of the initial Bzr repository path."
(lexical-let*
......@@ -236,6 +248,87 @@ Invoke the bzr command adding `BZR_PROGRESS_BAR=none' and
(when rootdir
(file-relative-name filename* rootdir))))
(defun vc-bzr-async-command (command args)
"Run Bzr COMMAND asynchronously with ARGS, displaying the result.
Send the output to a buffer named \"*vc-bzr : NAME*\", where NAME
is the root of the current Bzr branch. Display the buffer in
some window, but don't select it."
;; TODO: set up hyperlinks.
(let* ((dir default-directory)
(root (vc-bzr-root default-directory))
(buffer (get-buffer-create (format "*vc-bzr : %s*" root))))
(with-current-buffer buffer
(setq default-directory root)
(goto-char (point-max))
(unless (eq (point) (point-min))
(insert " \n"))
(insert "Running \"" vc-bzr-program " " command)
(dolist (arg args)
(insert " " arg))
(insert "\"...\n")
;; Run bzr in the original working directory.
(let ((default-directory dir))
(apply 'vc-bzr-command command t 'async nil args)))
(display-buffer buffer)))
(defun vc-bzr-pull (prompt)
"Pull changes into the current Bzr branch.
Normally, this runs \"bzr pull\". However, if the branch is a
bound branch, run \"bzr update\" instead. If there is no default
location from which to pull or update, or if PROMPT is non-nil,
prompt for the Bzr command to run."
(let* ((vc-bzr-program vc-bzr-program)
(branch-conf (vc-bzr--branch-conf default-directory))
;; Check whether the branch is bound.
(bound (string-match "^bound\\s-*=\\s-*True" branch-conf))
;; If we need to do a "bzr pull", check for a parent. If it
;; does not exist, bzr will need a pull location.
(parent (unless bound
(string-match
"^parent_location\\s-*=\\s-*[^\n[:space:]]+"
branch-conf)))
(command (if bound "update" "pull"))
args buf)
;; If necessary, prompt for the exact command.
(when (or prompt (not (or bound parent)))
(setq args (split-string
(read-shell-command
"Run Bzr (like this): "
(concat vc-bzr-program " " command)
'vc-bzr-history)
" " t))
(setq vc-bzr-program (car args)
command (cadr args)
args (cddr args)))
(vc-bzr-async-command command args)))
(defun vc-bzr-merge-branch (prompt)
"Merge another Bzr branch into the current one.
If a default merge source is defined (i.e. an upstream branch or
a previous merge source), this normally runs \"bzr merge --pull\".
If optional PROMPT is non-nil or no default merge source is
defined, prompt for the Bzr command to run."
(let* ((vc-bzr-program vc-bzr-program)
(command "merge")
(args '("--pull"))
command-string args buf)
(when (or prompt
;; Prompt if there is no default merge source.
(null
(string-match
"^\\(parent_location\\|submit_branch\\)\\s-*=\\s-*[^\n[:space:]]+"
(vc-bzr--branch-conf default-directory))))
(setq args (split-string
(read-shell-command
"Run Bzr (like this): "
(concat vc-bzr-program " " command " --pull")
'vc-bzr-history)
" " t))
(setq vc-bzr-program (car args)
command (cadr args)
args (cddr args)))
(vc-bzr-async-command command args)))
(defun vc-bzr-status (file)
"Return FILE status according to Bzr.
Return value is a cons (STATUS . WARNING), where WARNING is a
......
......@@ -100,7 +100,7 @@
;; In the list of functions below, each identifier needs to be prepended
;; with `vc-sys-'. Some of the functions are mandatory (marked with a
;; `*'), others are optional (`-').
;;
;; BACKEND PROPERTIES
;;
;; * revision-granularity
......@@ -109,7 +109,7 @@
;; that return 'file have per-file revision numbering; backends
;; that return 'repository have per-repository revision numbering,
;; so a revision level implicitly identifies a changeset
;;
;; STATE-QUERYING FUNCTIONS
;;
;; * registered (file)
......@@ -313,11 +313,24 @@
;;
;; - merge (file rev1 rev2)
;;
;; Merge the changes between REV1 and REV2 into the current working file.
;; Merge the changes between REV1 and REV2 into the current working file
;; (for non-distributed VCS).
;;
;; - merge-branch (prompt)
;;
;; Merge another branch into the current one. If PROMPT is non-nil,
;; or if necessary, prompt for a location to merge from.
;;
;; - merge-news (file)
;;
;; Merge recent changes from the current branch into FILE.
;; (for non-distributed VCS).
;;
;; - pull (prompt)
;;
;; Pull "upstream" changes into the current branch (for distributed
;; VCS). If PROMPT is non-nil, or if necessary, prompt for a
;; location to pull from.
;;
;; - steal-lock (file &optional revision)
;;
......@@ -335,7 +348,7 @@
;;
;; Mark conflicts as resolved. Some VC systems need to run a
;; command to mark conflicts as resolved.
;;
;; HISTORY FUNCTIONS
;;
;; * print-log (files buffer &optional shortlog start-revision limit)
......@@ -440,7 +453,7 @@
;; If the backend supports annotating through copies and renames,
;; and displays a file name and a revision, then return a cons
;; (REVISION . FILENAME).
;;
;; TAG SYSTEM
;;
;; - create-tag (dir name branchp)
......@@ -461,7 +474,7 @@
;; does a sanity check whether there aren't any uncommitted changes at
;; or below DIR, and then performs a tree walk, using the `checkout'
;; function to retrieve the corresponding revisions.
;;
;; MISCELLANEOUS
;;
;; - make-version-backups-p (file)
......@@ -1815,54 +1828,67 @@ The headers are reset to their non-expanded form."
'modify-change-comment files rev comment))))))
;;;###autoload
(defun vc-merge ()
"Merge changes between two revisions into the current buffer's file.
This asks for two revisions to merge from in the minibuffer. If the
first revision is a branch number, then merge all changes from that
branch. If the first revision is empty, merge news, i.e. recent changes
from the current branch.
See Info node `Merging'."
(interactive)
(vc-ensure-vc-buffer)
(vc-buffer-sync)
(let* ((file buffer-file-name)
(backend (vc-backend file))
(state (vc-state file))
first-revision second-revision status)
(defun vc-merge (&optional arg)
"Perform a version control merge operation.
On a distributed version control system, this runs a \"merge\"
operation to incorporate changes from another branch onto the
current branch, prompting for an argument list if required.
Optional prefix ARG forces a prompt.
On a non-distributed version control system, this merges changes
between two revisions into the current fileset. This asks for
two revisions to merge from in the minibuffer. If the first
revision is a branch number, then merge all changes from that
branch. If the first revision is empty, merge the most recent
changes from the current branch."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset))
(files (cadr vc-fileset)))
(cond
((stringp state) ;; Locking VCses only
(error "File is locked by %s" state))
((not (vc-editable-p file))
(if (y-or-n-p
"File must be checked out for merging. Check out now? ")
(vc-checkout file t)
(error "Merge aborted"))))
(setq first-revision
(vc-read-revision
(concat "Branch or revision to merge from "
"(default news on current branch): ")
(list file)
backend))
(if (string= first-revision "")
(setq status (vc-call-backend backend 'merge-news file))
(if (not (vc-find-backend-function backend 'merge))
(error "Sorry, merging is not implemented for %s" backend)
(if (not (vc-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second revision: "
(list file) backend nil
;; FIXME: This is CVS/RCS/SCCS specific.
(concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-BACKEND-merge understands us.
(setq second-revision first-revision)
;; first-revision must be the starting point of the branch
(setq first-revision (vc-branch-part first-revision)))
(setq status (vc-call-backend backend 'merge file
first-revision second-revision))))
(vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE")))
;; If a branch-merge operation is defined, use it.
((vc-find-backend-function backend 'merge-branch)
(vc-call-backend backend 'merge-branch arg))
;; Otherwise, do a per-file merge.
((vc-find-backend-function backend 'merge)
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
first-revision second-revision status)
(cond
((stringp state) ;; Locking VCses only
(error "File %s is locked by %s" file state))
((not (vc-editable-p file))
(vc-checkout file t)))
(setq first-revision
(vc-read-revision
(concat "Merge " file
"from branch or revision "
"(default news on current branch): ")
(list file)
backend))
(cond
((string= first-revision "")
(setq status (vc-call-backend backend 'merge-news file)))
(t
(if (not (vc-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second revision: "
(list file) backend nil
;; FIXME: This is CVS/RCS/SCCS specific.
(concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-BACKEND-merge understands us.
(setq second-revision first-revision)
;; first-revision must be the starting point of the branch
(setq first-revision (vc-branch-part first-revision)))
(setq status (vc-call-backend backend 'merge file
first-revision second-revision))))
(vc-maybe-resolve-conflicts file status "WORKFILE" "MERGE SOURCE"))))
(t
(error "Sorry, merging is not implemented for %s" backend)))))
(defun vc-maybe-resolve-conflicts (file status &optional name-A name-B)
(vc-resynch-buffer file t (not (buffer-modified-p)))
......@@ -2274,35 +2300,47 @@ depending on the underlying version-control system."
(define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1")
;;;###autoload
(defun vc-update ()
"Update the current fileset's files to their tip revisions.
For each one that contains no changes, and is not locked, then this simply
replaces the work file with the latest revision on its branch. If the file
contains changes, and the backend supports merging news, then any recent
changes from the current branch are merged into the working file."
(interactive)
(let* ((vc-fileset (vc-deduce-fileset))
(defun vc-update (&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
list if required. Optional prefix ARG forces a prompt.
On a non-distributed version control system, update the current
fileset to the tip revisions. For each unchanged and unlocked
file, this simply replaces the work file with the latest revision
on its branch. If the file contains changes, any changes in the
tip revision are merged into the working file."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset))
(files (cadr vc-fileset)))
(save-some-buffers ; save buffers visiting files
nil (lambda ()
(and (buffer-modified-p)
(let ((file (buffer-file-name)))
(and file (member file files))))))
(dolist (file files)
(if (vc-up-to-date-p file)
(vc-checkout file nil t)
(if (eq (vc-checkout-model backend (list file)) 'locking)
(if (eq (vc-state file) 'edited)
(error "%s"
(substitute-command-keys
"File is locked--type \\[vc-revert] to discard changes"))
(error "Unexpected file state (%s) -- type %s"
(vc-state file)
(substitute-command-keys
"\\[vc-next-action] to correct")))
(vc-maybe-resolve-conflicts
file (vc-call-backend backend 'merge-news file)))))))
(cond
;; If a pull operation is defined, use it.
((vc-find-backend-function backend 'pull)
(vc-call-backend backend 'pull arg))
;; If VCS has `merge-news' functionality (CVS and SVN), use it.
((vc-find-backend-function backend 'merge-news)
(save-some-buffers ; save buffers visiting files
nil (lambda ()
(and (buffer-modified-p)
(let ((file (buffer-file-name)))
(and file (member file files))))))
(dolist (file files)
(if (vc-up-to-date-p file)
(vc-checkout file nil t)
(vc-maybe-resolve-conflicts
file (vc-call-backend backend 'merge-news file)))))
;; For a locking VCS, check out each file.
((eq (vc-checkout-model backend files) 'locking)
(dolist (file files)
(if (vc-up-to-date-p file)
(vc-checkout file nil t))))
(t
(error "VC update is unsupported for `%s'" backend)))))
;;;###autoload
(defalias 'vc-pull 'vc-update)
(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