From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 23 Mar 2000 22:49:05 +0000 (+0000)
Subject: Implement CVS support for VC.  Bring the RCS support of VC more up to
X-Git-Tag: 20090517-FFI~4159
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1a20a700f7c025974151d4e11c5c0b681b4441e7;p=mit-scheme.git

Implement CVS support for VC.  Bring the RCS support of VC more up to
date.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index c438ea48e..32b99658f 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.245 2000/03/23 06:31:16 cph Exp $
+$Id: edwin.pkg,v 1.246 2000/03/23 22:48:47 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -1096,17 +1096,17 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    edwin-mode$vc-log
 	    edwin-variable$diff-switches
 	    edwin-variable$vc-checkin-hooks
-	    edwin-variable$vc-checkin-switches
 	    edwin-variable$vc-checkout-carefully
 	    edwin-variable$vc-command-messages
+	    edwin-variable$vc-display-status
 	    edwin-variable$vc-initial-comment
 	    edwin-variable$vc-keep-workfiles
 	    edwin-variable$vc-log-mode-hook
 	    edwin-variable$vc-make-backup-files
 	    edwin-variable$vc-mode-line-status
 	    edwin-variable$vc-rcs-preserve-mod-times
-	    edwin-variable$vc-rcs-status
-	    edwin-variable$vc-suppress-confirm))
+	    edwin-variable$vc-suppress-confirm
+	    vc-after-save))
 
   (define-package (edwin rcs-parse)
     (files "rcsparse")
diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 8a1338938..5e6cab758 100644
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: fileio.scm,v 1.150 2000/03/23 03:19:11 cph Exp $
+;;; $Id: fileio.scm,v 1.151 2000/03/23 22:48:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -568,7 +568,8 @@ Otherwise, a message is written both before and after long file writes."
 		   (lambda () unspecific)
 		   (lambda ()
 		     (os/restore-modes-to-updated-file! pathname
-							modes))))))))))
+							modes))))
+	      (vc-after-save buffer)))))))
 
 (define (verify-visited-file-modification-time? buffer)
   (let ((truename (buffer-truename buffer))
diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 7de65176f..d16b9f6ae 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: vc.scm,v 1.34 2000/03/23 03:19:25 cph Exp $
+;;; $Id: vc.scm,v 1.35 2000/03/23 22:49:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ;;;
@@ -48,7 +48,9 @@ Bound to #F if the buffer is not under version control."
   boolean?)
 
 (define-variable vc-keep-workfiles
-  "If true, don't delete working files after registering changes."
+  "If true, don't delete working files after registering changes.
+If the back-end is CVS, workfiles are always kept, regardless of the
+value of this flag."
   #t
   boolean?)
 
@@ -62,11 +64,6 @@ Bound to #F if the buffer is not under version control."
   #f
   boolean?)
 
-(define-variable vc-checkin-switches
-  "Extra switches passed to the checkin program by \\[vc-checkin]."
-  '()
-  list-of-strings?)
-
 (define-variable diff-switches
   "A list of strings specifying switches to be be passed to diff."
   '("-c")
@@ -91,8 +88,8 @@ and that its contents match what the master file says."
   "An event distributor that is invoked when entering VC-log mode."
   (make-event-distributor))
 
-(define-variable vc-rcs-status
-  "If true, revision and locks on RCS working file displayed in modeline.
+(define-variable vc-display-status
+  "If true, display revision number and lock status in modeline.
 Otherwise, not displayed."
   #t
   boolean?)
@@ -106,6 +103,7 @@ Otherwise, the mod time of the file is the checkout time."
 ;;;; Editor Hooks
 
 (define (vc-find-file-hook buffer)
+  (buffer-remove! buffer 'VC-MASTER)
   (let ((master (buffer-vc-master buffer)))
     (vc-mode-line master buffer)
     (if (and master (not (ref-variable vc-make-backup-files buffer)))
@@ -133,21 +131,57 @@ Otherwise, the mod time of the file is the checkout time."
       (set-variable! find-file-not-found-hooks
 		     (append! hooks (list vc-file-not-found-hook)))))
 
-(define (vc-mode-line master buffer)
-  (let ((variable (ref-variable-object vc-mode-line-status)))
+(define (vc-after-save buffer)
+  (let ((master (buffer-vc-master buffer)))
     (if master
-	(set-variable-local-value!
-	 buffer
-	 variable
-	 (string-append " " (vc-mode-line-status master buffer)))
-	(undefine-variable-local-value! buffer variable)))
-  ;; root shouldn't modify a registered file without locking it first.
-  (if (and master
-	   (= 0 (unix/current-uid))
-	   (not (let ((locking-user (vc-locking-user master #f)))
-		  (and locking-user
-		       (string=? locking-user (current-user-name))))))
-      (set-buffer-read-only! buffer)))
+	(vc-mode-line master buffer))))
+
+(define (vc-mode-line master buffer)
+  (let ((buffer (or buffer (vc-workfile-buffer master))))
+    (let ((variable (ref-variable-object vc-mode-line-status)))
+      (if master
+	  (set-variable-local-value!
+	   buffer
+	   variable 
+	   (string-append " "
+			  (vc-type-display-name (vc-master-type master))
+			  (if (ref-variable vc-display-status buffer)
+			      (vc-mode-line-status master)
+			      "")))
+	  (undefine-variable-local-value! buffer variable)))
+    (buffer-modeline-event! buffer 'VC-MODE-LINE-STATUS)
+    (if (and master
+	     (buffer-writeable? buffer)
+	     (eq? buffer (vc-workfile-buffer master))
+	     ;; If the file is locked by some other user, make the
+	     ;; buffer read-only.  Like this, even root cannot modify a
+	     ;; file that someone else has locked.
+	     (or (let ((locking-user (vc-locking-user master #f)))
+		   (and locking-user
+			(not (string=? locking-user (current-user-name)))))
+		 ;; If the user is root, and the file is not
+		 ;; owner-writeable, then pretend that we can't write it
+		 ;; even though we can (because root can write
+		 ;; anything).  This way, even root cannot modify a file
+		 ;; that isn't locked.
+		 (and (= 0 (unix/current-uid))
+		      (fix:= 0
+			     (fix:and #o200
+				      (file-modes
+				       (vc-workfile-pathname master)))))))
+	(set-buffer-read-only! buffer))))
+
+(define (vc-mode-line-status master)
+  (let ((revision
+	 (or (vc-workfile-version master)
+	     (vc-default-version master #f))))
+    (if revision
+	(let ((locker (vc-locking-user master revision)))
+	  (string-append (cond ((not locker) "-")
+			       ((string=? locker (current-user-name)) ":")
+			       (else (string-append ":" locker ":")))
+			 revision))
+	" @@")))
 
 ;;;; Primary Commands
 
@@ -225,9 +259,7 @@ lock steals will raise an error.
   (let ((master (file-vc-master workfile)))
     (if (not master)
 	(vc-register workfile revision comment 'LOCK)
-	(let ((revision
-	       (or (vc-get-version revision "Version level to act on")
-		   (vc-workfile-version master))))
+	(let* ((revision (vc-get-version revision "Version level to act on")))
 	  (let ((owner (vc-locking-user master revision)))
 	    (cond ((not owner)
 		   (vc-checkout master revision))
@@ -264,23 +296,18 @@ lock steals will raise an error.
 	       (not (file-exists? workfile)))
 	  (buffer-modified! buffer)))
     (vc-save-workfile-buffer workfile)
-    (let ((keep? (or keep? (vc-keep-workfiles? workfile))))
-      (vc-start-entry workfile
-		      "Enter initial comment."
-		      (or comment
-			  (if (ref-variable vc-initial-comment
-					    (vc-workfile-buffer workfile))
-			      #f
-			      ""))
+    (vc-start-entry workfile
+		    "Enter initial comment."
+		    (or comment
+			(if (ref-variable vc-initial-comment
+					  (vc-workfile-buffer workfile))
+			    #f
+			    ""))
+		    (let ((keep? (or keep? (vc-keep-workfiles? workfile))))
 		      (lambda (comment)
-			(vc-backend-register workfile revision comment)
-			(if keep?
-			    (vc-backend-checkout (file-vc-master workfile #t)
-						 revision
-						 (eq? 'LOCK keep?)
-						 #f))
-			(vc-update-workfile-buffer workfile keep?))
-		      #f))))
+			(vc-backend-register workfile revision comment keep?)
+			(vc-update-workfile-buffer workfile keep?)))
+		    #f)))
 
 (define (vc-checkout master revision)
   (let ((revision
@@ -313,7 +340,7 @@ lock steals will raise an error.
 		   (string-append "File has unlocked changes, "
 				  "claim lock retaining changes")))))
 	     (guarantee-vc-master-valid master)
-	     (vc-backend-claim-lock master revision)
+	     (vc-backend-steal master revision)
 	     (let ((buffer (vc-workfile-buffer master)))
 	       (if buffer
 		   (vc-mode-line master buffer))))
@@ -323,24 +350,27 @@ lock steals will raise an error.
 	     (editor-error "Checkout aborted."))))))
 
 (define (vc-checkin master revision comment)
-  (let ((revision
-	 (or (vc-get-version revision "New version level")
-	     (vc-workfile-version master)))
-	(keep? (vc-keep-workfiles? master)))
+  (let ((revision (vc-get-version revision "New version level")))
     (vc-save-workfile-buffer master)
     (vc-start-entry master
 		    "Enter a change comment."
 		    comment
-		    (lambda (comment)
-		      (vc-backend-checkin master revision comment)
-		      (if keep?
-			  (vc-backend-checkout master revision #f #f))
-		      (vc-update-workfile-buffer master keep?))
+		    (let ((keep? (vc-keep-workfiles? master)))
+		      (lambda (comment)
+			(vc-backend-checkin master revision
+					    (if (blank-string? comment)
+						"*** empty log message ***"
+						comment)
+					    keep?)
+			(vc-update-workfile-buffer master keep?)))
 		    (lambda ()
 		      (event-distributor/invoke!
 		       (ref-variable vc-checkin-hooks
 				     (vc-workfile-buffer master))
 		       master)))))
+
+(define (blank-string? string)
+  (not (string-find-next-char-in-set string char-set:not-whitespace)))
 
 (define (vc-revert master revision)
   (let ((revision
@@ -447,7 +477,7 @@ If `F.~REV~' already exists, it is used instead of being re-created."
     (let ((master (current-vc-master #t)))
       (let ((revision
 	     (or (vc-normalize-version revision)
-		 (vc-backend-default-version master))))
+		 (vc-default-version master #t))))
 	(let ((workfile
 	       (string-append (->namestring (vc-master-workfile master))
 			      ".~"
@@ -490,15 +520,6 @@ Headers are inserted at the start of the buffer."
     (vc-backend-print-log (current-vc-master #t))
     (pop-up-vc-command-buffer #f)))
 
-(define-command vc-list-locked-files
-  "List the current directory's locked files in a window.
-Normally lists only those files locked by the user;
-prefix arg says to list all locked files regardless."
-  "P"
-  (lambda (all-lockers?)
-    (vc-backend-list-locked-files (current-vc-master #t) all-lockers?)
-    (pop-up-vc-command-buffer #f)))
-
 (define-command vc-revert-buffer
   "Revert the current buffer's file back to the latest checked-in version.
 This asks for confirmation if the buffer contents are not identical
@@ -773,42 +794,21 @@ the value of vc-log-mode-hook."
 	  #f))))
 
 (define (%file-vc-master workfile require-master?)
-  (let ((master (hash-table/get vc-master-table workfile #f)))
-    (if (and master (vc-master-valid? master))
-	master
-	(begin
-	  (if master
-	      (hash-table/remove! vc-master-table workfile))
-	  (let loop ((templates vc-master-templates))
-	    (if (null? templates)
-		(begin
-		  (if require-master? (vc-registration-error workfile))
-		  #f)
-		(let ((master
-		       (make-vc-master (cdar templates)
-				       ((caar templates) workfile)
-				       workfile)))
-		  (if (vc-master-valid? master)
-		      (begin
-			(hash-table/put! vc-master-table workfile master)
-			master)
-		      (loop (cdr templates))))))))))
-
-(define vc-master-table
-  ;; EQUAL-HASH-MOD happens to work correctly here, because a pathname
-  ;; has the same hash value as its namestring.
-  ((weak-hash-table/constructor equal-hash-mod pathname=? #t)))
+  (let ((workfile (->pathname workfile)))
+    (let loop ((templates vc-master-templates))
+      (if (null? templates)
+	  (begin
+	    (if require-master? (vc-registration-error workfile))
+	    #f)
+	  (let ((master ((car templates) workfile)))
+	    (if (and master (vc-master-valid? master))
+		master
+		(loop (cdr templates))))))))
 
 (define (guarantee-vc-master-valid master)
   (if (not (vc-master-valid? master))
       (error "VC master file disappeared:" (vc-master-workfile master))))
 
-(define (vc-master-valid? master)
-  ;; FILE-EQ? yields #f if either file doesn't exist.
-  (let ((pathname (vc-master-pathname master)))
-    (and (file-exists? pathname)
-	 (not (file-eq? (vc-master-workfile master) pathname)))))
-
 (define (vc-registration-error object)
   (if (or (buffer? object) (not object))
       (editor-error "Buffer "
@@ -826,16 +826,54 @@ the value of vc-log-mode-hook."
   (pathname #f read-only #t)
   (workfile #f read-only #t)
   (checkout-time #f)
-  (%time #f)
-  (%admin #f))
+  (properties (make-1d-table) read-only #t))
+
+(define (vc-master-get master key default)
+  (1d-table/get (vc-master-properties master) key default))
+
+(define (vc-master-put! master key value)
+  (1d-table/put! (vc-master-properties master) key value))
+
+(define (vc-master-remove! master key)
+  (1d-table/remove! (vc-master-properties master) key))
+
+(define (sync-checkout-time! master unchanged?)
+  (set-vc-master-checkout-time!
+   master
+   (and unchanged?
+	(file-modification-time-indirect (vc-workfile-pathname master))))
+  (vc-mode-line master #f))
 
-(define-structure (vc-type (constructor %make-vc-type (name header-keyword)))
+(define (vc-master-read-cached-value master key read-value)
+  (let ((pathname (vc-master-pathname master)))
+    (let loop ()
+      (let ((time (file-modification-time-indirect pathname)))
+	(or (and (eqv? time (vc-master-get master 'MASTER-TIME #f))
+		 (vc-master-get master key #f))
+	    (begin
+	      (vc-master-put! master 'MASTER-TIME time)
+	      (vc-master-put! master key (read-value))
+	      (loop)))))))
+
+(define-structure (vc-type (constructor %make-vc-type
+					(name display-name header-keyword)))
   (name #f read-only #t)
+  (display-name #f read-only #t)
   (header-keyword #f read-only #t)
-  (operations '()))
+  (operations '())
+  (properties (make-1d-table) read-only #t))
+
+(define (vc-type-get type key default)
+  (1d-table/get (vc-type-properties type) key default))
 
-(define (make-vc-type name header-keyword)
-  (let ((type (%make-vc-type name header-keyword))
+(define (vc-type-put! type key value)
+  (1d-table/put! (vc-type-properties type) key value))
+
+(define (vc-type-remove! type key)
+  (1d-table/remove! (vc-type-properties type) key))
+
+(define (make-vc-type name display-name header-keyword)
+  (let ((type (%make-vc-type name display-name header-keyword))
 	(entry (assq name vc-types)))
     (if entry
 	(set-cdr! entry type)
@@ -845,14 +883,54 @@ the value of vc-log-mode-hook."
 (define vc-types
   '())
 
-(define (define-vc-master-template vc-type pathname-map)
-  (set! vc-master-templates
-	(cons (cons pathname-map vc-type)
-	      vc-master-templates))
+(define (define-vc-master-template pathname-map)
+  (set! vc-master-templates (cons pathname-map vc-master-templates))
   unspecific)
 
 (define vc-master-templates
   '())
+
+(define (vc-release? type release)
+  (let ((release* (vc-release type)))
+    (and release*
+	 (release<=? release release*))))
+
+(define (vc-release type)
+  (let ((release (vc-type-get type 'RELEASE 'UNKNOWN)))
+    (if (eq? 'UNKNOWN release)
+	(let ((release ((vc-type-operation type 'RELEASE))))
+	  (vc-type-put! type 'RELEASE release)
+	  release)
+	release)))
+
+(define (release<=? r1 r2)
+  ;; Compare release numbers, represented as strings.
+  ;; Release components are assumed cardinal numbers, not decimal
+  ;; fractions (5.10 is a higher release than 5.9).  Omitted fields
+  ;; are considered lower (5.6.7 is earlier than 5.6.7.1).
+  ;; Comparison runs till the end of the string is found, or a
+  ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta",
+  ;; which is probably not what you want in some cases).
+  ;;   This code is suitable for existing RCS release numbers.  
+  ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5).
+  (let ((t1 (burst-string r1 #\space #t))
+	(t2 (burst-string r2 #\space #t)))
+    (let loop
+	((ns1 (burst-string (car t1) #\. #f))
+	 (ns2 (burst-string (car t2) #\. #f)))
+      (if (pair? ns1)
+	  (and (pair? ns2)
+	       (let ((n1 (string->number (car ns1)))
+		     (n2 (string->number (car ns2))))
+		 (or (< n1 n2)
+		     (and (= n1 n2)
+			  (loop (cdr ns1) (cdr ns2))))))
+	  (or (pair? ns2)
+	      (not (pair? (cdr t1)))
+	      (pair? (cdr t2)))))))
+
+(define (trunk-revision? revision)
+  (re-string-match "\\`[0-9]+\\.[0-9]+\\'" revision))
 
 (define (define-vc-type-operation name type procedure)
   (let ((entry (assq name (vc-type-operations type))))
@@ -873,7 +951,7 @@ the value of vc-log-mode-hook."
 
 ;;;; Back-End Calls
 
-(define (vc-backend-register workfile revision comment)
+(define (vc-backend-register workfile revision comment keep?)
   ((vc-type-operation
     (if (and (not (null? vc-types))
 	     (null? (cdr vc-types)))
@@ -900,27 +978,19 @@ the value of vc-log-mode-hook."
 					 #f
 					 #f))))))
     'REGISTER)
-   workfile revision comment))
-
-(define (vc-backend-claim-lock master revision)
-  (vc-call 'CLAIM-LOCK master revision))
+   workfile revision comment keep?))
 
 (define (vc-backend-checkout master revision lock? workfile)
-  (let ((workfile
-	 (and workfile
-	      (not (pathname=? workfile (vc-workfile-pathname master)))
-	      workfile)))
-    (vc-call 'CHECKOUT master revision lock? workfile)
-    (if (and (not revision) (not workfile))
-	(set-vc-master-checkout-time!
-	 master
-	 (file-modification-time-indirect (vc-workfile-pathname master))))))
+  (vc-call 'CHECKOUT master revision lock?
+	   (and workfile
+		(not (pathname=? workfile (vc-workfile-pathname master)))
+		workfile)))
 
 (define (vc-backend-revert master revision)
   (vc-call 'REVERT master revision))
 
-(define (vc-backend-checkin master revision comment)
-  (vc-call 'CHECKIN master revision comment))
+(define (vc-backend-checkin master revision comment keep?)
+  (vc-call 'CHECKIN master revision comment keep?))
 
 (define (vc-backend-steal master revision)
   (vc-call 'STEAL master revision))
@@ -929,70 +999,70 @@ the value of vc-log-mode-hook."
   (vc-call 'LOGENTRY-CHECK master log-buffer))
 
 (define (vc-backend-diff master rev1 rev2 simple?)
-  (vc-call 'DIFF master rev1 rev2 simple?))
+  (let ((result (vc-call 'DIFF master rev1 rev2 simple?)))
+    (if (and (or (not rev1) (equal? rev1 (vc-workfile-version master)))
+	     (not rev2))
+	(sync-checkout-time! master (= 0 result)))
+    result))
 
 (define (vc-backend-print-log master)
   (vc-call 'PRINT-LOG master))
-      
-(define (vc-backend-list-locked-files master all-lockers?)
-  (vc-call 'LIST-LOCKED-FILES master all-lockers?))
 
-(define (vc-backend-default-version master)
-  (vc-call 'DEFAULT-VERSION master))
+(define (vc-default-version master error?)
+  (vc-call 'DEFAULT-VERSION master error?))
 
-(define (vc-backend-buffer-version master buffer)
-  (vc-call 'BUFFER-VERSION master buffer))
+(define (vc-workfile-version master)
+  (vc-call 'WORKFILE-VERSION master))
 
 (define (vc-locking-user master revision)
   (vc-call 'LOCKING-USER master revision))
 
-(define (vc-mode-line-status master buffer)
-  (vc-call 'MODE-LINE-STATUS master buffer))
-
-(define (vc-admin master)
-  (let ((pathname (vc-master-pathname master)))
-    (let loop ()
-      (let ((time (file-modification-time-indirect pathname)))
-	(or (and (eqv? (vc-master-%time master) time)
-		 (vc-master-%admin master))
-	    (begin
-	      (set-vc-master-%time! master time)
-	      (set-vc-master-%admin! master (vc-call 'GET-ADMIN master))
-	      (loop)))))))
-
 (define (vc-backend-check-headers master buffer)
   (vc-call 'CHECK-HEADERS master buffer))
+
+(define (vc-master-valid? master)
+  (vc-call 'VALID? master))
 
 ;;;; RCS Commands
 
 (define vc-type:rcs
   ;; Splitting up string constant prevents RCS from expanding this
   ;; keyword.
-  (make-vc-type 'RCS (string-append "$" "Id" "$")))
-
-(define-vc-master-template vc-type:rcs
-  (lambda (pathname)
-    (merge-pathnames (string-append (file-namestring pathname) ",v")
-		     (let ((pathname (directory-pathname pathname)))
-		       (pathname-new-directory
-			pathname
-			(append (pathname-directory pathname)
-				'("RCS")))))))
-
-(define-vc-master-template vc-type:rcs
-  (lambda (pathname)
-    (merge-pathnames (string-append (file-namestring pathname) ",v")
-		     (directory-pathname pathname))))
-
-(define-vc-master-template vc-type:rcs
-  (lambda (pathname)
-    (pathname-new-directory pathname
-			    (append (pathname-directory pathname)
+  (make-vc-type 'RCS "RCS" (string-append "$" "Id" "$")))
+
+(define (rcs-directory workfile)
+  (let ((directory (directory-pathname workfile)))
+    (pathname-new-directory directory
+			    (append (pathname-directory directory)
 				    '("RCS")))))
 
+(let ((rcs-template
+       (lambda (transform)
+	 (define-vc-master-template
+	   (lambda (workfile)
+	     (make-vc-master vc-type:rcs (transform workfile) workfile)))))
+      (in-rcs-directory
+       (lambda (pathname)
+	 (merge-pathnames (file-pathname pathname)
+			  (rcs-directory pathname))))
+      (rcs-file
+       (lambda (pathname)
+	 (merge-pathnames (string-append (file-namestring pathname) ",v")
+			  (directory-pathname pathname)))))
+  (rcs-template (lambda (workfile) (rcs-file (in-rcs-directory workfile))))
+  (rcs-template in-rcs-directory)
+  (rcs-template rcs-file))
+
+(define-vc-type-operation 'VALID? vc-type:rcs
+  (lambda (master)
+    ;; FILE-EQ? yields #f if either file doesn't exist.
+    (let ((pathname (vc-master-pathname master)))
+      (and (file-exists? pathname)
+	   (not (file-eq? (vc-master-workfile master) pathname))))))
+
 (define-vc-type-operation 'LOCKING-USER vc-type:rcs
   (lambda (master revision)
-    (let ((admin (vc-admin master)))
+    (let ((admin (get-rcs-admin master)))
       (let ((delta (rcs-find-delta admin revision #f)))
 	(if delta
 	    (let loop ((locks (rcs-admin/locks admin)))
@@ -1003,63 +1073,45 @@ the value of vc-log-mode-hook."
 	    ;; Kludge: this causes the next action to be a checkin.
 	    (current-user-name))))))
 
-(define-vc-type-operation 'MODE-LINE-STATUS vc-type:rcs
-  (lambda (master buffer)
-    (and (ref-variable vc-rcs-status buffer)
-	 (string-append
-	  "RCS"
-	  (let ((admin (vc-admin master)))
-	    (let ((locks (rcs-admin/locks admin)))
-	      (if (not (null? locks))
-		  (apply string-append
-			 (let ((user (current-user-name)))
-			   (map (lambda (lock)
-				  (string-append
-				   ":"
-				   (let ((rev (rcs-delta/number (cdr lock))))
-				     (if (string=? user (car lock))
-					 rev
-					 (string-append (car lock) ":" rev)))))
-				locks)))
-		  (let ((head (rcs-admin/head admin)))
-		    (if head
-			(string-append "-" (rcs-delta/number head))
-			" @@")))))))))
-
-(define-vc-type-operation 'GET-ADMIN vc-type:rcs
-  (lambda (master)
-    (parse-rcs-admin (vc-master-pathname master))))
+(define (get-rcs-admin master)
+  (vc-master-read-cached-value master 'RCS-ADMIN
+    (lambda ()
+      (parse-rcs-admin (vc-master-pathname master)))))
 
 (define-vc-type-operation 'CHECK-HEADERS vc-type:rcs
   (lambda (master buffer)
     master
-    (re-search-forward (string-append "\\$[A-Za-z\300-\326\330-\366\370-\377]+"
-				      "\\(: [\t -#%-\176\240-\377]*\\)?\\$")
-		       (buffer-start buffer)
-		       (buffer-end buffer))))
+    (check-rcs-headers buffer)))
+
+(define (check-rcs-headers buffer)
+  (re-search-forward (string-append "\\$[A-Za-z\300-\326\330-\366\370-\377]+"
+				    "\\(: [\t -#%-\176\240-\377]*\\)?\\$")
+		     (buffer-start buffer)
+		     (buffer-end buffer)))
 
 (define-vc-type-operation 'LIKELY-CONTROL-TYPE? vc-type:rcs
   (lambda (workfile)
-    (file-directory?
-     (let ((directory (directory-pathname workfile)))
-       (pathname-new-directory directory
-			       (append (pathname-directory directory)
-				       '("RCS")))))))
+    (file-directory? (rcs-directory workfile))))
 
 (define-vc-type-operation 'REGISTER vc-type:rcs
-  (lambda (workfile revision comment)
+  (lambda (workfile revision comment keep?)
     (with-vc-command-message workfile "Registering"
       (lambda ()
-	(vc-run-command workfile 0 "ci"
-			(rcs-rev-switch "-r" revision)
+	(vc-run-command workfile '() "ci"
+			(and (vc-release? vc-type:rcs "5.6.4") "-i")
+			(rcs-rev-switch (cond ((not keep?) "-r")
+					      ((eq? 'LOCK keep?) "-l")
+					      (else "-u"))
+					revision)
 			(string-append "-t-" comment)
 			(vc-workfile-pathname workfile))))))
 
-(define-vc-type-operation 'CLAIM-LOCK vc-type:rcs
-  (lambda (master revision)
-    (vc-run-command master 0 "rcs"
-		    (rcs-rev-switch "-l" revision)
-		    (vc-workfile-pathname master))))
+(define-vc-type-operation 'RELEASE vc-type:rcs
+  (lambda ()
+    (and (= 0 (vc-run-command #f '() "rcs" "-V"))
+	 (re-search-forward "^RCS version \\([0-9.]+ *.*\\)"
+			    (buffer-start (get-vc-command-buffer)))
+	 (extract-string (re-match-start 1) (re-match-end 1)))))
 
 (define-vc-type-operation 'CHECKOUT vc-type:rcs
   (lambda (master revision lock? workfile)
@@ -1070,45 +1122,60 @@ the value of vc-log-mode-hook."
 	    ;; but the working file.
 	    (begin
 	      (delete-file-no-errors workfile)
-	      (vc-run-shell-command master 0 "co"
+	      (vc-run-shell-command master '() "co"
 				    (rcs-rev-switch "-p" revision)
 				    (vc-workfile-pathname master)
 				    ">"
 				    workfile)
 	      (set-file-modes! workfile (if lock? #o644 #o444)))
-	    (vc-run-command master 0 "co"
+	    (vc-run-command master '() "co"
 			    (rcs-rev-switch (if lock? "-l" "-r") revision)
 			    (rcs-mtime-switch master)
-			    (vc-workfile-pathname master)))))))
-
+			    (vc-workfile-pathname master)))))
+    (if (and (not revision) (not workfile))
+	(sync-checkout-time! master #t))))
+
 (define-vc-type-operation 'REVERT vc-type:rcs
   (lambda (master revision)
     (with-vc-command-message master "Reverting"
       (lambda ()
-	(vc-run-command master 0 "co"
+	(vc-run-command master '() "co"
 			"-f"
 			(rcs-rev-switch "-u" revision)
 			(rcs-mtime-switch master)
 			(vc-workfile-pathname master))))))
 
 (define-vc-type-operation 'CHECKIN vc-type:rcs
-  (lambda (master revision comment)
+  (lambda (master revision comment keep?)
     (with-vc-command-message master "Checking in"
       (lambda ()
-	(vc-run-command master 0 "ci"
-			(rcs-rev-switch "-r" revision)
+	(vc-run-command master '() "ci"
+			;; If available, use the secure check-in option.
+			(and (vc-release? vc-type:rcs "5.6.4") "-j")
+			(rcs-rev-switch (if keep? "-u" "-r") revision)
 			(string-append "-m" comment)
 			(vc-workfile-pathname master))))))
 
 (define-vc-type-operation 'STEAL vc-type:rcs
   (lambda (master revision)
+    (if (not (vc-release? vc-type:rcs "5.6.2"))
+	(error "Unable to steal locks with this version of RCS."))
     (with-vc-command-message master "Stealing lock on"
       (lambda ()
-	(vc-run-command master 0 "rcs"
+	(vc-run-command master '() "rcs"
 			"-M"
 			(rcs-rev-switch "-u" revision)
 			(rcs-rev-switch "-l" revision)
 			(vc-workfile-pathname master))))))
+
+(define (rcs-rev-switch switch revision)
+  (if revision
+      (string-append switch revision)
+      switch))
+
+(define (rcs-mtime-switch master)
+  (and (ref-variable vc-rcs-preserve-mod-times (vc-workfile-buffer master))
+       "-M"))
 
 (define-vc-type-operation 'LOGENTRY-CHECK vc-type:rcs
   (lambda (master log-buffer)
@@ -1117,98 +1184,374 @@ the value of vc-log-mode-hook."
 
 (define-vc-type-operation 'DIFF vc-type:rcs
   (lambda (master rev1 rev2 simple?)
-    (vc-run-command master 1 "rcsdiff"
-		    "-q"
-		    (and rev1 (string-append "-r" rev1))
-		    (and rev2 (string-append "-r" rev2))
-		    (if simple?
-			'()
-			(ref-variable diff-switches
-				      (vc-workfile-buffer master)))
-		    (vc-workfile-pathname master))))
+    (let ((type (vc-master-type master))
+	  (run-diff
+	   (lambda (status brief?)
+	     (vc-run-command master
+			     `((STATUS ,status)
+			       ,@(if simple? `((BUFFER " *vc-diff*")) '()))
+			     "rcsdiff"
+			     (and brief? "--brief")
+			     "-q"
+			     (and rev1 (string-append "-r" rev1))
+			     (and rev2 (string-append "-r" rev2))
+			     (if simple?
+				 '()
+				 (ref-variable diff-switches
+					       (vc-workfile-buffer master)))
+			     (vc-workfile-pathname master)))))
+      (if (or (not simple?) (vc-type-get type 'RCSDIFF-NO-BRIEF? #f))
+	  (run-diff 1 #f)
+	  (let ((status (run-diff 2 #t)))
+	    (if (= 2 status)
+		(begin
+		  (vc-type-put! type 'RCSDIFF-NO-BRIEF? #t)
+		  (run-diff 1 #f))
+		status))))))
 
 (define-vc-type-operation 'PRINT-LOG vc-type:rcs
   (lambda (master)
-    (vc-run-command master 0 "rlog" (vc-workfile-pathname master))))
-
-(define-vc-type-operation 'LIST-LOCKED-FILES vc-type:rcs
-  (lambda (master all-lockers?)
-    (vc-run-shell-command master 0 "rlog"
-			  "-L -R"
-			  (and (not all-lockers?)
-			       (string-append "-l" (current-user-name)))
-			  (merge-pathnames
-			   "*,v"
-			   (directory-pathname (vc-master-pathname master))))))
+    (vc-run-command master '() "rlog" (vc-workfile-pathname master))))
 
 (define-vc-type-operation 'DEFAULT-VERSION vc-type:rcs
+  (lambda (master error?)
+    (let ((delta (rcs-find-delta (get-rcs-admin master) #f error?)))
+      (and delta
+	   (rcs-delta/number delta)))))
+
+(define-vc-type-operation 'WORKFILE-VERSION vc-type:rcs
   (lambda (master)
-    (rcs-delta/number (rcs-find-delta (vc-admin master) #f #t))))
+    (let ((parse-buffer
+	   (lambda (buffer)
+	     (let ((start (buffer-start buffer))
+		   (end (buffer-end buffer)))
+	       (let ((find-keyword
+		      (lambda (keyword)
+			(let ((mark
+			       (search-forward (string-append "$" keyword ":")
+					       start end #f)))
+			  (and mark
+			       (skip-chars-forward " " mark end #f)))))
+		     (get-version
+		      (lambda (start)
+			(let ((end (skip-chars-forward "0-9." start end)))
+			  (and (mark< start end)
+			       (let ((revision (extract-string start end)))
+				 (let ((length (rcs-number-length revision)))
+				   (and (> length 2)
+					(even? length)
+					(rcs-number-head revision
+							 (- length 1)
+							 #f)))))))))
+		 (cond ((or (find-keyword "Id") (find-keyword "Header"))
+			=> (lambda (mark)
+			     (get-version
+			      (skip-chars-forward
+			       " "
+			       (skip-chars-forward "^ " mark end)
+			       end))))
+		       ((find-keyword "Revision") => get-version)
+		       (else #f)))))))
+      (let ((pathname (vc-workfile-pathname master)))
+	(let ((buffer (pathname->buffer pathname)))
+	  (if buffer
+	      (parse-buffer buffer)
+	      (call-with-temporary-buffer " *VC-temp*"
+		(lambda (buffer)
+		  (catch-file-errors (lambda () #f)
+		    (lambda ()
+		      (read-buffer buffer pathname #f)
+		      (parse-buffer buffer)))))))))))
+
+;;;; CVS Commands
 
-(define-vc-type-operation 'BUFFER-VERSION vc-type:rcs
+(define vc-type:cvs
+  (make-vc-type 'CVS "CVS" (string-append "$" "Id" "$")))
+
+(define-vc-master-template
+  (lambda (workfile)
+    (find-cvs-master workfile)))
+
+(define (find-cvs-master workfile)
+  (let* ((entries-file (merge-pathnames "Entries" (cvs-directory workfile)))
+	 (master (make-vc-master vc-type:cvs entries-file workfile))
+	 (time (file-modification-time-indirect entries-file))
+	 (tokens (find-cvs-entry master)))
+    (and tokens
+	 (begin
+	   (vc-master-put! master 'MASTER-TIME time)
+	   (vc-master-put! master 'CVS-WORKFILE-VERSION (cadr tokens))
+	   (let ((mtime (file-modification-time-indirect workfile)))
+	     (if (string=? (file-time->global-ctime-string mtime)
+			   (caddr tokens))
+		 (set-vc-master-checkout-time! master mtime)
+		 (vc-backend-diff master #f #f #t)))
+	   master))))
+
+(define (cvs-directory workfile)
+  (let ((directory (directory-pathname workfile)))
+    (pathname-new-directory directory
+			    (append (pathname-directory directory)
+				    '("CVS")))))
+
+(define (get-cvs-workfile-version master error?)
+  (vc-master-read-cached-value master 'CVS-WORKFILE-VERSION
+    (lambda ()
+      (let ((tokens (find-cvs-entry master)))
+	(if tokens
+	    (cadr tokens)
+	    (and error?
+		 (error "Workfile has no version:"
+			(vc-master-workfile master))))))))
+
+(define (find-cvs-entry master)
+  (let ((pathname (vc-master-pathname master))
+	(name (file-namestring (vc-master-workfile master))))
+    (and (file-readable? pathname)
+	 (call-with-input-file pathname
+	   (lambda (port)
+	     (let ((prefix (string-append "/" name "/")))
+	       (let loop ()
+		 (let ((line (read-line port)))
+		   (and (not (eof-object? line))
+			(if (string-prefix? prefix line)
+			    (let ((tokens (cdr (burst-string line #\/ #f))))
+			      (if (fix:= 5 (length tokens))
+				  tokens
+				  (loop)))
+			    (loop)))))))))))
+
+(define (get-cvs-status master)
+  (let ((pathname (vc-workfile-pathname master)))
+    (vc-run-command master
+		    `((DIRECTORY ,(directory-pathname pathname))
+		      (BUFFER " *vc-status*"))
+		    "cvs" "status" (file-pathname pathname)))
+  (let ((m (buffer-start (get-vc-command-buffer))))
+    (let ((status
+	   (if (re-search-forward "^File: [^ \t]+[ \t]+Status: \\(.*\\)" m)
+	       (convert-cvs-status
+		(extract-string (re-match-start 1) (re-match-end 1)))
+	       'UNKNOWN)))
+      (if (eq? 'UP-TO-DATE status)
+	  (sync-checkout-time! master #t))
+      (values
+       status
+       (if (re-search-forward
+	    "\\(RCS Version\\|RCS Revision\\|Repository revision\\):[ \t]+\\([0-9.]+\\)"
+	    m)
+	   (extract-string (re-match-start 2) (re-match-end 2))
+	   #f)))))
+
+(define (convert-cvs-status status)
+  (cond ((string-ci=? status "Up-to-date")
+	 'UP-TO-DATE)
+	((string-ci=? status "Locally Modified")
+	 'LOCALLY-MODIFIED)
+	((string-ci=? status "Needs Merge")
+	 'NEEDS-MERGE)
+	((or (string-ci=? status "Needs Checkout")
+	     (string-ci=? status "Needs Patch"))
+	 'NEEDS-CHECKOUT)
+	((or (string-ci=? status "Unresolved Conflict")
+	     (string-ci=? status "File had conflicts on merge"))
+	 'UNRESOLVED-CONFLICT)
+	((or (string-ci=? status "Locally Added")
+	     (string-ci=? status "New file!"))
+	 'LOCALLY-ADDED)
+	(else
+	 'UNKNOWN)))
+
+(define (cvs-rev-switch revision)
+  (and revision
+       (list "-r" revision)))
+
+(define-vc-type-operation 'VALID? vc-type:cvs
+  (lambda (master)
+    (get-cvs-workfile-version master #f)))
+
+(define-vc-type-operation 'RELEASE vc-type:cvs
+  (lambda ()
+    (and (= 0 (vc-run-command #f '() "cvs" "-v"))
+	 (re-search-forward "^Concurrent Versions System (CVS) \\([0-9.]+\\)"
+			    (buffer-start (get-vc-command-buffer)))
+	 (extract-string (re-match-start 1) (re-match-end 1)))))
+
+(define-vc-type-operation 'LOCKING-USER vc-type:cvs
+  (lambda (master revision)
+    revision
+    (let ((workfile (vc-workfile-pathname master)))
+      (let ((mtime (file-modification-time-indirect workfile)))
+	(and mtime
+	     (not (eqv? mtime (vc-master-checkout-time master)))
+	     (let ((attr (file-attributes workfile)))
+	       (and attr
+		    (unix/uid->string (file-attributes/uid attr)))))))))
+
+(define-vc-type-operation 'DEFAULT-VERSION vc-type:cvs
+  (lambda (master error?)
+    (or (call-with-values (lambda () (get-cvs-status master))
+	  (lambda (status revision)
+	    status
+	    revision))
+	(and error?
+	     (error "Unable to determine default CVS version:"
+		    (vc-workfile-pathname master))))))
+
+(define-vc-type-operation 'WORKFILE-VERSION vc-type:cvs
+  (lambda (master)
+    (get-cvs-workfile-version master #f)))
+
+(define-vc-type-operation 'CHECK-HEADERS vc-type:cvs
   (lambda (master buffer)
     master
-    (let ((start (buffer-start buffer))
-	  (end (buffer-end buffer)))
-      (let ((find-keyword
-	     (lambda (keyword)
-	       (let ((mark
-		      (search-forward (string-append "$" keyword ":")
-				      start
-				      end
-				      #f)))
-		 (and mark
-		      (skip-chars-forward " " mark end #f)))))
-	    (get-version
-	     (lambda (start)
-	       (let ((end (skip-chars-forward "0-9." start end)))
-		 (and (mark< start end)
-		      (let ((revision (extract-string start end)))
-			(let ((length (rcs-number-length revision)))
-			  (and (> length 2)
-			       (even? length)
-			       (rcs-number-head revision
-						(- length 1)
-						#f)))))))))
-	(cond ((or (find-keyword "Id") (find-keyword "Header"))
-	       => (lambda (mark)
-		    (get-version
-		     (skip-chars-forward " "
-					 (skip-chars-forward "^ " mark end)
-					 end))))
-	      ((find-keyword "Revision") => get-version)
-	      (else #f))))))
+    (check-rcs-headers buffer)))
 
-(define (rcs-rev-switch switch revision)
-  (if revision
-      (string-append switch revision)
-      switch))
+(define-vc-type-operation 'LIKELY-CONTROL-TYPE? vc-type:cvs
+  (lambda (workfile)
+    (file-directory? (cvs-directory workfile))))
 
-(define (rcs-mtime-switch master)
-  (and (ref-variable vc-rcs-preserve-mod-times (vc-workfile-buffer master))
-       "-M"))
+(define-vc-type-operation 'REGISTER vc-type:cvs
+  (lambda (workfile revision comment keep?)
+    revision keep?			;always keep file.
+    (with-vc-command-message workfile "Registering"
+      (lambda ()
+	(vc-run-command workfile '() "cvs" "add"
+			"-m" comment
+			(vc-workfile-pathname workfile))))))
+
+(define-vc-type-operation 'CHECKOUT vc-type:cvs
+  (lambda (master revision lock? workfile)
+    lock?				;locking not used with CVS
+    (cond (workfile
+	   ;; CVS makes it difficult to check a file out into anything
+	   ;; but the working file.
+	   (delete-file-no-errors workfile)
+	   (vc-run-shell-command master '() "cvs" "update" "-p"
+				 (cvs-rev-switch revision)
+				 (vc-workfile-pathname master)
+				 ">"
+				 workfile))
+	  (revision
+	   ;; Checkout only necessary for given revision.
+	   (vc-run-command master '() "cvs" "update"
+			   (cvs-rev-switch revision)
+			   (vc-workfile-pathname master))
+	   (sync-checkout-time! master #t)))))
+
+(define-vc-type-operation 'REVERT vc-type:cvs
+  (lambda (master revision)
+     ;; Check out via standard output, so that no sticky tag is set.
+    (vc-backend-checkout master revision #f (vc-workfile-pathname master))))
+
+(define-vc-type-operation 'CHECKIN vc-type:cvs
+  (lambda (master revision comment keep?)
+    keep?
+    (bind-condition-handler (list condition-type:editor-error)
+	(lambda (condition)
+	  condition
+	  (if (eq? 'NEEDS-MERGE
+		   (call-with-values (lambda () (get-cvs-status master))
+		     (lambda (status revision)
+		       revision
+		       status)))
+	      (error "Type C-x 0 C-x C-q to merge in changes.")))
+      (lambda ()
+	(if (and revision
+		 (not (equal? revision (vc-workfile-version master)))
+		 (trunk-revision? revision))
+	    (vc-run-command master '() "cvs" "commit"
+			    "-m" "#intermediate"
+			    (vc-workfile-pathname master)))
+	(vc-run-command master '() "cvs" "commit"
+			(cvs-rev-switch revision)
+			"-m" comment
+			(vc-workfile-pathname master))))
+    ;; If this was an explicit check-in, remove the sticky tag.
+    (vc-run-command master '() "cvs" "update" "-A"
+		    (vc-workfile-pathname master))))
+
+(define-vc-type-operation 'STEAL vc-type:cvs
+  (lambda (master revision)
+    master revision
+    (error "You cannot steal a CVS lock; there are no CVS locks to steal.")))
+
+(define-vc-type-operation 'LOGENTRY-CHECK vc-type:cvs
+  (lambda (master log-buffer)
+    master log-buffer
+    unspecific))
+
+(define-vc-type-operation 'DIFF vc-type:cvs
+  (lambda (master rev1 rev2 simple?)
+    (let ((options
+	   `((STATUS 1)
+	     ,@(if simple? `((BUFFER " *vc-diff*")) '()))))
+      (if (equal? "0" (vc-workfile-version master))
+	  ;; This file is added but not yet committed; there is no
+	  ;; master file.
+	  (begin
+	    (if (or rev1 rev2)
+		(error "No revisions exist:" (vc-workfile-pathname master)))
+	    (if simple?
+		;; File is added but not committed; we regard this as
+		;; "changed".
+		1
+		;; Diff against /dev/null.
+		(vc-run-command master options "diff"
+				(ref-variable diff-switches
+					      (vc-workfile-buffer master))
+				"/dev/null"
+				(vc-workfile-pathname master))))
+	  (vc-run-command master options "cvs" "diff"
+			  (and rev1 (string-append "-r" rev1))
+			  (and rev2 (string-append "-r" rev2))
+			  (if simple?
+			      '()
+			      (ref-variable diff-switches
+					    (vc-workfile-buffer master)))
+			  (vc-workfile-pathname master))))))
+
+(define-vc-type-operation 'PRINT-LOG vc-type:cvs
+  (lambda (master)
+    (vc-run-command master '() "cvs" "log" (vc-workfile-pathname master))))
 
 ;;;; Command Execution
 
-(define (vc-run-command master status-limit command . arguments)
+(define (vc-run-command master options command . arguments)
+  (let ((option
+	 (lambda (name default)
+	   (let ((option (assq name options)))
+	     (if option
+		 (cadr option)
+		 (default))))))
   (let ((command-messages?
-	 (ref-variable vc-command-messages (vc-workfile-buffer master)))
+	 (ref-variable vc-command-messages
+		       (and master (vc-workfile-buffer master))))
 	(msg
 	 (string-append "Running " command
-			" on " (vc-workfile-string master) "..."))
-	(command-buffer (get-vc-command-buffer)))
+			(if master
+			    (string-append " on " (vc-workfile-string master))
+			    "")
+			"..."))
+	(status-limit (option 'STATUS (lambda () 0)))
+	(directory (option 'DIRECTORY working-directory-pathname))
+	(command-buffer
+	 (let ((buffer (option 'BUFFER get-vc-command-buffer)))
+	   (cond ((string? buffer) (find-or-create-buffer buffer))
+		 ((buffer? buffer) buffer)
+		 (else (error "Illegal buffer:" buffer))))))
     (if command-messages? (message msg))
     (buffer-reset! command-buffer)
     (bury-buffer command-buffer)
+    (set-buffer-default-directory! command-buffer directory)
     (let ((result
 	   (apply run-synchronous-process
 		  #f
 		  (buffer-end command-buffer)
+		  directory
 		  #f
-		  #f
-		  (os/find-program command
-				   (buffer-default-directory command-buffer)
-				   (ref-variable exec-path))
+		  (os/find-program command directory
+				   (ref-variable exec-path command-buffer))
 		  (vc-command-arguments arguments))))
       (if (and (eq? 'EXITED (car result))
 	       (<= 0 (cdr result) status-limit))
@@ -1218,7 +1561,7 @@ the value of vc-log-mode-hook."
 	  (begin
 	    (pop-up-vc-command-buffer #f)
 	    (editor-error "Running " command "...FAILED "
-			  (list (car result) (cdr result))))))))
+			  (list (car result) (cdr result)))))))))
 
 (define (vc-command-arguments arguments)
   (append-map (lambda (argument)
@@ -1229,8 +1572,8 @@ the value of vc-log-mode-hook."
 		      (else (error "Ill-formed command argument:" argument))))
 	      arguments))
 
-(define (vc-run-shell-command master status-limit command . arguments)
-  (vc-run-command master status-limit "/bin/sh" "-c"
+(define (vc-run-shell-command master options command . arguments)
+  (vc-run-command master options "/bin/sh" "-c"
 		  (reduce string-append-separated
 			  ""
 			  (vc-command-arguments (cons command arguments)))))
@@ -1252,14 +1595,15 @@ the value of vc-log-mode-hook."
 ;;;; Workfile Utilities
 
 (define (vc-keep-workfiles? master)
-  (ref-variable vc-keep-workfiles (vc-workfile-buffer master)))
+  (or (eq? vc-type:cvs (vc-master-type master))
+      (ref-variable vc-keep-workfiles (vc-workfile-buffer master))))
 
 (define (vc-update-workfile-buffer master keep?)
   ;; Depending on VC-KEEP-WORKFILES, either revert the workfile
   ;; buffer to show the updated workfile, or kill the buffer.
   (let ((buffer (vc-workfile-buffer master)))
     (if buffer
-	(if (or keep? (ref-variable vc-keep-workfiles buffer))
+	(if keep?
 	    (vc-revert-buffer buffer #t)
 	    (kill-buffer buffer)))))
 
@@ -1273,18 +1617,6 @@ the value of vc-log-mode-hook."
        (not (string-null? revision))
        revision))
 
-(define (vc-workfile-version master)
-  (let ((pathname (vc-workfile-pathname master)))
-    (let ((buffer (pathname->buffer pathname)))
-      (if buffer
-	  (vc-backend-buffer-version master buffer)
-	  (call-with-temporary-buffer " *VC-temp*"
-	    (lambda (buffer)
-	      (catch-file-errors (lambda () #f)
-		(lambda ()
-		  (read-buffer buffer pathname #f)
-		  (vc-backend-buffer-version master buffer)))))))))
-
 (define (vc-workfile-buffer master)
   (pathname->buffer (vc-workfile-pathname master)))
 
@@ -1301,12 +1633,7 @@ the value of vc-log-mode-hook."
 	 (file-modification-time-indirect (vc-workfile-pathname master))))
     (cond ((not mod-time) #f)
 	  ((eqv? (vc-master-checkout-time master) mod-time) #f)
-	  ((= 0 (vc-backend-diff master #f #f #t))
-	   (set-vc-master-checkout-time! master mod-time)
-	   #f)
-	  (else
-	   (set-vc-master-checkout-time! master #f)
-	   #t))))
+	  (else (not (= 0 (vc-backend-diff master #f #f #t)))))))
 
 (define (vc-save-workfile-buffer master)
   (let ((buffer (vc-workfile-buffer master)))