From d17bae9039021b600ceaec93f2f0e888b12e523d Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Mon, 1 Dec 2014 11:41:45 -0500 Subject: [PATCH] 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. --- lisp/ChangeLog | 6 ++++++ lisp/vc/vc-cvs.el | 29 +++++++++++++++++++++++++++++ lisp/vc/vc-rcs.el | 25 +++++++++++++++++++++++++ lisp/vc/vc-svn.el | 23 +++++++++++++++++++++++ lisp/vc/vc.el | 41 +++++++++++------------------------------ 5 files changed, 94 insertions(+), 30 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b736b2d5617..e75cc89e3e9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -5,6 +5,12 @@ 2014-12-01 Eric S. Raymond + * 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 diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index a09909a8353..fc1e8572578 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -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." diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 96ae5836f42..940d967d68b 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -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." diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index c3efcc59b5a..00a0388c599 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -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." diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a30581efb4a..b6ba2d3e863 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -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") -- 2.11.4.GIT