diff lisp/vc-rcs.el @ 104621:f4a041a8c69d

* vc.el (vc-trunk-p): Rename to vc-rcs-trunk-p and move to vc-rcs.el. (vc-minor-part): Rename to vc-rcs-minor-part and move to vc-rcs.el. (vc-default-previous-revision): Rename to vc-rcs-previous-revision and move to vc-rcs.el. (vc-default-next-revision): Rename to vc-rcs-next-revision and move to vc-rcs.el. (vc-cvs-update-changelog): Move to vc-cvs.el, use vc-call-backend. (vc-rcs-update-changelog): Remove. (vc-update-changelog-rcs2log): Rename to vc-rcs-update-changelog and move to vc-rcs.el. * vc-rcs.el (vc-rcs-latest-on-branch-p, vc-rcs-checkin) (vc-rcs-checkout, vc-rcs-rollback): Adjust for the vc-rcs-trunk-p renaming. (vc-rcs-trunk-p, vc-rcs-minor-part, vc-rcs-previous-revision) (vc-rcs-next-revision, vc-rcs-update-changelog): Moved here from vc.el, renamed to be RCS specific. * vc-cvs.el (vc-cvs-previous-revision, vc-cvs-next-revision): New functions. (vc-cvs-update-changelog): Moved here from vc.el. * vc-sccs.el (vc-sccs-previous-revision, vc-sccs-next-revision): New functions.

--- a/lisp/vc-rcs.el	Wed Aug 26 14:47:23 2009 +0000
+++ b/lisp/vc-rcs.el	Wed Aug 26 17:54:05 2009 +0000
@@ -220,7 +220,7 @@
   (unless version (setq version (vc-working-revision file)))
   (with-temp-buffer
     (string= version
-	     (if (vc-trunk-p version)
+	     (if (vc-rcs-trunk-p version)
 		 (progn
 		   ;; Compare VERSION to the head version number.
 		   (vc-insert-file (vc-name file) "^[0-9]")
@@ -378,7 +378,7 @@
 	       (not (string= (vc-branch-part old-version)
 			     (vc-branch-part new-version))))
 	  (vc-rcs-set-default-branch file
-				     (if (vc-trunk-p new-version) nil
+				     (if (vc-rcs-trunk-p new-version) nil
 				       (vc-branch-part new-version)))
 	  ;; If this is an old RCS release, we might have
 	  ;; to remove a remaining lock.
@@ -438,7 +438,7 @@
 					 ;; use current workfile version
 					 workrev
 				       ;; REV is t ...
-				       (if (not (vc-trunk-p workrev))
+				       (if (not (vc-rcs-trunk-p workrev))
 					   ;; ... go to head of current branch
 					   (vc-branch-part workrev)
 					 ;; ... go to head of trunk
@@ -456,7 +456,7 @@
 		 (vc-rcs-set-default-branch
 		  file
 		  (if (vc-rcs-latest-on-branch-p file new-version)
-		      (if (vc-trunk-p new-version) nil
+		      (if (vc-rcs-trunk-p new-version) nil
 			(vc-branch-part new-version))
 		    new-version)))))
 	(message "Checking out %s...done" file))))))
@@ -468,7 +468,7 @@
       (error "RCS backend doesn't support directory-level rollback."))
   (dolist (file (vc-expand-dirs files))
 	  (let* ((discard (vc-working-revision file))
-		 (previous (if (vc-trunk-p discard) "" (vc-branch-part discard)))
+		 (previous (if (vc-rcs-trunk-p discard) "" (vc-branch-part discard)))
 		 (config (current-window-configuration))
 		 (done nil))
 	    (if (null (yes-or-no-p (format "Remove version %s from %s history? "
@@ -799,6 +799,95 @@
 ;;; Miscellaneous
 ;;;
 
+(defun vc-rcs-trunk-p (rev)
+  "Return t if REV is a revision on the trunk."
+  (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+
+(defun vc-rcs-minor-part (rev)
+  "Return the minor revision number of a revision number REV."
+  (string-match "[0-9]+\\'" rev)
+  (substring rev (match-beginning 0) (match-end 0)))
+
+(defun vc-rcs-previous-revision (file rev)
+  "Return the revision number immediately preceding REV for FILE,
+or nil if there is no previous revision.  This default
+implementation works for MAJOR.MINOR-style revision numbers as
+used by RCS and CVS."
+  (let ((branch (vc-branch-part rev))
+        (minor-num (string-to-number (vc-rcs-minor-part rev))))
+    (when branch
+      (if (> minor-num 1)
+          ;; revision does probably not start a branch or release
+          (concat branch "." (number-to-string (1- minor-num)))
+        (if (vc-rcs-trunk-p rev)
+            ;; we are at the beginning of the trunk --
+            ;; don't know anything to return here
+            nil
+          ;; we are at the beginning of a branch --
+          ;; return revision of starting point
+          (vc-branch-part branch))))))
+
+(defun vc-rcs-next-revision (file rev)
+  "Return the revision number immediately following REV for FILE,
+or nil if there is no next revision.  This default implementation
+works for MAJOR.MINOR-style revision numbers as used by RCS
+and CVS."
+  (when (not (string= rev (vc-working-revision file)))
+    (let ((branch (vc-branch-part rev))
+	  (minor-num (string-to-number (vc-rcs-minor-part rev))))
+      (concat branch "." (number-to-string (1+ minor-num))))))
+
+(defun vc-rcs-update-changelog (files)
+  "Default implementation of update-changelog.
+Uses `rcs2log' which only works for RCS and CVS."
+  ;; FIXME: We (c|sh)ould add support for cvs2cl
+  (let ((odefault default-directory)
+	(changelog (find-change-log))
+	;; Presumably not portable to non-Unixy systems, along with rcs2log:
+	(tempfile (make-temp-file
+		   (expand-file-name "vc"
+				     (or small-temporary-file-directory
+					 temporary-file-directory))))
+        (login-name (or user-login-name
+                        (format "uid%d" (number-to-string (user-uid)))))
+	(full-name (or add-log-full-name
+		       (user-full-name)
+		       (user-login-name)
+		       (format "uid%d" (number-to-string (user-uid)))))
+	(mailing-address (or add-log-mailing-address
+			     user-mail-address)))
+    (find-file-other-window changelog)
+    (barf-if-buffer-read-only)
+    (vc-buffer-sync)
+    (undo-boundary)
+    (goto-char (point-min))
+    (push-mark)
+    (message "Computing change log entries...")
+    (message "Computing change log entries... %s"
+	     (unwind-protect
+		 (progn
+		   (setq default-directory odefault)
+		   (if (eq 0 (apply 'call-process
+                                    (expand-file-name "rcs2log"
+                                                      exec-directory)
+                                    nil (list t tempfile) nil
+                                    "-c" changelog
+                                    "-u" (concat login-name
+                                                 "\t" full-name
+                                                 "\t" mailing-address)
+                                    (mapcar
+                                     (lambda (f)
+                                       (file-relative-name
+					(expand-file-name f odefault)))
+                                     files)))
+                       "done"
+		     (pop-to-buffer (get-buffer-create "*vc*"))
+		     (erase-buffer)
+		     (insert-file-contents tempfile)
+		     "failed"))
+	       (setq default-directory (file-name-directory changelog))
+	       (delete-file tempfile)))))
+
 (defun vc-rcs-check-headers ()
   "Check if the current file has any headers in it."
   (save-excursion