From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 Mar 2000 21:49:13 +0000 (+0000)
Subject: Extensive work to get correct operation of CVS support.  Now
X-Git-Tag: 20090517-FFI~4158
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2059732803ad5768b50178b79f45a0227de71422;p=mit-scheme.git

Extensive work to get correct operation of CVS support.  Now
substantially merged with "vc.el" from Emacs 20.6.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 32b99658f..627432b5e 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.246 2000/03/23 22:48:47 cph Exp $
+$Id: edwin.pkg,v 1.247 2000/03/24 21:49:13 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -1082,7 +1082,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (files "vc")
     (parent (edwin))
     (export (edwin)
-	    edwin-command$vc-cancel-version
 	    edwin-command$vc-diff
 	    edwin-command$vc-finish-logentry
 	    edwin-command$vc-insert-headers
diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index d16b9f6ae..d855649ab 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: vc.scm,v 1.35 2000/03/23 22:49:05 cph Exp $
+;;; $Id: vc.scm,v 1.36 2000/03/24 21:49:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ;;;
@@ -19,7 +19,9 @@
 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 ;;;; Version Control
-;;;  Translated from "vc.el" in Emacs 19.22.
+
+;;; Adapted from "vc.el" in Emacs 19.22.
+;;; Updated March 2000 from "vc.el" in Emacs 20.6.
 
 (declare (usual-integrations))
 
@@ -37,7 +39,7 @@ Bound to #F if the buffer is not under version control."
   #f
   string-or-false?)
 (let ((variable (ref-variable-object vc-mode-line-status)))
-  (variable-permanent-local! variable)
+  ;;(variable-permanent-local! variable)
   (set-variable! minor-mode-alist
 		 (cons (list variable variable)
 		       (ref-variable minor-mode-alist))))
