Refactor VC merging to fix a layer violation.

* vc/vc.el, vc/vc-cvs.el, vc/vc-rcs.el, vc/vc-svn.el: The 'merge'
backend method of RCS/CVS/SVN is now 'merge-file', to contrast with
'merge-branch'. Prompting for merge revisions is pushed down to the
back ends; this fixes a layering violation that caused bad behavior
with SVN.
This commit is contained in:
Eric S. Raymond 2014-12-01 11:41:45 -05:00
parent dce46a7484
commit d17bae9039
5 changed files with 94 additions and 30 deletions

View file

@ -5,6 +5,12 @@
2014-12-01 Eric S. Raymond <esr@snark.thyrsus.com>
* vc/vc.el, vc/vc-cvs.el, vc/vc-rcs.el, vc/vc-svn.el: The 'merge'
backend method of RCS/CVS/SVN is now 'merge-file', to contrast with
'merge-branch'. Prompting for merge revisions is pushed down to
the back ends; this fixes a layering violation that caused bad
behavior with SVN.
* vc/vc.el, vc-hooks.el, and all backends: API simplification;
vc-stay-local-p and repository-hostname are no longer public
methods. Only the CVS and SVN backends used these, and the SVN

View file

@ -440,6 +440,35 @@ REV is the revision to check out."
;; Make the file read-only by switching off all w-bits
(set-file-modes file (logand (file-modes file) 3950)))))
(defun vc-cvs-merge-file (file)
"Accept a file merge request, prompting for revisions."
(let* ((first-revision
(vc-read-revision
(concat "Merge " file
" from branch or revision "
"(default news on current branch): ")
(list file)
'CVS))
second-revision
status)
(cond
((string= first-revision "")
(setq status (vc-cvs-merge-news file)))
(t
(if (not (vc-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second revision: "
(list file) 'CVS nil
(concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-cvs-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-cvs-merge file first-revision second-revision))))
status))
(defun vc-cvs-merge (file first-revision &optional second-revision)
"Merge changes into current working copy of FILE.
The changes are between FIRST-REVISION and SECOND-REVISION."

View file

@ -486,6 +486,31 @@ revert all registered files beneath it."
(concat (if (eq (vc-state file) 'edited) "-u" "-r")
(vc-working-revision file)))))
(defun vc-rcs-merge-file (file)
"Accept a file merge request, prompting for revisions."
(let* ((first-revision
(vc-read-revision
(concat "Merge " file " from branch or revision: ")
(list file)
'RCS))
second-revision)
(cond
((string= first-revision "")
(error "A starting RCS revision is required"))
(t
(if (not (vc-branch-p first-revision))
(setq second-revision
(vc-read-revision
"Second RCS revision: "
(list file) 'RCS nil
(concat (vc-branch-part first-revision) ".")))
;; We want to merge an entire branch. Set revisions
;; accordingly, so that vc-rcs-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)))))
(vc-rcs-merge file first-revision second-revision)))
(defun vc-rcs-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."

View file

@ -379,6 +379,29 @@ FILE is a file wildcard, relative to the root directory of DIRECTORY."
(unless contents-done
(vc-svn-command nil 0 file "revert")))
(defun vc-svn-merge-file (file)
"Accept a file merge request, prompting for revisions."
(let* ((first-revision
(vc-read-revision
(concat "Merge " file
" from SVN revision "
"(default news on current branch): ")
(list file)
'SVN))
second-revision
status)
(cond
((string= first-revision "")
(setq status (vc-svn-merge-news file)))
(t
(setq second-revision
(vc-read-revision
"Second SVN revision: "
(list file) 'SVN nil
first-revision))
(setq status (vc-svn-merge file first-revision second-revision))))
status))
(defun vc-svn-merge (file first-version &optional second-version)
"Merge changes into current working copy of FILE.
The changes are between FIRST-VERSION and SECOND-VERSION."

View file

@ -289,10 +289,11 @@
;; 'cancel-version' and took a single file arg, not a list of
;; files.)
;;
;; - merge (file rev1 rev2)
;; - merge-file (file rev1 rev2)
;;
;; Merge the changes between REV1 and REV2 into the current working file
;; (for non-distributed VCS).
;; Merge the changes between REV1 and REV2 into the current working
;; file (for non-distributed VCS). It is expected that with an
;; empty first revision this will behave like the merge-news method.
;;
;; - merge-branch ()
;;
@ -594,6 +595,11 @@
;; RCS has setting the initial revision been even possible, let alone
;; sane.
;;
;; - The backend operation for non-distributed VCSes formerly called
;; "merge" is now "merge-file" (to contrast with merge-branch), and
;; does its own prompting for revisions. (This fixes a layer violation
;; that produced bad behavior under SVN.)
;;
;; workfile-unchanged-p is no longer a public back-end method. It
;; was redundant with vc-state and usually implemented with a trivial
;; call to it. A few older back ends retain versions for internal use in
@ -2060,42 +2066,17 @@ changes from the current branch."
(vc-buffer-sync)
(dolist (file files)
(let* ((state (vc-state file))
first-revision second-revision status)
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))))
(setq status (vc-call-backend backend 'merge-file file))
(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)))
(if (zerop status) (message "Merge successful")