From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 31 Mar 2000 18:26:15 +0000 (+0000)
Subject: Add support for "manual" style CVS using "cvs edit" and "cvs unedit".
X-Git-Tag: 20090517-FFI~4128
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ef8e76f7f3d73c2347526665df7b4ef9b4537aa3;p=mit-scheme.git

Add support for "manual" style CVS using "cvs edit" and "cvs unedit".
---

diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index ef0b9fbb7..7dd4d2879 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: vc.scm,v 1.49 2000/03/31 17:03:42 cph Exp $
+;;; $Id: vc.scm,v 1.50 2000/03/31 18:26:15 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ;;;
@@ -496,7 +496,7 @@ merge in the changes into your working copy."
 			 ;; user!
 			 ((prompt-for-yes-or-no? "Revert to master version")
 			  (vc-backend-revert master)
-			  (vc-revert-buffer buffer #f))))))
+			  (vc-revert-buffer buffer #t))))))
 	      (do-checkout
 	       (lambda ()
 		 (vc-save-workfile-buffer workfile)
@@ -505,9 +505,14 @@ merge in the changes into your working copy."
 	      (case (cvs-status master)
 		((UP-TO-DATE)
 		 (let ((buffer (vc-workfile-buffer master)))
-		   (cond ((and buffer (buffer-modified? buffer))
+		   (cond ((or (and buffer (buffer-modified? buffer))
+			      (cvs-file-edited? master))
 			  (do-checkin))
-			 (revision?
+			 ((or revision?
+			      (string-prefix?
+			       "-r-"
+			       (file-attributes/mode-string
+				(file-attributes workfile))))
 			  (do-checkout))
 			 ((not from-dired?)
 			  (message (buffer-name buffer) " is up to date.")))))
@@ -793,13 +798,15 @@ to that version."
   (lambda ()
     (let* ((buffer (selected-buffer))
 	   (master (buffer-vc-master buffer #t)))
-      (if (and (vc-workfile-modified? master)
-	       (or (ref-variable vc-suppress-confirm)
-		   (cleanup-pop-up-buffers
-		    (lambda ()
-		      (run-diff master #f #f)
-		      (pop-up-vc-diff-buffer #f)
-		      (prompt-for-yes-or-no? "Discard changes")))))
+      (if (or (and (vc-workfile-modified? master)
+		   (or (ref-variable vc-suppress-confirm)
+		       (cleanup-pop-up-buffers
+			(lambda ()
+			  (run-diff master #f #f)
+			  (pop-up-vc-diff-buffer #f)
+			  (prompt-for-yes-or-no? "Discard changes")))))
+	      (and (eq? vc-type:cvs (vc-master-type master))
+		   (cvs-file-edited? master)))
 	  (begin
 	    (vc-backend-revert master)
 	    (vc-revert-buffer buffer #t))
@@ -1449,18 +1456,37 @@ the value of vc-log-mode-hook."
 	(%find-cvs-entry pathname (vc-master-workfile master))))))
 
 (define (%find-cvs-entry pathname workfile)
+  (let ((line
+	 (find-cvs-line pathname
+			(string-append "/" (file-namestring workfile) "/"))))
+    (and line
+	 (let ((tokens (cdr (burst-string line #\/ #f))))
+	   (and (fix:= 5 (length tokens))
+		tokens)))))
+
+(define (cvs-file-edited? master)
+  (let ((pathname
+	 (merge-pathnames "Baserev"
+			  (directory-pathname (vc-master-pathname master)))))
+    (read-cached-value-1 master 'CVS-FILE-EDITED? pathname
+      (lambda (time)
+	time
+	(find-cvs-line pathname
+		       (string-append
+			"B"
+			(file-namestring (vc-master-workfile master))
+			"/"))))))
+
+(define (find-cvs-line pathname prefix)
   (and (file-readable? pathname)
        (call-with-input-file pathname
 	 (lambda (port)
-	   (let ((prefix (string-append "/" (file-namestring workfile) "/")))
-	     (let loop ()
-	       (let ((line (read-line port)))
-		 (and (not (eof-object? line))
-		      (if (string-prefix? prefix line)
-			  (let ((tokens (cdr (burst-string line #\/ #f))))
-			    (and (fix:= 5 (length tokens))
-				 tokens))
-			  (loop))))))))))
+	   (let loop ()
+	     (let ((line (read-line port)))
+	       (and (not (eof-object? line))
+		    (if (string-prefix? prefix line)
+			line
+			(loop)))))))))
 
 (define (cvs-status master)
   (get-cvs-status master
@@ -1543,7 +1569,8 @@ the value of vc-log-mode-hook."
     ;; We consider the workfile's owner to be the locker.
     (and (or (not revision)
 	     (equal? revision (vc-backend-workfile-revision master)))
-	 (vc-workfile-modified? master)
+	 (or (vc-workfile-modified? master)
+	     (cvs-file-edited? master))
 	 (unix/uid->string
 	  (file-attributes/uid
 	   (file-attributes (vc-master-workfile master)))))))
@@ -1563,10 +1590,9 @@ the value of vc-log-mode-hook."
 
 (define-vc-type-operation 'CHECKOUT vc-type:cvs
   (lambda (master revision lock? workfile)
-    lock?				;locking not used with CVS
-    (cond (workfile
-	   (with-vc-command-message master "Checking out"
-	     (lambda ()
+    (with-vc-command-message master "Checking out"
+      (lambda ()
+	(cond (workfile
 	       ;; CVS makes it difficult to check a file out into
 	       ;; anything but the working file.
 	       (delete-file-no-errors workfile)
@@ -1574,13 +1600,13 @@ the value of vc-log-mode-hook."
 				     (cvs-rev-switch revision)
 				     (vc-master-workfile master)
 				     ">"
-				     workfile))))
-	  (revision
-	   ;; Checkout only necessary for given revision.
-	   (with-vc-command-message master "Checking out"
-	     (lambda ()
-	       (vc-run-command master '() "cvs" "update"
+				     workfile))
+	      (revision
+	       (vc-run-command master '() "cvs" (and lock? "-w") "update"
 			       (cvs-rev-switch revision)
+			       (vc-master-workfile master)))
+	      (else
+	       (vc-run-command master '() "cvs" "edit"
 			       (vc-master-workfile master))))))))
 
 (define-vc-type-operation 'CHECKIN vc-type:cvs
@@ -1619,8 +1645,11 @@ the value of vc-log-mode-hook."
     (with-vc-command-message master "Reverting"
       (lambda ()
 	(let ((workfile (vc-master-workfile master)))
-	  (delete-file-no-errors workfile)
-	  (vc-run-command master '() "cvs" "update" workfile))))))
+	  (if (cvs-file-edited? master)
+	      (vc-run-command master '() "cvs" "unedit" workfile)
+	      (begin
+		(delete-file-no-errors workfile)
+		(vc-run-command master '() "cvs" "update" workfile))))))))
 
 (define-vc-type-operation 'STEAL vc-type:cvs
   (lambda (master revision)