@@ -102,86 +104,77 @@ 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)))
-	(define-variable-local-value! buffer
-	    (ref-variable-object make-backup-files)
-	  #f))))
-(add-event-receiver! (ref-variable find-file-hooks) vc-find-file-hook)
-
-(define (vc-file-not-found-hook buffer)
-  (let ((master (buffer-vc-master buffer)))
-    (and master
-	 (begin
-	   (load-edwin-library 'VC)
-	   (call-with-current-continuation
-	    (lambda (k)
-	      (bind-condition-handler (list condition-type:error)
-		  (lambda (condition)
-		    condition
-		    (k #f))
-		(lambda ()
-		  (vc-checkout master #f)
-		  #t))))))))
-(let ((hooks (ref-variable find-file-not-found-hooks)))
-  (if (not (memq vc-file-not-found-hook hooks))
-      (set-variable! find-file-not-found-hooks
-		     (append! hooks (list vc-file-not-found-hook)))))
+(add-event-receiver! (ref-variable find-file-hooks)
+  (lambda (buffer)
+    (let ((master (buffer-vc-master buffer #f)))
+      (if master
+	  (begin
+	    (vc-mode-line master buffer)
+	    (if (not (ref-variable vc-make-backup-files buffer))
+		(local-set-variable! make-backup-files #f buffer)))))))
+
+(set-variable!
+ find-file-not-found-hooks
+ (append! (ref-variable find-file-not-found-hooks)
+	  (list
+	   (lambda (buffer)
+	     (let ((master (buffer-vc-master buffer #f)))
+	       (and master
+		    (call-with-current-continuation
+		     (lambda (k)
+		       (bind-condition-handler (list condition-type:error)
+			   (lambda (condition) condition (k #f))
+			 (lambda ()
+			   (vc-checkout master #f)
+			   #t))))))))))
 
 (define (vc-after-save buffer)
-  (let ((master (buffer-vc-master buffer)))
+  (let ((master (buffer-vc-master buffer #f)))
     (if master
 	(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))
-	" @@")))
+  (let ((workfile-buffer (vc-workfile-buffer master)))
+    (let ((buffer (or buffer workfile-buffer))
+	  (revision
+	   (or (vc-backend-workfile-revision master)
+	       (vc-backend-default-revision master #f))))
+      (let ((locker (vc-backend-locking-user master revision))
+	    (user-name (current-user-name)))
+	(set-variable!
+	 vc-mode-line-status
+	 (string-append
+	  " "
+	  (vc-type-display-name (vc-master-type master))
+	  (if (ref-variable vc-display-status buffer)
+	      (if revision
+		  (let ()
+		    (string-append
+		     (cond ((not locker) "-")
+			   ((string=? locker user-name) ":")
+			   (else (string-append ":" locker ":")))
+		     revision))
+		  " @@")
+	      ""))
+	 buffer)
+	(buffer-modeline-event! buffer 'VC-MODE-LINE-STATUS)
+	(if (and (buffer-writeable? buffer)
+		 (eq? buffer workfile-buffer)
+		 ;; 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 (and locker (not (string=? locker 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-master-workfile master)))))))
+	    (set-buffer-read-only! buffer))))))
 
 ;;;; Primary Commands
 
@@ -192,16 +185,26 @@ then check the file in or out.  Otherwise, just change the read-only flag
 of the buffer."
   ()
   (lambda ()
-    (if (buffer-vc-master (current-buffer))
+    (if (buffer-vc-master (selected-buffer) #f)
 	((ref-command vc-next-action) #f)
 	((ref-command toggle-read-only)))))
 
 (define-command vc-next-action
   "Do the next logical checkin or checkout operation on the current file.
+   If you call this from within a VC dired buffer with no files marked,
+it will operate on the file in the current line.
+   If you call this from within a VC dired buffer, and one or more
+files are marked, it will accept a log message and then operate on
+each one.  The log message will be used as a comment for any register
+or checkin operations, but ignored when doing checkouts.  Attempted
+lock steals will raise an error.
+   A prefix argument lets you specify the version number to use.
+
+For RCS files:
    If the file is not already registered, this registers it for version
-control and then retrieves a writeable, locked copy for editing.
+control.
    If the file is registered and not locked by anyone, this checks out
-a writeable and locked file ready for editing.
+a writable and locked file ready for editing.
    If the file is checked out and locked by the calling user, this
 first checks to see if the file has changed since checkout.  If not,
 it performs a revert.
@@ -212,66 +215,140 @@ the variable `vc-keep-workfiles' is true (which is its default), a
 read-only copy of the changed file is left in place afterwards.
    If the file is registered and locked by someone else, you are given
 the option to steal the lock.
-   If you call this from within a VC dired buffer with no files marked,
-it will operate on the file in the current line.
-   If you call this from within a VC dired buffer, and one or more
-files are marked, it will accept a log message and then operate on
-each one.  The log message will be used as a comment for any register
-or checkin operations, but ignored when doing checkouts.  Attempted
-lock steals will raise an error.
 
-   For checkin, a prefix argument lets you specify the version number to use."
+For CVS files:
+   If the file is not already registered, this registers it for version
+control.  This does a \"cvs add\", but no \"cvs commit\".
+   If the file is added but not committed, it is committed.
+   If your working file is changed, but the repository file is
+unchanged, this pops up a buffer for entry of a log message; when the
+message has been entered, it checks in the resulting changes along
+with the logmessage as change commentary.  A writable file is retained.
+   If the repository file is changed, you are asked if you want to
+merge in the changes into your working copy."
   "P"
   (lambda (revision?)
-    (if (not (eq? (current-major-mode) (ref-mode-object dired)))
-	(let ((workfile (buffer-pathname (current-buffer))))
-	  (if (not workfile)
-	      (vc-registration-error #f))
-	  (vc-next-action-on-file workfile revision? #f))
+    (if (vc-dired-buffer? (selected-buffer))
 	(let ((files
 	       (let ((files (dired-marked-files)))
-		 (if (null? files)
-		     (dired-next-files 1)
-		     files))))
-	  (cond ((null? files)
-		 unspecific)
-		((null? (cdr files))
-		 (vc-next-action-on-file (caar files) revision? #f))
-		(else
-		 (vc-start-entry #f
-				 "Enter a change comment for the marked files."
-				 #f
-				 (vc-next-action-dired (current-buffer))
-				 #f)))))))
+		 (if (pair? files)
+		     files
+		     (dired-next-files 1)))))
+	  (if (pair? files)
+	      (if (pair? (cdr files))
+		  (vc-start-entry
+		   #f "Enter a change comment for the marked files." #f
+		   (vc-next-action-dired (selected-buffer))
+		   #f)
+		  (vc-next-action-on-file (caar files) #t #f #f))))
+	(vc-next-action-on-file (or (buffer-pathname (selected-buffer))
+				    (vc-registration-error #f))
+				#f revision? #f))))
 
 (define-command vc-register
   "Register the current file into your version-control system."
   "P"
   (lambda (revision?)
-    (let ((workfile (buffer-pathname (current-buffer))))
-      (if (not workfile)
-	  (vc-registration-error #f))
-      (if (file-vc-master workfile)
+    (let ((workfile (buffer-pathname (selected-buffer))))
+      (if (not workfile) (vc-registration-error #f))
+      (if (file-vc-master workfile #f)
 	  (editor-error "This file is already registered."))
       (vc-register workfile revision? #f #f))))
 
-(define (vc-next-action-on-file workfile revision comment)
-  (let ((master (file-vc-master workfile)))
-    (if (not master)
-	(vc-register workfile revision comment 'LOCK)
-	(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))
-		  ((string=? owner (current-user-name))
-		   (if (or (let ((buffer (vc-workfile-buffer workfile)))
-			     (and buffer
-				  (buffer-modified? buffer)))
-			   (vc-workfile-modified? master))
-		       (vc-checkin master revision comment)
-		       (vc-revert master revision)))
-		  (else
-		   (vc-steal-lock master revision comment owner))))))))
+(define (vc-next-action-on-file workfile from-dired? revision? comment)
+  (let ((master (file-vc-master workfile #f)))
+    (if master
+	(let* ((type (vc-master-type master))
+	       (cvs? (eq? type vc-type:cvs))
+	       (cvs-status (and cvs? (cvs-status master))))
+	  (cond ((memq cvs-status '(NEEDS-CHECKOUT NEEDS-MERGE))
+		 (vc-next-action-merge master from-dired?))
+		((and cvs?
+		      (not revision?)
+		      (not (vc-workfile-modified? master)))
+		 (if (not from-dired?)
+		     (message (buffer-name (pathname->buffer workfile))
+			      " is up to date.")))
+		((vc-backend-locking-user master #f)
+		 =>
+		 (lambda (owner)
+		   (if (and (not cvs?)
+			    (not (string=? owner (current-user-name))))
+		       (begin
+			 (if (and (eq? type vc-type:rcs)
+				  (not (vc-release? vc-type:rcs "5.6.2")))
+			     ;; Can't steal locks with old RCS
+			     ;; versions.
+			     (editor-error "File is locked by " owner "."))
+			 (vc-steal-lock master revision? comment owner))
+		       (let ((buffer (find-file-noselect workfile #t)))
+			 (if from-dired?
+			     (select-buffer-other-window buffer)
+			     (select-buffer buffer))
+			 ;; If the file on disk is newer, then the
+			 ;; user just said no to rereading it.  So the
+			 ;; user probably wishes to overwrite the file
+			 ;; with the buffer's contents, and check that
+			 ;; in.
+			 (cond ((verify-visited-file-modification-time? buffer)
+				(vc-save-buffer buffer #t))
+			       ((prompt-for-yes-or-no?
+				 "Replace file on disk with buffer contents")
+				(save-buffer buffer #f))
+			       (else
+				(editor-error "Aborted")))
+			 ;; Revert if file is unchanged and buffer is
+			 ;; too.  If buffer is modified, that means
+			 ;; the user just said no to saving it; in
+			 ;; that case, don't revert, because the user
+			 ;; might intend to save after finishing the
+			 ;; log entry.
+			 (if (and (not (buffer-modified? buffer))
+				  (not (vc-workfile-modified? master)))
+			     ;; DO NOT revert the file without asking
+			     ;; the user!
+			     (if (prompt-for-yes-or-no?
+				  "Revert to master version")
+				 (begin
+				   (vc-backend-revert master)
+				   (vc-revert-buffer buffer #f)))
+			     (vc-checkin master revision? comment))))))
+		(else
+		 (vc-save-workfile-buffer workfile)
+		 (vc-checkout master revision?))))
+	(vc-register workfile revision? comment 'LOCK))))
+
+(define (vc-next-action-merge master from-dired?)
+  (let ((buffer (vc-workfile-buffer master)))
+    (if (or from-dired?
+	    (prompt-for-yes-or-no?
+	     (string-append
+	      (buffer-name buffer)
+	      " is not up-to-date.  Merge in changes now")))
+	(begin
+	  (if (and buffer (buffer-modified? buffer))
+	      (begin
+		(if (vc-dired-buffer? (selected-buffer))
+		    (select-buffer-other-window buffer)
+		    (select-buffer buffer))
+		(vc-save-buffer buffer #f)))
+	  (if (and buffer
+		   (buffer-modified? buffer)
+		   (not
+		    (prompt-for-yes-or-no?
+		     (string-append
+		      "Buffer "
+		      (buffer-name buffer)
+		      " modified; merge file on disc anyhow"))))
+	      (editor-error "Merge aborted"))
+	  (let ((conflicts? (cvs-backend-merge-news master)))
+	    (if buffer
+		(vc-revert-buffer buffer #t))
+	    (if (and conflicts?
+		     (prompt-for-confirmation?
+		      "Conflicts detected.  Resolve them now"))
+		(find-file (vc-master-workfile master)))))
+	(editor-error (buffer-name buffer) " needs update."))))
 
 (define (vc-next-action-dired buffer)
   (lambda (comment)
@@ -279,15 +356,15 @@ lock steals will raise an error.
       (lambda (file)
 	(let ((msg (string-append "Processing " (->namestring file) "...")))
 	  (message msg)
-	  (vc-next-action-on-file file #f comment)
+	  (vc-next-action-on-file file #t #f comment)
 	  (message msg "done"))))))
-
-(define (vc-register workfile revision comment keep?)
+
+(define (vc-register workfile revision? comment keep?)
   (let ((revision
-	 (vc-get-version revision
-			 (string-append "Initial version level for "
-					(vc-workfile-string workfile)))))
-    (let ((buffer (vc-workfile-buffer workfile)))
+	 (vc-get-revision revision?
+			  (string-append "Initial version level for "
+					 (->namestring workfile)))))
+    (let ((buffer (pathname->buffer workfile)))
       ;; Watch out for new buffers of size 0: the corresponding file
       ;; does not exist yet, even though buffer-modified? is false.
       (if (and buffer
@@ -299,8 +376,7 @@ lock steals will raise an error.
     (vc-start-entry workfile
 		    "Enter initial comment."
 		    (or comment
-			(if (ref-variable vc-initial-comment
-					  (vc-workfile-buffer workfile))
+			(if (ref-variable vc-initial-comment buffer)
 			    #f
 			    ""))
 		    (let ((keep? (or keep? (vc-keep-workfiles? workfile))))
@@ -308,21 +384,18 @@ lock steals will raise an error.
 			(vc-backend-register workfile revision comment keep?)
 			(vc-update-workfile-buffer workfile keep?)))
 		    #f)))
-
-(define (vc-checkout master revision)
-  (let ((revision
-	 (or (vc-get-version revision "Version level to check out")
-	     (vc-workfile-version master))))
+
+(define (vc-checkout master revision?)
+  (let ((revision (vc-get-revision revision? "Branch or version to move to")))
     (let ((do-it
 	   (lambda ()
 	     (vc-backend-checkout master revision #t #f)
 	     (vc-revert-workfile-buffer master #t))))
-      (cond ((or (not (let ((value (ref-variable vc-checkout-carefully)))
-			(if (boolean? value)
-			    value
-			    (value))))
-		 (not (vc-workfile-modified? master))
-		 (= 0 (vc-backend-diff master #f #f #t)))
+      (cond ((not (and (let ((value (ref-variable vc-checkout-carefully)))
+			 (if (boolean? value)
+			     value
+			     (value)))
+		       (vc-workfile-modified? master)))
 	     (do-it))
 	    ((cleanup-pop-up-buffers
 	      (lambda ()
@@ -348,10 +421,10 @@ lock steals will raise an error.
 	     (do-it))
 	    (else
 	     (editor-error "Checkout aborted."))))))
-
-(define (vc-checkin master revision comment)
-  (let ((revision (vc-get-version revision "New version level")))
-    (vc-save-workfile-buffer master)
+
+(define (vc-checkin master revision? comment)
+  (let ((revision (vc-get-revision revision? "New version level")))
+    (vc-save-workfile-buffer (vc-master-workfile master))
     (vc-start-entry master
 		    "Enter a change comment."
 		    comment
@@ -362,33 +435,21 @@ lock steals will raise an error.
 						"*** empty log message ***"
 						comment)
 					    keep?)
-			(vc-update-workfile-buffer master keep?)))
+			(vc-update-workfile-buffer (vc-master-workfile 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
-	 (or (vc-get-version revision "Version level to revert")
-	     (vc-workfile-version master))))
-    (vc-save-workfile-buffer master)
-    (vc-backend-revert master revision)
-    (vc-revert-workfile-buffer master #f)))
-
-(define (vc-steal-lock master revision comment owner)
+(define (vc-steal-lock master revision? comment owner)
   (let ((filename (vc-workfile-string master)))
     (if comment
 	(editor-error "Sorry, you can't steal the lock on "
 		      filename
 		      " this way."))
-    (let ((revision
-	   (or (vc-get-version revision "Version level to steal")
-	       (vc-workfile-version master))))
+    (let ((revision (vc-get-revision revision? "Version level to steal")))
       (let ((file:rev
 	     (if revision
 		 (string-append filename ":" revision)
@@ -400,16 +461,12 @@ lock steals will raise an error.
 			  #f
 			  select-buffer-other-window
 			  'DISCARD-PREVIOUS-MAIL)
-	(let ((mail-buffer (current-buffer)))
-	  (let ((time (get-decoded-time)))
-	    (insert-string (string-append "I stole the lock on "
-					  file:rev
-					  ", "
-					  (decoded-time/date-string time)
-					  " at "
-					  (decoded-time/time-string time)
-					  ".\n")
-			   (buffer-end mail-buffer)))
+	(let ((mail-buffer (selected-buffer)))
+	  (insert-string
+	   (string-append "I stole the lock on " file:rev ", "
+			  (universal-time->string (get-universal-time))
+			  ".\n")
+	   (buffer-end mail-buffer))
 	  (set-buffer-point! mail-buffer (buffer-end mail-buffer))
 	  (let ((variable (ref-variable-object send-mail-procedure)))
 	    (define-variable-local-value! mail-buffer variable
@@ -448,25 +505,23 @@ files in or below it."
 	(vc-diff (file-vc-master workfile #t) rev1 rev2))))
 
 (define (vc-diff master rev1 rev2)
-  (vc-save-workfile-buffer master)
-  (let ((rev1 (vc-normalize-version rev1))
-	(rev2 (vc-normalize-version rev2)))
-    (let ((rev1 (if (or rev1 rev2) rev1 (vc-workfile-version master))))
-      (if (and (or rev1 rev2 (not (vc-workfile-modified? master)))
-	       (= 0 (vc-backend-diff master rev1 rev2 #t)))
-	  (begin
-	    (message "No changes to "
-		     (vc-workfile-string master)
-		     (if (and rev1 rev2)
-			 (string-append " between " rev1 " and " rev2)
-			 (string-append " since "
-					(or rev1 rev2 "latest version")))
-		     ".")
-	    #t)
-	  (begin
-	    (vc-backend-diff master rev1 rev2 #f)
-	    (pop-up-vc-command-buffer #t)
-	    #f)))))
+  (vc-save-workfile-buffer (vc-master-workfile master))
+  (let ((rev1 (vc-normalize-revision rev1))
+	(rev2 (vc-normalize-revision rev2)))
+    (if (and (or rev1 rev2 (vc-workfile-modified? master))
+	     (vc-backend-diff master rev1 rev2 #f))
+	(begin
+	  (pop-up-vc-command-buffer #t)
+	  #f)
+	(begin
+	  (message "No changes to "
+		   (vc-workfile-string master)
+		   (if (and rev1 rev2)
+		       (string-append " between " rev1 " and " rev2)
+		       (string-append " since "
+				      (or rev1 rev2 "latest version")))
+		   ".")
+	  #t))))
 
 (define-command vc-version-other-window
   "Visit version REV of the current buffer in another window.
@@ -476,8 +531,8 @@ If `F.~REV~' already exists, it is used instead of being re-created."
   (lambda (revision)
     (let ((master (current-vc-master #t)))
       (let ((revision
-	     (or (vc-normalize-version revision)
-		 (vc-default-version master #t))))
+	     (or (vc-normalize-revision revision)
+		 (vc-backend-default-revision master #t))))
 	(let ((workfile
 	       (string-append (->namestring (vc-master-workfile master))
 			      ".~"
@@ -494,8 +549,9 @@ Headers are inserted at the start of the buffer."
   (lambda ()
     (let ((master (current-vc-master #t)))
       (let ((buffer
-	     (or (vc-workfile-buffer master)
-		 (find-file-other-window (vc-workfile-pathname master)))))
+	     (let ((workfile (vc-master-workfile master)))
+	       (or (pathname->buffer workfile)
+		   (find-file-other-window workfile)))))
 	(without-group-clipped! (buffer-group buffer)
 	  (lambda ()
 	    (if (or (not (vc-backend-check-headers master buffer))
@@ -526,25 +582,17 @@ This asks for confirmation if the buffer contents are not identical
 to that version."
   ()
   (lambda ()
-    (let ((buffer (current-buffer)))
-      (let ((master (buffer-vc-master buffer)))
+    (let ((buffer (selected-buffer)))
+      (let ((master (buffer-vc-master buffer #t)))
 	(if (cleanup-pop-up-buffers
 	     (lambda ()
 	       (or (not (vc-diff master #f #f))
 		   (ref-variable vc-suppress-confirm)
 		   (prompt-for-yes-or-no? "Discard changes"))))
 	    (begin
-	      (vc-backend-revert master #f)
+	      (vc-backend-revert master)
 	      (vc-revert-buffer buffer #t))
 	    (editor-error "Revert cancelled."))))))
-
-(define-command vc-cancel-version
-  "Get rid of most recently checked in version of this file.
-A prefix argument means do not revert the buffer afterwards."
-  "P"
-  (lambda (no-revert?)
-    no-revert?
-    (editor-error "VC-CANCEL-VERSION not implemented.")))
 
 ;;;; VC Dired
 
@@ -553,7 +601,7 @@ A prefix argument means do not revert the buffer afterwards."
 Normally shows only locked files; prefix arg says to show all files."
   "P"
   (lambda (all-files?)
-    (let ((directory (buffer-default-directory (current-buffer))))
+    (let ((directory (buffer-default-directory (selected-buffer))))
       (let ((buffer (vc-dired directory all-files?)))
 	(if (> (buffer-length buffer) 0)
 	    (pop-up-buffer buffer #t)
@@ -580,18 +628,20 @@ Normally shows only locked files; prefix arg says to show all files."
 (define (get-vc-dired-buffer directory)
   (or (list-search-positive (buffer-list)
 	(lambda (buffer)
-	  (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC)))
+	  (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC #f)))
 	    (and spec
 		 (pathname=? (car spec) directory)))))
       (new-buffer (pathname->buffer-name directory))))
 
+(define (vc-dired-buffer? buffer)
+  (buffer-get buffer 'VC-DIRECTORY-SPEC #f))
+
 (define (fill-vc-dired-buffer! buffer directory all-files?)
   (let ((msg
 	 (string-append "Reading directory " (->namestring directory) "...")))
     (buffer-reset! buffer)
     (set-buffer-major-mode! buffer (ref-mode-object dired))
-    (define-variable-local-value! buffer (ref-variable-object mode-name)
-      "VC-Dired")
+    (local-set-variable! mode-name "VC-Dired" buffer)
     (set-buffer-default-directory! buffer (directory-pathname directory))
     (buffer-put! buffer 'VC-DIRECTORY-SPEC (cons directory all-files?))
     (buffer-put! buffer 'REVERT-BUFFER-METHOD revert-vc-dired-buffer)
@@ -611,7 +661,7 @@ Normally shows only locked files; prefix arg says to show all files."
   (set-buffer-read-only! buffer))
 
 (define (revert-vc-dired-buffer buffer dont-use-auto-save? dont-confirm?)
-  (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC)))
+  (let ((spec (buffer-get buffer 'VC-DIRECTORY-SPEC #f)))
     (if spec
 	(fill-vc-dired-buffer! buffer (car spec) (cdr spec))
 	(revert-buffer-default buffer dont-use-auto-save? dont-confirm?))))
@@ -620,9 +670,9 @@ Normally shows only locked files; prefix arg says to show all files."
   (for-each (lambda (file)
 	      (let ((attr (file-attributes-direct file)))
 		(if (and attr (not (file-attributes/type attr)))
-		    (let ((master (file-vc-master file)))
+		    (let ((master (file-vc-master file #f)))
 		      (if master
-			  (let ((locker (vc-locking-user master #f)))
+			  (let ((locker (vc-backend-locking-user master #f)))
 			    (if (or locker all-files?)
 				(generate-vc-dired-line file
 							attr
@@ -659,8 +709,10 @@ Normally shows only locked files; prefix arg says to show all files."
 	(set-buffer-major-mode! log-buffer (ref-mode-object vc-log))
 	(if (vc-master? master)
 	    (vc-mode-line master log-buffer))
-	(buffer-put! log-buffer 'VC-PARENT-BUFFER
-		     (and master (vc-workfile-buffer master)))
+	(let ((buffer (and master (pathname->buffer (->workfile master)))))
+	  (if buffer
+	      (buffer-put! log-buffer 'VC-PARENT-BUFFER buffer)
+	      (buffer-remove! log-buffer 'VC-PARENT-BUFFER)))
 	(let ((window (current-window)))
 	  (let ((log-window (pop-up-buffer log-buffer #t)))
 	    (buffer-put! log-buffer
@@ -688,10 +740,10 @@ Normally shows only locked files; prefix arg says to show all files."
 	  (select-window window)))
     (guarantee-newline (buffer-end log-buffer))
     (if (vc-master? master)
-	(guarantee-vc-master-valid master))
-    ;; Signal error if log entry too long.
-    (if (vc-master? master)
-	(vc-backend-logentry-check master log-buffer))
+	(begin
+	  (guarantee-vc-master-valid master)
+	  ;; Signal error if log entry too long.
+	  (vc-backend-check-log-entry master log-buffer)))
     (let ((comment (buffer-string log-buffer)))
       ;; Enter the comment in the comment ring.
       (comint-record-input vc-comment-ring comment)
@@ -721,12 +773,8 @@ saved comments.  These can be recalled as follows:
 Entry to the vc-log submode calls the value of text-mode-hook, then
 the value of vc-log-mode-hook."
   (lambda (buffer)
-    (define-variable-local-value! buffer
-	(ref-variable-object comint-input-ring)
-      vc-comment-ring)
-    (define-variable-local-value! buffer
-	(ref-variable-object comint-last-input-match)
-      false)
+    (local-set-variable! comint-input-ring vc-comment-ring buffer)
+    (local-set-variable! comint-last-input-match #f buffer)
     (event-distributor/invoke! (ref-variable vc-log-mode-hook buffer) buffer)))
 
 (define-key 'vc-log '(#\C-c #\C-c) 'vc-finish-logentry)
@@ -739,93 +787,87 @@ the value of vc-log-mode-hook."
   "Complete the operation implied by the current log entry."
   ()
   (lambda ()
-    (let ((buffer (current-buffer)))
-      (let ((finish-entry (buffer-get buffer 'VC-LOG-FINISH-ENTRY)))
+    (let ((buffer (selected-buffer)))
+      (let ((finish-entry (buffer-get buffer 'VC-LOG-FINISH-ENTRY #f)))
 	(if (not finish-entry)
 	    (error "No log operation is pending."))
 	(finish-entry buffer)))))
 
-;;;; VC-Master Association
-
-(define (file-vc-master workfile #!optional require-master?)
-  (let ((require-master?
-	 (if (default-object? require-master?)
-	     #f
-	     require-master?))
-	(buffer (pathname->buffer workfile)))
-    (if buffer
-	(buffer-vc-master buffer require-master?)
-	(%file-vc-master workfile require-master?))))
-
-(define (current-vc-master #!optional require-master?)
-  (let ((buffer (current-buffer))
-	(require-master?
-	 (if (default-object? require-master?)
-	     #f
-	     require-master?)))
-    (if (eq? (buffer-major-mode buffer) (ref-mode-object dired))
-	(let ((file (dired-this-file)))
-	  (if file
-	      (file-vc-master (car file) require-master?)
-	      (begin
-		(if require-master? (vc-registration-error #f))
-		#f)))
-	(buffer-vc-master (or (buffer-get buffer 'VC-PARENT-BUFFER) buffer)
-			  require-master?))))
-
-(define (buffer-vc-master buffer #!optional require-master?)
-  (let ((require-master?
-	 (if (default-object? require-master?)
-	     #f
-	     require-master?))
-	(workfile (buffer-pathname buffer)))
-    (if workfile
-	(let ((master (buffer-get buffer 'VC-MASTER)))
-	  (if (and master
-		   (pathname=? workfile (vc-master-workfile master))
-		   (vc-master-valid? master))
-	      master
-	      (let ((master (%file-vc-master workfile require-master?)))
-		(buffer-put! buffer 'VC-MASTER master)
-		master)))
-	(begin
-	  (buffer-put! buffer 'VC-MASTER #f)
-	  (if require-master? (vc-registration-error buffer))
-	  #f))))
-
-(define (%file-vc-master workfile require-master?)
+;;;; VC-MASTER association
+
+(define (file-vc-master workfile error?)
   (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))))))))
+    (or (let loop ((masters known-vc-masters) (prev #f))
+	  (and (weak-pair? masters)
+	       (let ((master (weak-car masters))
+		     (masters* (weak-cdr masters)))
+		 (cond ((not master)
+			(if prev
+			    (weak-set-cdr! prev masters*)
+			    (set! known-vc-masters masters*))
+			(loop masters* prev))
+		       ((pathname=? workfile (vc-master-workfile master))
+			(loop masters* masters)	;clean rest of list
+			master)
+		       (else
+			(loop masters* masters))))))
+	(let ((master (vc-backend-find-master workfile)))
+	  (and master
+	       (begin
+		 (set! known-vc-masters (weak-cons master known-vc-masters))
+		 master)))
+	(and error? (vc-registration-error workfile)))))
+
+(define known-vc-masters '())
+
+(define (buffer-vc-master buffer error?)
+  (if (vc-dired-buffer? buffer)
+      (let ((file (dired-this-file)))
+	(if file
+	    (file-vc-master (car file) error?)
+	    (and error? (vc-registration-error #f))))
+      (let ((workfile
+	     (buffer-pathname
+	      (let loop ((buffer buffer))
+		(let ((buffer* (buffer-get buffer 'VC-PARENT-BUFFER #f)))
+		  (if buffer*
+		      (loop buffer*)
+		      buffer))))))
+	(if workfile
+	    (file-vc-master workfile error?)
+	    (and error? (vc-registration-error buffer))))))
+
+(define (current-vc-master error?)
+  (buffer-vc-master (selected-buffer) error?))
 
 (define (guarantee-vc-master-valid master)
-  (if (not (vc-master-valid? master))
-      (error "VC master file disappeared:" (vc-master-workfile master))))
+  (if (not (vc-backend-master-valid? master))
+      (error "VC master file disappeared:" (vc-master-pathname master))))
 
 (define (vc-registration-error object)
   (if (or (buffer? object) (not object))
       (editor-error "Buffer "
-		    (buffer-name (or object (current-buffer)))
+		    (buffer-name (or object (selected-buffer)))
 		    " is not associated with a file.")
       (editor-error "File "
-		    (vc-workfile-string object)
+		    (->namestring object)
 		    " is not under version control.")))
 
-;;;; VC-Master Datatype
-
-(define-structure (vc-master
-		   (constructor make-vc-master (type pathname workfile)))
-  (type #f read-only #t)
-  (pathname #f read-only #t)
-  (workfile #f read-only #t)
-  (checkout-time #f)
+;;;; VC-MASTER datatype
+
+(define-structure (vc-master (constructor make-vc-master
+					  (type pathname workfile))
+			     safe-accessors)
+  (type #f read-only #t)		;a VC-TYPE object
+  (pathname #f read-only #t)		;a PATHNAME object
+  (workfile #f read-only #t)		;a PATHNAME object
+  ;; A boolean indicating whether the file is modified.
+  %modified?
+  ;; The modification time of the master and work files when
+  ;; %MODIFIED? was last set.  Can be #F meaning %MODIFIED? doesn't
+  ;; contain valid information.
+  (mod-time #f)
+  (workfile-mod-time #f)
   (properties (make-1d-table) read-only #t))
 
 (define (vc-master-get master key default)
@@ -837,30 +879,36 @@ the value of vc-log-mode-hook."
 (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!
+(define (record-modification-state! master modified?)
+  (set-vc-master-%modified?! master modified?)
+  (set-vc-master-mod-time!
+   master
+   (file-modification-time (vc-master-pathname master)))
+  (set-vc-master-workfile-mod-time!
    master
-   (and unchanged?
-	(file-modification-time-indirect (vc-workfile-pathname master))))
+   (file-modification-time (vc-master-workfile master)))
   (vc-mode-line master #f))
 
 (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)))
+      (let ((time (file-modification-time 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)))))))
+
+;;;; VC-TYPE datatype
 
 (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 '())
+					(name display-name header-keyword))
+			   safe-accessors)
+  (name #f read-only #t)		;a symbol
+  (display-name #f read-only #t)	;a string
+  (header-keyword #f read-only #t)	;a string
+  (operations '())			;a list; see below
   (properties (make-1d-table) read-only #t))
 
 (define (vc-type-get type key default)
@@ -880,57 +928,7 @@ the value of vc-log-mode-hook."
 	(set! vc-types (cons (cons name type) vc-types)))
     type))
 
-(define vc-types
-  '())
-
-(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 vc-types '())
 
 (define (define-vc-type-operation name type procedure)
   (let ((entry (assq name (vc-type-operations type))))
@@ -951,9 +949,76 @@ the value of vc-log-mode-hook."
 
 ;;;; Back-End Calls
 
+;;; In what follows, a "revision string" has the following definition:
+;;; A revision string of #F usually refers to the head of the
+;;;   branch on which the workfile resides, but in some cases it has a
+;;;   different meaning.
+;;; A revision string with an odd number of elements specifies a branch,
+;;;   and the string refers to the head of the specified branch.
+;;; A revision string with an even number of elements specifies a
+;;;   particular revision.  When checking in, this revision must not
+;;;   exist, and must be greater than any existing revision on the
+;;;   associated trunk or branch.  When checking out, this revision
+;;;   must exist.
+;;; A revision string may be symbolic, in which case it is treated as
+;;;   the numeric string that it is bound to.
+
+(define (vc-backend-release type)
+  ;; TYPE is a VC-TYPE object.
+  ;; The return value is either a release string or #F.
+  ;; A release string matches "[0-9.]+ *.*".
+  (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 (vc-backend-find-master workfile)
+  (let loop ((types vc-types))
+    (and (pair? types)
+	 (or ((vc-type-operation (cdar types) 'FIND-MASTER) workfile)
+	     (loop (cdr types))))))
+
+(define (vc-backend-master-valid? master)
+  ;; MASTER is a VC-MASTER object.
+  ;; The return value is a boolean indicating that MASTER is valid.
+  (vc-call 'VALID? master))
+
+(define (vc-backend-default-revision master error?)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; ERROR? is a boolean.
+  ;; The default revision (usually the head of the trunk) is returned.
+  ;; If there is no such revision, then if ERROR? is true, an error is
+  ;; signalled.  Otherwise #F is returned.
+  (vc-call 'DEFAULT-REVISION master error?))
+
+(define (vc-backend-workfile-revision master)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; The last checked-in revision of the file is returned.
+  ;; If this can't be determined, #F is returned.
+  (vc-call 'WORKFILE-REVISION master))
+
+(define (vc-backend-locking-user master revision)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; REVISION is a revision string or #F.
+  ;;   A REVISION of #F refers to the last checked-in revision of the
+  ;;   workfile.
+  ;; The user holding the lock on that revision is returned.  If there
+  ;;   is no lock, or if the lock cannot be determined, #F is returned.
+  (vc-call 'LOCKING-USER master revision))
+
 (define (vc-backend-register workfile revision comment keep?)
+  ;; WORKFILE is an absolute pathname to an existing file.
+  ;; REVISION is either a revision string or #F.
+  ;; COMMENT is a comment string.
+  ;; KEEP? is either #F, #T, or LOCK.
+  ;;   #F means don't keep a copy of WORKFILE after registration.
+  ;;   #T means keep an unlocked copy.
+  ;;   LOCK means keep a locked copy.
+  ;; On return, WORKFILE must be registered.
   ((vc-type-operation
-    (if (and (not (null? vc-types))
+    (if (and (pair? vc-types)
 	     (null? (cdr vc-types)))
 	(cdar vc-types)
 	(let ((likely-types
@@ -961,7 +1026,7 @@ the value of vc-log-mode-hook."
 		 (lambda (entry)
 		   ((vc-type-operation (cdr entry) 'LIKELY-CONTROL-TYPE?)
 		    workfile)))))
-	  (if (and (not (null? likely-types))
+	  (if (and (pair? likely-types)
 		   (null? (cdr likely-types)))
 	      (cdar likely-types)
 	      (cleanup-pop-up-buffers
@@ -981,47 +1046,74 @@ the value of vc-log-mode-hook."
    workfile revision comment keep?))
 
 (define (vc-backend-checkout master revision lock? workfile)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; REVISION is either a revision string or #F.
+  ;; LOCK? is a boolean saying whether to lock the specified revision.
+  ;;   This has effect only with backends that do locking.
+  ;; WORKFILE is either an absolute pathname or #F.
+  ;;   If #F, the file is checked out into the workfile pathname of MASTER.
+  ;;   Otherwise, the file is checked out into WORKFILE.
   (vc-call 'CHECKOUT master revision lock?
 	   (and workfile
-		(not (pathname=? workfile (vc-workfile-pathname master)))
+		(not (pathname=? workfile (vc-master-workfile master)))
 		workfile)))
-
-(define (vc-backend-revert master revision)
-  (vc-call 'REVERT master revision))
 
 (define (vc-backend-checkin master revision comment keep?)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; REVISION is either a revision string or #F.
+  ;; COMMENT is a comment string.
+  ;; KEEP? is a boolean specifying that the workfile should be kept
+  ;;   after checking in.  If #F, the workfile is deleted.
+  ;; The workfile is checked in.
   (vc-call 'CHECKIN master revision comment keep?))
+
+(define (vc-backend-revert master)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; The workfile is checked out, discarding the existing workfile.
+  (vc-call 'REVERT master))
 
 (define (vc-backend-steal master revision)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; REVISION is either a revision string or #F.
+  ;; The lock is stolen from the owner without notification.
   (vc-call 'STEAL master revision))
 
-(define (vc-backend-logentry-check master log-buffer)
-  (vc-call 'LOGENTRY-CHECK master log-buffer))
-
 (define (vc-backend-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))
+  ;; MASTER is a valid VC-MASTER object.
+  ;; REV1 is either a revision string or #F.
+  ;; REV2 is either a revision string or #F.
+  ;;   If REV1 and REV2 are both #F, the workfile is compared to its
+  ;;     most recent checked-in revision.
+  ;;   If REV1 nor REV2 is #F, the specified revisions are compared.
+  ;;   Otherwise, the workfile is compared to the specified revision.
+  ;; SIMPLE? is a boolean specifying how the comparison is performed.
+  ;;   If #T, only the result of the comparison is interesting.
+  ;;   If #F, the differences are to be shown to the user.
+  (let ((different? (vc-call 'DIFF master rev1 rev2 simple?)))
+    (if (and (not rev1) (not rev2))
+	(record-modification-state! master different?))
+    different?))
 
 (define (vc-backend-print-log master)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; The log associated with that file is popped up in another buffer.
   (vc-call 'PRINT-LOG master))
 
-(define (vc-default-version master error?)
-  (vc-call 'DEFAULT-VERSION master error?))
-
-(define (vc-workfile-version master)
-  (vc-call 'WORKFILE-VERSION master))
-
-(define (vc-locking-user master revision)
-  (vc-call 'LOCKING-USER master revision))
+(define (vc-backend-check-log-entry master log-buffer)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; LOG-BUFFER is a buffer containing a log message.
+  ;; The buffer's contents is checked for compatibility with the backend.
+  ;;   The contents may be modified by this call.
+  ;;   The contents might also be rejected by signalling an error.
+  (vc-call 'CHECK-LOG-ENTRY master log-buffer))
 
 (define (vc-backend-check-headers master buffer)
+  ;; MASTER is a valid VC-MASTER object.
+  ;; BUFFER is the workfile buffer.
+  ;; Examines the buffer contents to determine if they contain
+  ;; appropriate revision-control header strings.  Returns #t iff the
+  ;; header strings are present.
   (vc-call 'CHECK-HEADERS master buffer))
-
-(define (vc-master-valid? master)
-  (vc-call 'VALID? master))
 
 ;;;; RCS Commands
 
@@ -1031,142 +1123,18 @@ the value of vc-log-mode-hook."
   (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 (get-rcs-admin master)))
-      (let ((delta (rcs-find-delta admin revision #f)))
-	(if delta
-	    (let loop ((locks (rcs-admin/locks admin)))
-	      (and (not (null? locks))
-		   (if (eq? delta (cdar locks))
-		       (caar locks)
-		       (loop (cdr locks)))))
-	    ;; Kludge: this causes the next action to be a checkin.
-	    (current-user-name))))))
+  (subdirectory-pathname workfile "RCS"))
 
 (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
-    (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? (rcs-directory workfile))))
-
-(define-vc-type-operation 'REGISTER vc-type:rcs
-  (lambda (workfile revision comment keep?)
-    (with-vc-command-message workfile "Registering"
-      (lambda ()
-	(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 '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)
-    (with-vc-command-message master "Checking out"
-      (lambda ()
-	(if workfile
-	    ;; RCS makes it difficult to check a file out into anything
-	    ;; but the working file.
-	    (begin
-	      (delete-file-no-errors workfile)
-	      (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 '() "co"
-			    (rcs-rev-switch (if lock? "-l" "-r") revision)
-			    (rcs-mtime-switch 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 '() "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 keep?)
-    (with-vc-command-message master "Checking in"
-      (lambda ()
-	(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 '() "rcs"
-			"-M"
-			(rcs-rev-switch "-u" revision)
-			(rcs-rev-switch "-l" revision)
-			(vc-workfile-pathname master))))))
 
 (define (rcs-rev-switch switch revision)
   (if revision
@@ -1174,52 +1142,47 @@ the value of vc-log-mode-hook."
       switch))
 
 (define (rcs-mtime-switch master)
-  (and (ref-variable vc-rcs-preserve-mod-times (vc-workfile-buffer master))
+  (and (ref-variable vc-rcs-preserve-mod-times
+		     (pathname->buffer (->workfile master)))
        "-M"))
 
-(define-vc-type-operation 'LOGENTRY-CHECK vc-type:rcs
-  (lambda (master log-buffer)
-    master log-buffer
-    unspecific))
+(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 'DIFF vc-type:rcs
-  (lambda (master rev1 rev2 simple?)
-    (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 'FIND-MASTER vc-type:rcs
+  (lambda (workfile)
+    (let ((try
+	   (lambda (transform)
+	     (let ((master-file (transform workfile)))
+	       (and (file-exists? master-file)
+		    (make-vc-master vc-type:rcs master-file 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)))))
+      (or (try (lambda (workfile) (rcs-file (in-rcs-directory workfile))))
+	  (try in-rcs-directory)
+	  (try rcs-file)))))
 
-(define-vc-type-operation 'PRINT-LOG vc-type:rcs
+(define-vc-type-operation 'VALID? vc-type:rcs
   (lambda (master)
-    (vc-run-command master '() "rlog" (vc-workfile-pathname master))))
+    (file-exists? (vc-master-pathname master))))
 
-(define-vc-type-operation 'DEFAULT-VERSION vc-type:rcs
+(define-vc-type-operation 'DEFAULT-REVISION 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
+
+(define-vc-type-operation 'WORKFILE-REVISION vc-type:rcs
   (lambda (master)
     (let ((parse-buffer
 	   (lambda (buffer)
@@ -1232,7 +1195,7 @@ the value of vc-log-mode-hook."
 					       start end #f)))
 			  (and mark
 			       (skip-chars-forward " " mark end #f)))))
-		     (get-version
+		     (get-revision
 		      (lambda (start)
 			(let ((end (skip-chars-forward "0-9." start end)))
 			  (and (mark< start end)
@@ -1245,14 +1208,14 @@ the value of vc-log-mode-hook."
 							 #f)))))))))
 		 (cond ((or (find-keyword "Id") (find-keyword "Header"))
 			=> (lambda (mark)
-			     (get-version
+			     (get-revision
 			      (skip-chars-forward
 			       " "
 			       (skip-chars-forward "^ " mark end)
 			       end))))
-		       ((find-keyword "Revision") => get-version)
+		       ((find-keyword "Revision") => get-revision)
 		       (else #f)))))))
-      (let ((pathname (vc-workfile-pathname master)))
+      (let ((pathname (vc-master-workfile master)))
 	(let ((buffer (pathname->buffer pathname)))
 	  (if buffer
 	      (parse-buffer buffer)
@@ -1263,39 +1226,174 @@ the value of vc-log-mode-hook."
 		      (read-buffer buffer pathname #f)
 		      (parse-buffer buffer)))))))))))
 
+(define-vc-type-operation 'LOCKING-USER vc-type:rcs
+  (lambda (master revision)
+    (let ((admin (get-rcs-admin master)))
+      (let ((delta
+	     (rcs-find-delta admin
+			     (or revision
+				 (vc-backend-workfile-revision master))
+			     #f)))
+	(and delta
+	     (let loop ((locks (rcs-admin/locks admin)))
+	       (and (not (null? locks))
+		    (if (eq? delta (cdar locks))
+			(caar locks)
+			(loop (cdr locks))))))))))
+
+(define-vc-type-operation 'LIKELY-CONTROL-TYPE? vc-type:rcs
+  (lambda (workfile)
+    (file-directory? (rcs-directory workfile))))
+
+(define-vc-type-operation 'REGISTER vc-type:rcs
+  (lambda (workfile revision comment keep?)
+    (with-vc-command-message workfile "Registering"
+      (lambda ()
+	(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)
+			(rcs-mtime-switch workfile)
+			(string-append "-t-" comment)
+			workfile)))))
+
+(define-vc-type-operation 'CHECKOUT vc-type:rcs
+  (lambda (master revision lock? workfile)
+    (let ((revision (or revision (vc-backend-workfile-revision master))))
+      (with-vc-command-message master "Checking out"
+	(lambda ()
+	  (if workfile
+	      ;; RCS makes it difficult to check a file out into anything
+	      ;; but the working file.
+	      (begin
+		(delete-file-no-errors workfile)
+		(vc-run-shell-command master '() "co"
+				      (rcs-rev-switch "-p" revision)
+				      (vc-master-workfile master)
+				      ">"
+				      workfile)
+		(set-file-modes! workfile (if lock? #o644 #o444)))
+	      (begin
+		(vc-run-command master '() "co"
+				(rcs-rev-switch (if lock? "-l" "-r") revision)
+				(rcs-mtime-switch master)
+				(vc-master-workfile master))
+		(if (not workfile)
+		    (record-modification-state! master #f)))))))))
+
+(define-vc-type-operation 'CHECKIN vc-type:rcs
+  (lambda (master revision comment keep?)
+    (with-vc-command-message master "Checking in"
+      (lambda ()
+	(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)
+			(rcs-mtime-switch master)
+			(string-append "-m" comment)
+			(vc-master-workfile master))))))
+
+(define-vc-type-operation 'REVERT vc-type:rcs
+  (lambda (master)
+    (with-vc-command-message master "Reverting"
+      (lambda ()
+	(vc-run-command master '() "co"
+			"-f" "-u"
+			(rcs-mtime-switch master)
+			(vc-master-workfile 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."))
+    (let ((revision (or revision (vc-backend-workfile-revision master))))
+      (with-vc-command-message master "Stealing lock on"
+	(lambda ()
+	  (vc-run-command master '() "rcs"
+			  "-M"
+			  (rcs-rev-switch "-u" revision)
+			  (rcs-rev-switch "-l" revision)
+			  (vc-master-workfile master)))))))
+
+(define-vc-type-operation 'DIFF vc-type:rcs
+  (lambda (master rev1 rev2 simple?)
+    (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"
+	      (if (and rev1 rev2)
+		  (list (string-append "-r" rev1)
+			(string-append "-r" rev2))
+		  (let ((rev
+			 (or rev1 rev2 (vc-backend-workfile-revision master))))
+		    (and rev
+			 (string-append "-r" rev))))
+	      (if simple?
+		  '()
+		  (ref-variable diff-switches
+				(vc-workfile-buffer master)))
+	      (vc-master-workfile master)))))
+      (= 1
+	 (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 '() "rlog" (vc-master-workfile master))))
+
+(define-vc-type-operation 'CHECK-LOG-ENTRY vc-type:rcs
+  (lambda (master log-buffer)
+    master log-buffer
+    unspecific))
+
+(define-vc-type-operation 'CHECK-HEADERS vc-type:rcs
+  (lambda (master buffer)
+    master
+    (check-rcs-headers buffer)))
+
 ;;;; CVS Commands
 
 (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))
+	 (time (file-modification-time 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)))
+	   (vc-master-put! master 'CVS-WORKFILE-REVISION (cadr tokens))
+	   (let ((mtime (file-modification-time workfile)))
 	     (if (string=? (file-time->global-ctime-string mtime)
 			   (caddr tokens))
-		 (set-vc-master-checkout-time! master mtime)
+		 (begin
+		   (set-vc-master-%modified?! master #f)
+		   (set-vc-master-mod-time! master time)
+		   (set-vc-master-workfile-mod-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")))))
+  (subdirectory-pathname workfile "CVS"))
 
-(define (get-cvs-workfile-version master error?)
-  (vc-master-read-cached-value master 'CVS-WORKFILE-VERSION
+(define (get-cvs-workfile-revision master error?)
+  (vc-master-read-cached-value master 'CVS-WORKFILE-REVISION
     (lambda ()
       (let ((tokens (find-cvs-entry master)))
 	(if tokens
@@ -1321,8 +1419,20 @@ the value of vc-log-mode-hook."
 				  (loop)))
 			    (loop)))))))))))
 
+(define (cvs-status master)
+  (call-with-values (lambda () (get-cvs-status master))
+    (lambda (status revision)
+      revision
+      status)))
+
+(define (cvs-default-revision master)
+  (call-with-values (lambda () (get-cvs-status master))
+    (lambda (status revision)
+      status
+      revision)))
+
 (define (get-cvs-status master)
-  (let ((pathname (vc-workfile-pathname master)))
+  (let ((pathname (vc-master-workfile master)))
     (vc-run-command master
 		    `((DIRECTORY ,(directory-pathname pathname))
 		      (BUFFER " *vc-status*"))
@@ -1334,7 +1444,7 @@ the value of vc-log-mode-hook."
 		(extract-string (re-match-start 1) (re-match-end 1)))
 	       'UNKNOWN)))
       (if (eq? 'UP-TO-DATE status)
-	  (sync-checkout-time! master #t))
+	  (record-modification-state! master #f))
       (values
        status
        (if (re-search-forward
@@ -1366,10 +1476,6 @@ the value of vc-log-mode-hook."
   (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"))
@@ -1377,35 +1483,35 @@ the value of vc-log-mode-hook."
 			    (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
+(define-vc-type-operation 'FIND-MASTER vc-type:cvs
+  (lambda (workfile)
+    (find-cvs-master workfile)))
+
+(define-vc-type-operation 'VALID? vc-type:cvs
+  (lambda (master)
+    (get-cvs-workfile-revision master #f)))
+
+(define-vc-type-operation 'DEFAULT-REVISION vc-type:cvs
   (lambda (master error?)
-    (or (call-with-values (lambda () (get-cvs-status master))
-	  (lambda (status revision)
-	    status
-	    revision))
+    (or (cvs-default-revision master)
 	(and error?
 	     (error "Unable to determine default CVS version:"
-		    (vc-workfile-pathname master))))))
+		    (vc-master-workfile master))))))
 
-(define-vc-type-operation 'WORKFILE-VERSION vc-type:cvs
+(define-vc-type-operation 'WORKFILE-REVISION vc-type:cvs
   (lambda (master)
-    (get-cvs-workfile-version master #f)))
+    (get-cvs-workfile-revision master #f)))
 
-(define-vc-type-operation 'CHECK-HEADERS vc-type:cvs
-  (lambda (master buffer)
-    master
-    (check-rcs-headers buffer)))
+(define-vc-type-operation 'LOCKING-USER vc-type:cvs
+  (lambda (master revision)
+    ;; The workfile is "locked" if it is modified.
+    ;; 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)
+	 (unix/uid->string
+	  (file-attributes/uid
+	   (file-attributes (vc-master-workfile master)))))))
 
 (define-vc-type-operation 'LIKELY-CONTROL-TYPE? vc-type:cvs
   (lambda (workfile)
@@ -1418,8 +1524,8 @@ the value of vc-log-mode-hook."
       (lambda ()
 	(vc-run-command workfile '() "cvs" "add"
 			"-m" comment
-			(vc-workfile-pathname workfile))))))
-
+			workfile)))))
+
 (define-vc-type-operation 'CHECKOUT vc-type:cvs
   (lambda (master revision lock? workfile)
     lock?				;locking not used with CVS
@@ -1429,20 +1535,15 @@ the value of vc-log-mode-hook."
 	   (delete-file-no-errors workfile)
 	   (vc-run-shell-command master '() "cvs" "update" "-p"
 				 (cvs-rev-switch revision)
-				 (vc-workfile-pathname master)
+				 (vc-master-workfile 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))))
+			   (vc-master-workfile master))
+	   (record-modification-state! master #f)))))
 
 (define-vc-type-operation 'CHECKIN vc-type:cvs
   (lambda (master revision comment keep?)
@@ -1450,118 +1551,154 @@ the value of vc-log-mode-hook."
     (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)))
+	  (if (eq? 'NEEDS-MERGE (cvs-status master))
 	      (error "Type C-x 0 C-x C-q to merge in changes.")))
       (lambda ()
 	(if (and revision
-		 (not (equal? revision (vc-workfile-version master)))
+		 (not (equal? revision (vc-backend-workfile-revision master)))
 		 (trunk-revision? revision))
 	    (vc-run-command master '() "cvs" "commit"
 			    "-m" "#intermediate"
-			    (vc-workfile-pathname master)))
+			    (vc-master-workfile master)))
 	(vc-run-command master '() "cvs" "commit"
 			(cvs-rev-switch revision)
 			"-m" comment
-			(vc-workfile-pathname master))))
+			(vc-master-workfile master))))
     ;; If this was an explicit check-in, remove the sticky tag.
     (vc-run-command master '() "cvs" "update" "-A"
-		    (vc-workfile-pathname master))))
+		    (vc-master-workfile master))))
+
+(define-vc-type-operation 'REVERT vc-type:cvs
+  (lambda (master)
+     ;; Check out via standard output, so that no sticky tag is set.
+    (vc-backend-checkout master #f #f (vc-master-workfile 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))
+      (if (equal? "0" (vc-backend-workfile-revision 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)))
+		(error "No revisions exist:" (vc-master-workfile master)))
 	    (if simple?
 		;; File is added but not committed; we regard this as
 		;; "changed".
-		1
+		#t
 		;; 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))))))
+		(= 1
+		   (vc-run-command master options "diff"
+				   (ref-variable diff-switches
+						 (vc-workfile-buffer master))
+				   "/dev/null"
+				   (vc-master-workfile master)))))
+	  (= 1
+	     (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-master-workfile master)))))))
 
 (define-vc-type-operation 'PRINT-LOG vc-type:cvs
   (lambda (master)
-    (vc-run-command master '() "cvs" "log" (vc-workfile-pathname master))))
+    (vc-run-command master '() "cvs" "log" (vc-master-workfile master))))
+
+(define-vc-type-operation 'CHECK-LOG-ENTRY vc-type:cvs
+  (lambda (master log-buffer)
+    master log-buffer
+    unspecific))
+
+(define-vc-type-operation 'CHECK-HEADERS vc-type:cvs
+  (lambda (master buffer)
+    master
+    (check-rcs-headers buffer)))
+
+(define (cvs-backend-merge-news master)
+  (let ((msg
+	 (string-append "Merging changes into "
+			(vc-workfile-string master)
+			"...")))
+    (message msg)
+    (vc-run-command master '() "cvs" "update" (vc-master-workfile master))
+    (let ((buffer (get-vc-command-buffer))
+	  (fn (re-quote-string (file-namestring (vc-master-workfile master)))))
+      (cond ((re-search-forward
+	      (string-append "^\\([CMUP]\\) " fn)
+	      (buffer-start buffer))
+	     (let ((conflicts?
+		    (char=? #\C (extract-right-char (re-match-start 0)))))
+	       (message msg "done")
+	       conflicts?))
+	    ((re-search-forward
+	      (string-append fn " already contains the differences between ")
+	      (buffer-start buffer))
+	     ;; Special case: file contents in sync with repository
+	     ;; anyhow:
+	     (message msg "done")
+	     #f)
+	    (else
+	     (pop-up-buffer buffer)
+	     (error "Couldn't analyze cvs update result."))))))
 
 ;;;; Command Execution
 
 (define (vc-run-command master options command . arguments)
-  (let ((option
+  (let ((workfile (and master (->workfile master)))
+	(option
 	 (lambda (name default)
 	   (let ((option (assq name options)))
 	     (if option
 		 (cadr option)
 		 (default))))))
-  (let ((command-messages?
-	 (ref-variable vc-command-messages
-		       (and master (vc-workfile-buffer master))))
-	(msg
-	 (string-append "Running " command
-			(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
-		  (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))
-	  (begin
-	    (if command-messages? (message msg "done"))
-	    (cdr result))
-	  (begin
-	    (pop-up-vc-command-buffer #f)
-	    (editor-error "Running " command "...FAILED "
-			  (list (car result) (cdr result)))))))))
+    (let ((command-messages?
+	   (ref-variable vc-command-messages
+			 (and workfile (pathname->buffer workfile))))
+	  (msg
+	   (string-append "Running " command
+			  (if master
+			      (string-append " on " (->namestring workfile))
+			      "")
+			  "..."))
+	  (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
+		    (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))
+	    (begin
+	      (if command-messages? (message msg "done"))
+	      (cdr result))
+	    (begin
+	      (pop-up-vc-command-buffer #f)
+	      (editor-error "Running " command "...FAILED "
+			    (list (car result) (cdr result)))))))))
 
 (define (vc-command-arguments arguments)
   (append-map (lambda (argument)
@@ -1587,67 +1724,117 @@ the value of vc-log-mode-hook."
   (find-or-create-buffer "*vc*"))
 
 (define (with-vc-command-message master operation thunk)
-  (let ((msg (string-append operation " " (vc-workfile-string master) "...")))
+  (let ((msg
+	 (string-append operation " " (->namestring (->workfile master))
+			"...")))
     (message msg)
     (thunk)
     (message msg "done")))
 
-;;;; Workfile Utilities
+;;;; Release/Revision numbers
+
+(define (vc-release? type release)
+  (let ((release* (vc-backend-release type)))
+    (and 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 (vc-normalize-revision revision)
+  (and revision
+       (not (string-null? revision))
+       revision))
+
+;;;; Utilities
+
+(define (blank-string? string)
+  (not (string-find-next-char-in-set string char-set:not-whitespace)))
+
+(define (subdirectory-pathname pathname name)
+  (let ((directory (directory-pathname pathname)))
+    (pathname-new-directory directory
+			    (append (pathname-directory directory)
+				    (list name)))))
 
 (define (vc-keep-workfiles? 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?)
+(define (vc-update-workfile-buffer workfile 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)))
+  (let ((buffer (pathname->buffer workfile)))
     (if buffer
 	(if keep?
 	    (vc-revert-buffer buffer #t)
 	    (kill-buffer buffer)))))
 
-(define (vc-get-version revision prompt)
-  (vc-normalize-version (if (or (not revision) (string? revision))
-			    revision
-			    (prompt-for-string prompt #f))))
+(define (vc-get-revision revision prompt)
+  (vc-normalize-revision (if (or (not revision) (string? revision))
+			     revision
+			     (prompt-for-string prompt #f))))
 
-(define (vc-normalize-version revision)
-  (and revision
-       (not (string-null? revision))
-       revision))
+(define (->workfile object)
+  (cond ((vc-master? object) (vc-master-workfile object))
+	((pathname? object) object)
+	(else (error:wrong-type-argument object "workfile" '->WORKFILE))))
 
 (define (vc-workfile-buffer master)
-  (pathname->buffer (vc-workfile-pathname master)))
+  (pathname->buffer (vc-master-workfile master)))
 
 (define (vc-workfile-string master)
-  (->namestring (vc-workfile-pathname master)))
-
-(define (vc-workfile-pathname master)
-  (if (vc-master? master)
-      (vc-master-workfile master)
-      master))
+  (->namestring (vc-master-workfile master)))
 
 (define (vc-workfile-modified? master)
-  (let ((mod-time
-	 (file-modification-time-indirect (vc-workfile-pathname master))))
-    (cond ((not mod-time) #f)
-	  ((eqv? (vc-master-checkout-time master) mod-time) #f)
-	  (else (not (= 0 (vc-backend-diff master #f #f #t)))))))
-
-(define (vc-save-workfile-buffer master)
-  (let ((buffer (vc-workfile-buffer master)))
+  (let ((tm (vc-master-mod-time master))
+	(tw (vc-master-workfile-mod-time master)))
+    (if (and tm tw
+	     (eqv? tm (file-modification-time (vc-master-pathname master)))
+	     (eqv? tw (file-modification-time (vc-master-workfile master))))
+	(vc-master-%modified? master)
+	(vc-backend-diff master #f #f #t))))
+
+(define (vc-save-workfile-buffer workfile)
+  (let ((buffer (pathname->buffer workfile)))
     (if buffer
-	(vc-save-buffer buffer))))
+	(vc-save-buffer buffer #t))))
 
-(define (vc-save-buffer buffer)
+(define (vc-save-buffer buffer error?)
   (if (buffer-modified? buffer)
       (begin
-	(if (not (or (ref-variable vc-suppress-confirm buffer)
-		     (prompt-for-confirmation?
-		      (string-append "Buffer "
-				     (buffer-name buffer)
-				     " modified; save it"))))
+	(if (and (not (or (ref-variable vc-suppress-confirm buffer)
+			  (prompt-for-confirmation?
+			   (string-append "Buffer "
+					  (buffer-name buffer)
+					  " modified; save it"))))
+		 error?)
 	    (editor-error "Aborted"))
 	(save-buffer buffer #f))))