(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.

diff --git a/lisp/vc.el b/lisp/vc.el
index ea2978b..1e047da 100644 (file)
--- a/lisp/vc.el
+++ b/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.  
-The command is successful if its exit status does not exceed OKSTATUS.
- (If OKSTATUS is nil, that means to ignore errors.)
-The last argument of the command is the master name of FILE if LAST is 
-`MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended 
-to an optional list of FLAGS."
+Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.  The
+command is considered successful if its exit status does not exceed
+OKSTATUS (if OKSTATUS is nil, that means to ignore errors).  FILE is
+the name of the working file (may also be nil, to execute commands
+that don't expect a file name).  If FILE is non-nil, the argument LAST
+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.
-         (vc-buffer-sync)
+         ;; 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.
+         (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
-                (expand-file-name (vc-backend-subdirectory-name file) 
-                                  (file-name-directory file)))))
+                (file-name-directory (vc-name 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
-       (expand-file-name (vc-backend-subdirectory-name file) 
-                        (file-name-directory file)))))
+      (file-name-directory (vc-name 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
-             (expand-file-name (vc-backend-subdirectory-name file) 
-                               (file-name-directory file)))))
+             (file-name-directory (vc-name 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
-            oldmaster
-            (let ((backend (vc-backend old))
-                  (newdir (or (file-name-directory new) ""))
-                  (newbase (file-name-nondirectory new)))
-              (catch 'found
-                (mapcar
-                 (function
-                  (lambda (s)
-                    (if (eq backend (cdr s))
-                        (let* ((newmaster (format (car s) newdir newbase))
-                               (newmasterdir (file-name-directory newmaster)))
-                          (if (or (not newmasterdir)
-                                  (file-directory-p newmasterdir))
-                              (throw 'found newmaster))))))
-                 vc-master-templates)
-                (error "New file lacks a version control directory"))))))
+            (setq newmaster
+                  (let ((backend (vc-backend old))
+                        (newdir (or (file-name-directory new) ""))
+                        (newbase (file-name-nondirectory new)))
+                    (catch 'found
+                      (mapcar
+                       (function
+                        (lambda (s)
+                          (if (eq backend (cdr s))
+                              (let* ((newmaster (format (car s) newdir newbase))
+                                     (newmasterdir (file-name-directory newmaster)))
+                                (if (or (not newmasterdir)
+                                        (file-directory-p newmasterdir))
+                                    (throw 'found newmaster))))))
+                       vc-master-templates)
+                      (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
-         (if (stringp vc-register-switches)
-             (list vc-register-switches)
-           vc-register-switches))
-        (backend
-        (cond
-         ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
-         ((file-exists-p "RCS") 'RCS)
-         ((file-exists-p "SCCS") 'SCCS)
-         ((file-exists-p "CVS") 'CVS)
-         (t vc-default-back-end))))
+  (let* ((switches
+          (if (stringp vc-register-switches)
+              (list vc-register-switches)
+            vc-register-switches))
+         (project-dir)
+         (backend
+          (cond
+           ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
+           ((file-exists-p "RCS") 'RCS)
+           ((file-exists-p "CVS") 'CVS)
+           ((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.
-           ;; (SCCS could do without it, but VC requires it to be there.)
-           (if (not (file-exists-p "SCCS")) (make-directory "SCCS"))
-          (apply 'vc-do-command nil 0 "admin" file 'MASTER     ;; SCCS
-                                 (and rev (concat "-r" rev))
-                                 "-fb"
-                                 (concat "-i" file)
-                                 (and comment (concat "-y" comment))
-                                 (format
-                                  (car (rassq 'SCCS vc-master-templates))
-                                  (or (file-name-directory file) "")
-                                  (file-name-nondirectory file))
-                                 switches)
+           (let ((vc-name
+                  (if project-dir (concat project-dir 
+                                          "s." (file-name-nondirectory file))
+                    (format
+                     (car (rassq 'SCCS vc-master-templates))
+                     (or (file-name-directory file) "")
+                     (file-name-nondirectory file)))))
+             (apply 'vc-do-command nil 0 "admin" nil nil       ;; SCCS
+                                   (and rev (concat "-r" rev))
+                                   "-fb"
+                                   (concat "-i" file)
+                                   (and comment (concat "-y" comment))
+                                   vc-name
+                                   switches))
           (delete-file file)
           (if vc-keep-workfiles
               (vc-do-command nil 0 "get" file 'MASTER)))