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.
This commit is contained in:
Chong Yidong
parent
ef6a29070d
commit
2c3160c54e
3 changed files with 223 additions and 79 deletions
|
|
@ -1,3 +1,16 @@
|
|||
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
|
||||
|
|
|
|||
196
lisp/vc/vc.el
196
lisp/vc/vc.el
|
|
@ -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.
|
||||
(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.
|
||||
|
||||
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)
|
||||
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.
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue