emacs: lisp/vc-rcs.el comparison

comparison lisp/vc-rcs.el @ 32094:027fb880735d

(vc-rcs-fetch-master-state): Parse and remember default branch unconditionally. (vc-rcs-set-default-branch): New function. (vc-rcs-cancel-version, vc-rcs-checkin, vc-rcs-checkout): Use it. (vc-rcs-checkin): If an appropriate default branch has been set, force creation of that branch.

author	André Spiegel <spiegel@gnu.org>
date	Tue, 03 Oct 2000 11:33:59 +0000
parents	4196f89984ce
children	e7f273d850bf

comparison

equal deleted inserted replaced

-:5c36fa51ee96
+:027fb880735d
 ;; Copyright (C) 1992,93,94,95,96,97,98,99,2000  Free Software Foundation, Inc.
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
-;; $Id: vc-rcs.el,v 1.8 2000/10/01 11:17:42 spiegel Exp $
+;; $Id: vc-rcs.el,v 1.9 2000/10/01 19:35:24 monnier Exp $
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 This function sets the properties `vc-workfile-version' and
 `vc-checkout-model' to their correct values, based on the master
 file."
 (with-temp-buffer
 (vc-insert-file (vc-name file) "^[0-9]")
-(let ((workfile-is-latest nil))
+(let ((workfile-is-latest nil)
+	  (default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
+(vc-file-setprop file 'vc-rcs-default-branch default-branch)
 (unless workfile-version
-	(let ((default-branch (vc-parse-buffer "^branch[ \t\n]+\\([^;]*\\);" 1)))
+	;; Workfile version not known yet.  Determine that first.  It
-	  ;; Workfile version not known yet.  Determine that first.  It
+	;; is either the head of the trunk, the head of the default
-	  ;; is either the head of the trunk, the head of the default
+	;; branch, or the "default branch" itself, if that is a full
-	  ;; branch, or the "default branch" itself, if that is a full
+	;; revision number.
-	  ;; revision number.
+	(cond
-	  (cond
+	 ;; no default branch
-	   ;; no default branch
+	 ((or (not default-branch) (string= "" default-branch))
-	   ((or (not default-branch) (string= "" default-branch))
+	  (setq workfile-version
+		(vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
+	  (setq workfile-is-latest t))
+	 ;; default branch is actually a revision
+	 ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
+			default-branch)
+	  (setq workfile-version default-branch))
+	 ;; else, search for the head of the default branch
+	 (t (vc-insert-file (vc-name file) "^desc")
 	    (setq workfile-version
-		  (vc-parse-buffer "^head[ \t\n]+\\([^;]+\\);" 1))
+		  (vc-rcs-find-most-recent-rev default-branch))
-	    (setq workfile-is-latest t))
+	    (setq workfile-is-latest t)))
-	   ;; default branch is actually a revision
+	(vc-file-setprop file 'vc-workfile-version workfile-version))
-	   ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$"
-			  default-branch)
-	    (setq workfile-version default-branch))
-	   ;; else, search for the head of the default branch
-	   (t (vc-insert-file (vc-name file) "^desc")
-	      (setq workfile-version
-		    (vc-rcs-find-most-recent-rev default-branch))
-	      (setq workfile-is-latest t)))
-	  (vc-file-setprop file 'vc-workfile-version workfile-version)))
 ;; Check strict locking
 (goto-char (point-min))
 (vc-file-setprop file 'vc-checkout-model
 		       (if (re-search-forward ";[ \t\n]*strict;" nil t)
 			   'locking 'implicit))
 	    (setq done t))
 	(error (set-buffer "*vc*")
 	       (goto-char (point-min))
 	       (if (search-forward "no side branches present for" nil t)
 		   (progn (setq previous (vc-branch-part previous))
-			  (vc-do-command nil 0 "rcs" (vc-name file)
+			  (vc-rcs-set-default-branch file previous)
-					 (concat "-b" previous))
 			  ;; vc-do-command popped up a window with
 			  ;; the error message.  Get rid of it, by
 			  ;; restoring the old window configuration.
 			  (set-window-configuration config))
 		 ;; No, it was some other error: re-signal it.
 (defun vc-rcs-checkin (file rev comment)
 "RCS-specific version of `vc-backend-checkin'."
 (let ((switches (if (stringp vc-checkin-switches)
 		      (list vc-checkin-switches)
 		    vc-checkin-switches)))
-(let ((old-version (vc-workfile-version file)) new-version)
+(let ((old-version (vc-workfile-version file)) new-version
+	  (default-branch (vc-file-getprop file 'vc-rcs-default-branch)))
+;; Force branch creation if an appropriate
+;; default branch has been set.
+(and (not rev)
+	   default-branch
+	   (string-match (concat "^" (regexp-quote old-version) "\\.")
+			 default-branch)
+	   (setq rev default-branch)
+	   (setq switches (cons "-f" switches)))
 (apply 'vc-do-command nil 0 "ci" (vc-name file)
 	     ;; if available, use the secure check-in option
 	     (and (vc-rcs-release-p "5.6.4") "-j")
 	     (concat (if vc-keep-workfiles "-u" "-r") rev)
 	     (concat "-m" comment)
-	     ;; allow creation of branches with no changes;
-	     ;; this is used by vc-rcs-receive-file if the
-	     ;; base version cannot be found
-	     (if (and (stringp rev) (string-match ".1.1$" rev)) "-f")
 	     switches)
 (vc-file-setprop file 'vc-workfile-version nil)
 ;; determine the new workfile version
 (set-buffer "*vc*")
 ;; branch accordingly
 (cond
 ((and old-version new-version
 	     (not (string= (vc-rcs-branch-part old-version)
 			   (vc-rcs-branch-part new-version))))
-	(vc-do-command nil 0 "rcs" (vc-name file)
+	(vc-rcs-set-default-branch file
-		       (if (vc-rcs-trunk-p new-version) "-b"
+				   (if (vc-rcs-trunk-p new-version) nil
-			 (concat "-b" (vc-rcs-branch-part new-version))))
+				     (vc-rcs-branch-part new-version)))
 	;; If this is an old RCS release, we might have
 	;; to remove a remaining lock.
 	(if (not (vc-rcs-release-p "5.6.2"))
 	    ;; exit status of 1 is also accepted.
 	    ;; It means that the lock was removed before.
 (defun vc-rcs-set-non-strict-locking (file)
 (vc-do-command nil 0 "rcs" file "-U")
 (vc-file-setprop file 'vc-checkout-model 'implicit)
 (set-file-modes file (logior (file-modes file) 128)))
+(defun vc-rcs-set-default-branch (file branch)
+(vc-do-command nil 0 "rcs" (vc-name file) (concat "-b" branch))
+(vc-file-setprop file 'vc-rcs-default-branch branch))
 (defun vc-rcs-checkout (file &optional writable rev workfile)
 "Retrieve a copy of a saved version of FILE into a workfile."
 (let ((filename (or workfile file))
 	(file-buffer (get-file-buffer file))
 		       (delete-file filename))))
 	    (let (new-version)
 	      ;; if we should go to the head of the trunk,
 	      ;; clear the default branch first
 	      (and rev (string= rev "")
-		   (vc-do-command nil 0 "rcs" (vc-name file) "-b"))
+		   (vc-rcs-set-default-branch file nil))
 	      ;; now do the checkout
 	      (apply 'vc-do-command
 		     nil 0 "co" (vc-name file)
 		     ;; If locking is not strict, force to overwrite
 		     ;; the writable workfile.
 		(setq new-version
 		      (vc-parse-buffer "^revision \\([0-9.]+\\).*\n" 1)))
 	      (vc-file-setprop file 'vc-workfile-version new-version)
 	      ;; if necessary, adjust the default branch
 	      (and rev (not (string= rev ""))
-		   (vc-do-command
+		   (vc-rcs-set-default-branch
-		    nil 0 "rcs" (vc-name file)
+		    file
-		    (concat "-b"
+		    (if (vc-rcs-latest-on-branch-p file new-version)
-			    (if (vc-rcs-latest-on-branch-p file new-version)
+			(if (vc-rcs-trunk-p new-version) nil
-				(if (vc-rcs-trunk-p new-version) nil
+			  (vc-rcs-branch-part new-version))
-				  (vc-rcs-branch-part new-version))
+		      new-version))))))
-			      new-version)))))))
 	(message "Checking out %s...done" filename)))))
 (provide 'vc-rcs)
 ;;; vc-rcs.el ends here

Mercurial > emacs

comparison lisp/vc-rcs.el @ 32094:027fb880735d