Re: pcvs branch and merge functions

[Arik Mitschang <arik.mitschang@gmail.com>]

[-- Attachment #1: message body text --]
[-- Type: text/plain, Size: 2221 bytes --]

Hi Stefan,

I addressed most of your comments in an updated version. Also seemed
to have success with the temporary merge-tag flag file. The diff is
attached to this message.

 > Maybe a better approach is to make it possible to strip some suffix
 > before adding -BASE etc.. so the user can say foo-BRANCH if she
 > wants, and the base won't be called foo-BRANCH-BASE but foo-BASE.

I did a similar thing to this in that if the branch is named with a
postfix and the user supplies the postfix added tag to the merge, it
will appropriately get stripped off before the merge tag is added.

e.g. if I use "-BRANCH" as a branch postfix, then I can supply
"foo-BRANCH" to the merge command and I will end up with "foo-MERGE"
as I would expect.

Also defaulted branch-postfix to "".

 > Currently PCL-CVS doesn't use "C-c <something>" keybindings much
 > (if at all).  Instead it uses bindings like `u', `m', ... so maybe
 > that's a better direction.
 > 
 > > (or not at all, these are probably not the most regular commands)
 > Not having a binding is OK as well, yes.

I'm opting with not-at-all for now, since I agree that the single key
bindings are more obvious for pcvs (only C-c binding is kill-process)
but any obvious key is taken for branch. "J" would be okay for merge,
but I think the pair should come together.

 > It does harm because the defcustom's `:type' will be more complex
 > (you didn't bother to provide it yet) making it more complex for
 > the user to customize, and because it makes the code more complex.
 > I.e. it does harm.  All of that for no real benefit.  If the user
 > really wants to create a branch without a -BASE tag, she can use
 > cvs-mode-tag.

Okay, I added checks to ensure that the tag is at least unique. A
sadistic user could possibly use a branch-tag and specify no base-tag
to get something like this:

base: foo
branch: foo-BRANCH

 > >> BTW.  Maybe an even better option would be to provide completion
 > >> after "-j" and "-r" when you do c-x M-x cvs-mode-update.
 > > You mean than the cvs-mode-merge/branch functions all-together?

I will defer this to another line of development, but I agree it would
be nice.

If you get a chance, please check it out.

Thanks,
~Arik


[-- Attachment #2: pcvs-branch-and-merge diff --]
[-- Type: application/octet-stream, Size: 7405 bytes --]

=== modified file 'lisp/vc/pcvs-defs.el'
--- lisp/vc/pcvs-defs.el	2010-06-11 18:51:00 +0000
+++ lisp/vc/pcvs-defs.el	2010-08-03 18:38:21 +0000
@@ -190,6 +190,37 @@
   :group 'pcl-cvs
   :type '(boolean))
 
+(defcustom cvs-branch-tag-base-postfix "-BASE"
+  "This postfix will get added to the branch tag given at prompt
+when creating a branch and used to tag the revision from which
+the branch was created. This tag must be unique to the
+`cvs-branch-tag-branch-postfix', or an error will be raised when
+running `cvs-mode-create-branch'"
+  :group 'pcl-cvs
+  :type 'string
+  )
+
+(defcustom cvs-branch-tag-branch-postfix ""
+  "This postfix will get added to the branch tag given at prompt
+when creating a branch and used as the branch name. The default
+is to tag the branch exactly as given at the prompt (no postfix)"
+  :group 'pcl-cvs
+  :type 'string
+  )
+
+(defcustom cvs-branch-tag-merge-postfix "-MERGE"
+  "if non-nil the postfix will get added to the (root of, if
+applicable) branch tag given at prompt when merging a branch and
+used to tag the revision at the merge point."
+  :group 'pcl-cvs
+  :type 'string
+  )
+
+(defvar cvs-mode-merge-control-file ".pcvs-merge-branch"
+  "Name of the file that flags current commit as likely being
+part of a merge. Must be specific enough not to conflict with any
+other cvs made files, since it is placed in the CVS directory")
+
 (defcustom cvs-buffer-name-alist
   '(("diff" cvs-diff-buffer-name diff-mode)
     ("status" "*cvs-info*" cvs-status-mode)

=== modified file 'lisp/vc/pcvs-parse.el'
--- lisp/vc/pcvs-parse.el	2010-06-11 18:51:00 +0000
+++ lisp/vc/pcvs-parse.el	2010-08-03 05:10:30 +0000
@@ -472,6 +472,8 @@
       (cvs-match " *Working revision:[ \t]*-?\\([0-9.]+\\).*$" (base-rev 1))
       ;; Let's not get all worked up if the format changes a bit
       (cvs-match " *Working revision:.*$"))
+     ;; we can get this with a merge
+     (cvs-or (cvs-match "^Result of merge UTC$") t)
      (cvs-or
       (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1))
       (cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$"

=== modified file 'lisp/vc/pcvs.el'
--- lisp/vc/pcvs.el	2010-06-11 19:09:57 +0000
+++ lisp/vc/pcvs.el	2010-08-03 18:53:27 +0000
@@ -1472,11 +1472,28 @@
 (defun cvs-do-commit (flags)
   "Do the actual commit, using the current buffer as the log message."
   (interactive (list (cvs-flags-query 'cvs-commit-flags "cvs commit flags")))
-  (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
+  (let ((msg (buffer-substring-no-properties (point-min) (point-max)))
+	(merge-file (expand-file-name
+		     (concat "CVS/" cvs-mode-merge-control-file)))
+	branch-name branch-merge post-tag)
     (cvs-mode!)
     ;;(pop-to-buffer cvs-buffer)
-    (cvs-mode-do "commit" (list* "-m" msg flags) 'commit)))
-
+    (when (file-exists-p merge-file)
+      (setq branch-name (with-temp-buffer 
+			  (insert-file merge-file)
+			  (buffer-substring (point-min) (point-max))))
+      (setq branch-merge (concat branch-name
+				 cvs-branch-tag-merge-postfix))
+      (when (and (y-or-n-p
+		  (format 
+		   "This appears to be a merge with %s. Is that so? " 
+		   (concat branch-name cvs-branch-tag-branch-postfix)))
+		 (not (equal cvs-branch-tag-merge-postfix "")))
+	(setq post-tag
+	      `((with-current-buffer "*cvs*" 
+		  (cvs-mode-do "tag" (list ',branch-merge) nil 
+			       :postproc (delete-file ',merge-file)))))))
+    (cvs-mode-do "commit" (list* "-m" msg flags) 'commit :postproc post-tag)))
 
 ;;;; Editing existing commit log messages.
 
@@ -2099,6 +2116,90 @@
 				   :postproc ',untag)))))
     (cvs-mode-run "tag" (list tag) fis :postproc update)))
 
+(defun-cvs-mode (cvs-mode-create-branch . SIMPLE) (branch-root)
+  "Create a branch from current revision, and move all files onto
+that branch. branch-root is the name of the branch, cvs-mode will
+tag the base of the branch with `cvs-branch-tag-base-postfix' and
+will add that to the end of the branch-root. It will likewise add
+`cvs-branch-tag-branch-postfix' (default to empty string).
+
+performs in order:
+    cvs tag branch-root{base-postfix}
+    cvs tag [-r branch-root{base-postfix}] -b branch-root{branch-postfix}
+    cvs update -r branch-root{branch-postfix}
+
+See also `cvs-mode-merge' for additional branch related functionality.
+"
+  (interactive
+   (list (setq branch-root
+	       (cvs-query-read nil
+			       "Branch root: " cvs-qtypedesc-tag))))
+  (if (not 
+       (and (not (equal cvs-branch-tag-base-postfix ""))
+	    (not (equal cvs-branch-tag-base-postfix 
+			cvs-branch-tag-branch-postfix))))
+      (error "Must have unique cvs-branch-tag-base-postfix for branching"))  
+  (let* ((fis (cvs-mode-marked (when cvs-force-dir-tag 'tag) "branch"))
+	 (base-tag (concat branch-root cvs-branch-tag-base-postfix))
+	 (branch-tag (concat branch-root cvs-branch-tag-branch-postfix))
+	 (update `((with-current-buffer ,(current-buffer)
+		     (cvs-mode-run 
+		      "update" (list "-r" ',branch-tag) ',fis))))
+	 (branch `((with-current-buffer ,(current-buffer)
+		     (cvs-mode-run 
+		      "tag" (list "-r" ',base-tag "-b" ',branch-tag) ',fis
+				   :postproc ',update)))))
+    (cvs-mode-run "tag" (list base-tag) fis :postproc branch)))
+
+
+(defun-cvs-mode (cvs-mode-merge . SIMPLE) (branch-root)
+  "Run a cvs update -j branch to merge branch-root to the current
+revision. It is safe to provide either the branch root as given
+to `cvs-mode-create-branch' or the tag name of the branch in a
+case where `cvs-branch-tag-branch-postfix' is not an empty
+string (eg foo or foo-BRANCH are allowed and do the same thing if
+`cvs-mode-tag-branch-postfix is '-BRANCH'.
+
+The value of `cvs-branch-tag-merge-postfix' will be added to the
+branch-root and used to tag the merge point.  Because conflict
+resolution must be done before the branch is officially merged,
+this function works by created small file in the CVS control
+directory whose name is given by `cvs-mode-merge-control-file'
+containing the branch root name. When doing a subsequent commit,
+this file will be detected and the user prompted whether the
+commit is the result of this merge. Typically this will be the
+case, but the file can be saved for a later commit by answering
+'n' at the prompt. Once a merge commit is completed successfully,
+the file is removed.
+"
+  (interactive
+   (list (setq branch-root 
+	       (cvs-query-read nil
+			       "Branch root: " cvs-qtypedesc-tag))))
+  (let* ((fis (cvs-mode-marked (when cvs-force-dir-tag 'tag) "merge"))
+	 (branch-tag 
+	  (concat branch-root 
+		  (if (string-match 
+		       (concat 
+			(regexp-quote 
+			 cvs-branch-tag-branch-postfix) "$")
+		       branch-root) ""
+		    (or cvs-branch-tag-branch-postfix) ""))))
+    ;; when we have a merge-postfix create a temp file
+    ;; flagging for merge tagging on commit
+    (cvs-mode-run "update" (list "-j" branch-tag) fis 
+		  :postproc `((when (not 
+				     (equal cvs-branch-tag-merge-postfix ""))
+				(with-temp-buffer
+				  (insert 
+				   (replace-regexp-in-string 
+				    (regexp-quote cvs-branch-tag-branch-postfix)
+				    "" ',branch-root))
+				  (write-file
+				   (expand-file-name
+				    (concat
+				     "CVS/" cvs-mode-merge-control-file)))))))))
+
 
 (defun-cvs-mode cvs-mode-delete-lock ()
   "Delete the lock file that CVS is waiting for.


[-- Attachment #3: .signature --]
[-- Type: text/plain, Size: 22 bytes --]


-- 
Arik W. Mitschang