(vc-next-action-on-file): Properly handle the case when user tries to

check-in, but file on disk has changed.
(vc-do-command): Consider LAST argument only if FILE is non-nil.
(vc-add-triple, vc-record-rename, vc-lookup-file): Find
vc-name-assoc-file based on vc-name of FILE.
(vc-backend-admin, vc-rename-file): Handle the SCCS PROJECTDIR feature.
(vc-do-command): Rewrote doc string.

lisp/vc.el

@@ -5,7 +5,7 @@
 ;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
 
-;; $Id: vc.el,v 1.210 1998/03/08 10:03:50 spiegel Exp spiegel $
+;; $Id: vc.el,v 1.211 1998/03/18 13:25:00 spiegel Exp spiegel $
 
 ;; This file is part of GNU Emacs.
 
@@ -524,12 +524,16 @@ If nil, VC itself computes this value when it is first needed."
 
 (defun vc-do-command (buffer okstatus command file last &rest flags)
   "Execute a version-control command, notifying user and checking for errors.
-Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.  
+Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.  The
-The command is successful if its exit status does not exceed OKSTATUS.
+command is considered successful if its exit status does not exceed
- (If OKSTATUS is nil, that means to ignore errors.)
+OKSTATUS (if OKSTATUS is nil, that means to ignore errors).  FILE is
-The last argument of the command is the master name of FILE if LAST is 
+the name of the working file (may also be nil, to execute commands
-`MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended 
+that don't expect a file name).  If FILE is non-nil, the argument LAST
-to an optional list of FLAGS."
+indicates what filename should actually be passed to the command: if
+it is `MASTER', the name of FILE's master file is used, if it is
+`WORKFILE', then FILE is passed through unchanged.  If an optional
+list of FLAGS is present, that is inserted into the command line
+before the filename."
   (and file (setq file (expand-file-name file)))
   (if (not buffer) (setq buffer "*vc*"))
   (if vc-command-messages
@@ -552,7 +556,7 @@ to an optional list of FLAGS."
      flags)
     (if (and vc-file (eq last 'MASTER))
 	(setq squeezed (append squeezed (list vc-file))))
-    (if (eq last 'WORKFILE)
+    (if (and file (eq last 'WORKFILE))
 	(progn
 	  (let* ((pwd (expand-file-name default-directory))
 		 (preflen (length pwd)))
@@ -855,8 +859,16 @@ to an optional list of FLAGS."
 	      (find-file-other-window file) 
 	    (find-file file))
 
-	  ;; give luser a chance to save before checking in.
+	  ;; If the file on disk is newer, then the user just
-	  (vc-buffer-sync)
+	  ;; said no to rereading it.  So the user probably wishes to
+	  ;; overwrite the file with the buffer's contents, and check 
+	  ;; that in.
+	  (if (not (verify-visited-file-modtime (current-buffer)))
+	      (if (yes-or-no-p "Replace file on disk with buffer contents? ")
+		  (write-file (buffer-file-name))
+		(error "Aborted"))
+	    ;; give luser a chance to save before checking in.
+	    (vc-buffer-sync))
 
 	  ;; Revert if file is unchanged and buffer is too.
 	  ;; If buffer is modified, that means the user just said no
@@ -1668,9 +1680,7 @@ in all these directories.  With a prefix argument, it lists all files."
   (save-excursion
     (find-file (expand-file-name
 		vc-name-assoc-file
-		(file-name-as-directory
+                (file-name-directory (vc-name file))))
-		 (expand-file-name (vc-backend-subdirectory-name file) 
-				   (file-name-directory file)))))
     (goto-char (point-max))
     (insert name "\t:\t" file "\t" rev "\n")
     (basic-save-buffer)
@@ -1682,9 +1692,7 @@ in all these directories.  With a prefix argument, it lists all files."
     (find-file
      (expand-file-name
       vc-name-assoc-file
-      (file-name-as-directory
+      (file-name-directory (vc-name file))))
-       (expand-file-name (vc-backend-subdirectory-name file) 
-			 (file-name-directory file)))))
     (goto-char (point-min))
     ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
     (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
@@ -1706,9 +1714,7 @@ in all these directories.  With a prefix argument, it lists all files."
 	   (vc-insert-file
 	    (expand-file-name
 	     vc-name-assoc-file
-	     (file-name-as-directory
+             (file-name-directory (vc-name file))))
-	      (expand-file-name (vc-backend-subdirectory-name file) 
-				(file-name-directory file)))))
 	   (prog1
 	       (car (vc-parse-buffer
 		     (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
@@ -1962,7 +1968,7 @@ A prefix argument means do not revert the buffer afterwards."
 	(error "Already editing new file name"))
     (if (file-exists-p new)
 	(error "New file already exists"))
-    (let ((oldmaster (vc-name old)))
+    (let ((oldmaster (vc-name old)) newmaster)
       (if oldmaster
 	  (progn
 	    (if (vc-locking-user old)
@@ -1971,23 +1977,32 @@ A prefix argument means do not revert the buffer afterwards."
 		    ;; This had FILE, I changed it to OLD. -- rms.
 		    (file-symlink-p (vc-backend-subdirectory-name old)))
 		(error "This is not a safe thing to do in the presence of symbolic links"))
-	    (rename-file
+            (setq newmaster
-	     oldmaster
+                  (let ((backend (vc-backend old))
-	     (let ((backend (vc-backend old))
+                        (newdir (or (file-name-directory new) ""))
-		   (newdir (or (file-name-directory new) ""))
+                        (newbase (file-name-nondirectory new)))
-		   (newbase (file-name-nondirectory new)))
+                    (catch 'found
-	       (catch 'found
+                      (mapcar
-		 (mapcar
+                       (function
-		  (function
+                        (lambda (s)
-		   (lambda (s)
+                          (if (eq backend (cdr s))
-		     (if (eq backend (cdr s))
+                              (let* ((newmaster (format (car s) newdir newbase))
-			 (let* ((newmaster (format (car s) newdir newbase))
+                                     (newmasterdir (file-name-directory newmaster)))
-				(newmasterdir (file-name-directory newmaster)))
+                                (if (or (not newmasterdir)
-			   (if (or (not newmasterdir)
+                                        (file-directory-p newmasterdir))
-				   (file-directory-p newmasterdir))
+                                    (throw 'found newmaster))))))
-			       (throw 'found newmaster))))))
+                       vc-master-templates)
-		  vc-master-templates)
+                      (error "New file lacks a version control directory"))))
-		 (error "New file lacks a version control directory"))))))
+            ;; Handle the SCCS PROJECTDIR feature.  It is odd that this 
+            ;; is a special case, but a more elegant solution would require
+            ;; significant changes in other parts of VC.
+            (if (eq (vc-backend old) 'SCCS)
+                (let ((project-dir (vc-sccs-project-dir)))
+                  (if project-dir
+                      (setq newmaster 
+                            (concat project-dir 
+                                    (file-name-nondirectory newmaster))))))
+            (rename-file oldmaster newmaster)))
       (if (or (not oldmaster) (file-exists-p old))
 	  (rename-file old new)))
 ; ?? Renaming a file might change its contents due to keyword expansion.
@@ -2289,31 +2304,34 @@ THRESHOLD, nil otherwise"
   (or vc-default-back-end
       (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
   (message "Registering %s..." file)
-  (let ((switches
+  (let* ((switches
-         (if (stringp vc-register-switches)
+          (if (stringp vc-register-switches)
-             (list vc-register-switches)
+              (list vc-register-switches)
-           vc-register-switches))
+            vc-register-switches))
-        (backend
+         (project-dir)
-	 (cond
+         (backend
-	  ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
+          (cond
-	  ((file-exists-p "RCS") 'RCS)
+           ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
-	  ((file-exists-p "SCCS") 'SCCS)
+           ((file-exists-p "RCS") 'RCS)
-	  ((file-exists-p "CVS") 'CVS)
+           ((file-exists-p "CVS") 'CVS)
-	  (t vc-default-back-end))))
+           ((file-exists-p "SCCS") 'SCCS)
+           ((setq project-dir (vc-sccs-project-dir)) 'SCCS)
+           (t vc-default-back-end))))
     (cond ((eq backend 'SCCS)
-	   ;; If there is no SCCS subdirectory yet, create it.
+           (let ((vc-name
-           ;; (SCCS could do without it, but VC requires it to be there.)
+                  (if project-dir (concat project-dir 
-           (if (not (file-exists-p "SCCS")) (make-directory "SCCS"))
+                                          "s." (file-name-nondirectory file))
-	   (apply 'vc-do-command nil 0 "admin" file 'MASTER	;; SCCS
+                    (format
-                                 (and rev (concat "-r" rev))
+                     (car (rassq 'SCCS vc-master-templates))
-                                 "-fb"
+                     (or (file-name-directory file) "")
-                                 (concat "-i" file)
+                     (file-name-nondirectory file)))))
-                                 (and comment (concat "-y" comment))
+             (apply 'vc-do-command nil 0 "admin" nil nil	;; SCCS
-                                 (format
+                                   (and rev (concat "-r" rev))
-                                  (car (rassq 'SCCS vc-master-templates))
+                                   "-fb"
-                                  (or (file-name-directory file) "")
+                                   (concat "-i" file)
-                                  (file-name-nondirectory file))
+                                   (and comment (concat "-y" comment))
-                                 switches)
+                                   vc-name
+                                   switches))
 	   (delete-file file)
 	   (if vc-keep-workfiles
 	       (vc-do-command nil 0 "get" file 'MASTER)))