(vc-rcs-workfile-is-newer): New function.

(vc-rcs-state-heuristic): Use it to guess the state of files with
non-strict locking.
(vc-rcs-find-most-recent-rev): Handle the case when a branch has been
set with -b, but not created yet.
(vc-rcs-fetch-master-state): With non-strict locking, compare file
contents in order to find the state.
(vc-rcs-checkin): Allow creation of branches with no changes.
(vc-rcs-unregister, vc-rcs-receive-file,
vc-rcs-set-non-strict-locking): New functions.

1 files changed, 90 insertions, 7 deletions

diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 2cc42744dc4..758b8ce628c 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -5,7 +5,7 @@
 ;; Author:     FSF (see vc.el for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 
-;; $Id: vc-rcs.el,v 1.3 2000/09/07 20:02:38 fx Exp $
+;; $Id: vc-rcs.el,v 1.4 2000/09/09 00:48:40 monnier Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -132,7 +132,11 @@ For a description of possible values, see `vc-check-master-templates'."
                    (not (vc-mistrust-permissions file)))
               (cond
                ((string-match ".rw..-..-." (nth 8 (file-attributes file)))
-                (vc-file-setprop file 'vc-checkout-model 'implicit))
+                (vc-file-setprop file 'vc-checkout-model 'implicit)
+		(setq state 
+		      (if (vc-rcs-workfile-is-newer file) 
+			  'edited 
+			'up-to-date)))
                ((string-match ".r-..-..-." (nth 8 (file-attributes file)))
                 (vc-file-setprop file 'vc-checkout-model 'locking))))
           state)
@@ -144,15 +148,29 @@ For a description of possible values, see `vc-check-master-templates'."
                    (vc-file-setprop file 'vc-checkout-model 'locking)
                    'up-to-date)
                   ((string-match ".rw..-..-." permissions)
-                   (if (file-ownership-preserved-p file)
-                       'edited
-                     (vc-user-login-name owner-uid)))
+		   (if (eq (vc-checkout-model file) 'locking)
+		       (if (file-ownership-preserved-p file)
+			   'edited
+			 (vc-user-login-name owner-uid))
+		     (if (vc-rcs-workfile-is-newer file) 
+			 'edited
+		       'up-to-date)))
                   (t
                    ;; Strange permissions.  Fall through to
                    ;; expensive state computation.
                    (vc-rcs-state file))))
         (vc-rcs-state file)))))
 
+(defun vc-rcs-workfile-is-newer (file)
+  "Return non-nil if FILE is newer than its RCS master.
+This likely means that FILE has been changed with respect
+to its master version."
+  (let ((file-time (nth 5 (file-attributes file)))
+	(master-time (nth 5 (file-attributes (vc-name file)))))
+    (or (> (nth 0 file-time) (nth 0 master-time))
+	(and (= (nth 0 file-time) (nth 0 master-time))
+	     (> (nth 1 file-time) (nth 1 master-time))))))
+
 (defun vc-rcs-workfile-version (file)
   "RCS-specific version of `vc-workfile-version'."
   (or (and vc-consult-headers
@@ -182,7 +200,8 @@ For a description of possible values, see `vc-check-master-templates'."
 	(when (< latest-rev rev)
 	  (setq latest-rev rev)
 	  (setq value (match-string 1)))))
-    value))
+    (or value
+	(vc-rcs-branch-part branch))))
 
 (defun vc-rcs-fetch-master-state (file &optional workfile-version)
   "Compute the master file's idea of the state of FILE.
@@ -234,7 +253,12 @@ file."
           (if (or workfile-is-latest
                   (vc-rcs-latest-on-branch-p file workfile-version))
               ;; workfile version is latest on branch
-              'up-to-date
+              (if (eq (vc-checkout-model file) 'locking)
+		  'up-to-date
+		(require 'vc)
+		(if (vc-workfile-unchanged-p file)
+		    'up-to-date
+		  'edited))
             ;; workfile version is not latest on branch
             'needs-patch))
 	 ;; locked by the calling user
@@ -565,6 +589,10 @@ CVS releases are handled reasonably, too \(1.3 < 1.4* < 1.5\)."
 	     (and (vc-rcs-release-p "5.6.4") "-j")
 	     (concat (if vc-keep-workfiles "-u" "-r") rev)
 	     (concat "-m" comment)
+	     ;; allow creation of branches with no changes;
+	     ;; this is used by vc-rcs-receive-file if the
+	     ;; base version cannot be found
+	     (if (string-match ".1.1$" rev) "-f")
 	     switches)
       (vc-file-setprop file 'vc-workfile-version nil)
 
@@ -680,6 +708,61 @@ expanded if `vc-keep-workfiles' is non-nil, otherwise, delete the workfile."
                               nil t)
                              (match-string 1))))))
 
+(defun vc-rcs-unregister (file)
+  "Unregister FILE from RCS.
+If this leaves the RCS subdirectory empty, ask the user
+whether to remove it."
+  (let* ((master (vc-name file))
+	 (dir (file-name-directory master)))
+    (delete-file master)
+    (and (string= (file-name-nondirectory (directory-file-name dir)) "RCS")
+	 ;; check whether RCS dir is empty, i.e. it does not
+	 ;; contain any files except "." and ".."
+	 (not (directory-files dir nil 
+			       "^\\([^.]\\|\\.[^.]\\|\\.\\.[^.]\\).*"))
+	 (yes-or-no-p (format "Directory %s is empty; remove it? " dir))
+	 (delete-directory dir))))
+
+(defun vc-rcs-receive-file (file move)
+  "Implementation of receive-file for RCS."
+  (let ((old-backend (vc-backend file))
+	(rev (vc-workfile-version file))
+	(state (vc-state file))
+	(checkout-model (vc-checkout-model file))
+	(comment (and move
+		      (vc-find-backend-function old-backend 'comment-history)
+		      (vc-call 'comment-history file))))
+    (if move (vc-unregister file old-backend))
+    (vc-file-clearprops file)
+    (if (not (vc-rcs-registered file))
+	(progn
+	  (with-vc-properties 
+	   file
+	   ;; TODO: If the file was 'edited under the old backend,
+	   ;; this should actually register the version 
+	   ;; it was based on.
+	   (vc-rcs-register file rev "")
+	   `((vc-backend ,backend)))
+	  (if (eq checkout-model 'implicit)
+	      (vc-rcs-set-non-strict-locking file))
+	  (if (not move)
+	      (vc-do-command nil 0 "rcs" file (concat "-b" rev ".1"))))
+      (vc-file-setprop file 'vc-backend backend)
+      (vc-file-setprop file 'vc-state 'edited)
+      (set-file-modes file
+		      (logior (file-modes file) 128)))
+    (when (or move (eq state 'edited))
+      (vc-file-setprop file 'vc-state 'edited)
+      ;; TODO: The comment history should actually become the
+      ;; initial contents of the log entry buffer.
+      (and comment (ring-insert vc-comment-ring comment))
+      (vc-checkin file (concat rev ".1.1")))))
+
+(defun vc-rcs-set-non-strict-locking (file)
+  (vc-do-command nil 0 "rcs" file "-U")
+  (vc-file-setprop file 'vc-checkout-model 'implicit)
+  (set-file-modes file (logior (file-modes file) 128)))
+
 (defun vc-rcs-checkout (file &optional writable rev workfile)
   "Retrieve a copy of a saved version of FILE into a workfile."
   (let ((filename (or workfile file))