(vc-do-command): Change RCS handling so rcsdiff won't strip

away relative-pathname information.  This function no longer sets the
default directory.  Also, mark the *vc* output buffer unmodified.
(vc-revert-buffer1): Handle font-lock mode correctly.
(vc-diff, vc-print-log): vc-do-command no longer sets the default
directory, but doing so	is advantageous for these cases.
(file-executable-p-18):	Better portability to Emacs 18.
(vc-directory-exclusion-list, vc-file-tree-walk-internal):
Implement the new variable vc-directory-exclusion-list to prune
tree walks.  Initial value tells it to ignore SCCS and RCS subdirectories.

1 files changed, 64 insertions, 36 deletions

diff --git a/lisp/vc.el b/lisp/vc.el
index b80f632a413..70ce0d5c842 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -4,7 +4,7 @@
 
 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Maintainer: ttn@netcom.com
-;; Version: 5.5 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
+;; Version: 5.6
 
 ;; This file is part of GNU Emacs.
 
@@ -29,10 +29,15 @@
 ;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
 ;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
 ;; and Richard Stallman contributed valuable criticism, support, and testing.
+;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
+;; in Jan-Feb 1994.
 ;;
-;; Supported version-control systems presently include SCCS and RCS;
-;; the RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
+;; Supported version-control systems presently include SCCS, RCS, and CVS.
+;; The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
 ;; or newer.  Currently (January 1994) that is only a beta test release.
+;; Even initial checkins will fail if your RCS version is so old that ci
+;; doesn't understand -t-; this has been known to happen to people running
+;; NExTSTEP 3.0. 
 ;;
 ;; The RCS code assumes strict locking.  You can support the RCS -x option
 ;; by adding pairs to the vc-master-templates list.
@@ -93,6 +98,8 @@ value of this flag.")
   (if (file-exists-p "/usr/sccs")
       '("/usr/sccs") nil)
   "*List of extra directories to search for version control commands.")
+(defvar vc-directory-exclusion-list '("SCCS" "RCS")
+  "*Directory names ignored by functions that recursively walk file trees.")
 
 (defconst vc-maximum-comment-ring-size 32
   "Maximum number of saved comments in the comment ring.")
@@ -159,6 +166,20 @@ and that its contents match what the master file says.")
 (defvar vc-comment-ring-index nil)
 (defvar vc-last-comment-match nil)
 
+;; Back-portability to Emacs 18
+
+(defun file-executable-p-18 (f)
+  (let ((modes (file-modes f)))
+    (and modes (not (zerop (logand 292))))))
+
+; Conditionally rebind some things for Emacs 18 compatibility
+(if (not (boundp 'minor-mode-map-alist))
+    (progn
+      (setq compilation-old-error-list nil)
+      (fset 'file-executable-p 'file-executable-p-18)
+      (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
+      ))
+  
 ;; File property caching
 
 (defun vc-file-clearprops (file)
@@ -203,9 +224,13 @@ and that its contents match what the master file says.")
   "Execute a version-control command, notifying user and checking for errors.
 The command is successful if its exit status does not exceed OKSTATUS.
 Output from COMMAND goes to buffer *vc*.  The last argument of the command is
-the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is
-'BASE; this is appended to an optional list of FLAGS."
+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."
   (setq file (expand-file-name file))
+  (let* ((pwd (expand-file-name default-directory))
+	 (preflen (length pwd)))
+    (if (string= (substring file 0 preflen) pwd)
+	(setq file (substring file preflen))))
   (if vc-command-messages
       (message "Running %s on %s..." command file))
   (let ((obuf (current-buffer)) (camefrom (current-buffer))
@@ -219,19 +244,14 @@ the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is
     
     (erase-buffer)
 
-    ;; This is so that command arguments typed in the *vc* buffer will
-    ;; have reasonable defaults.
-    (setq default-directory (file-name-directory file))
-
     (mapcar
      (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
      flags)
     (if (and vc-file (eq last 'MASTER))
 	(setq squeezed (append squeezed (list vc-file))))
-    (if (eq last 'BASE)
-	(setq squeezed (append squeezed (list (file-name-nondirectory file)))))
-    (let ((default-directory (file-name-directory (or file "./")))
-	  (exec-path (if vc-path (append exec-path vc-path) exec-path))
+    (if (eq last 'WORKFILE)
+	(setq squeezed (append squeezed (list file))))
+    (let ((exec-path (if vc-path (append exec-path vc-path) exec-path))
 	  ;; Add vc-path to PATH for the execution of this command.
 	  (process-environment
 	   (cons (concat "PATH=" (getenv "PATH")
@@ -239,6 +259,7 @@ the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is
 		 process-environment)))
       (setq status (apply 'call-process command nil t nil squeezed)))
     (goto-char (point-max))
+    (not-modified)
     (forward-line -1)
     (if (or (not (integerp status)) (< okstatus status))
 	(progn
@@ -324,8 +345,16 @@ the master name of FILE if LAST is 'MASTER, or the basename of FILE if LAST is
 				      (if buffer-error-marked-p buffer))))
 				  (buffer-list)))))))
 
-    ;; the actual revisit
-    (revert-buffer arg no-confirm)
+    (let ((in-font-lock-mode (and (boundp 'font-lock-fontified)
+                                font-lock-fontified)))
+      (if in-font-lock-mode
+	  (font-lock-mode 0))
+
+      ;; the actual revisit
+      (revert-buffer arg no-confirm)
+
+      (if in-font-lock-mode
+	  (font-lock-mode 1)))
 
     ;; Reparse affected compilation buffers.
     (while reparse
@@ -893,7 +922,7 @@ and two version designators specifying which versions to compare."
 	;; visited.  This plays hell with numerous assumptions in
 	;; the diff.el and compile.el machinery.
 	(pop-to-buffer "*vc*")
-	(pop-to-buffer "*vc*")
+	(setq default-directory (file-name-directory file))
 	(if (= 0 (buffer-size))
 	    (progn
 	      (setq unchanged t)
@@ -1103,10 +1132,6 @@ scan the entire tree of subdirectories of the current directory."
 	       (if verbose "registered" "locked") default-directory))
     ))
 
-; Emacs 18 also lacks these.
-(or (boundp 'compilation-old-error-list)
-    (setq compilation-old-error-list nil))
-
 ;; Named-configuration support for SCCS
 
 (defun vc-add-triple (name file rev)
@@ -1198,9 +1223,10 @@ levels in the snapshot."
   (while vc-parent-buffer
       (pop-to-buffer vc-parent-buffer))
   (if (and buffer-file-name (vc-name buffer-file-name))
-      (progn
-	(vc-backend-print-log buffer-file-name)
+      (let ((file buffer-file-name))
+	(vc-backend-print-log file)
 	(pop-to-buffer (get-buffer-create "*vc*"))
+	(setq default-directory (file-name-directory file))
 	(while (looking-at "=*\n")
 	  (delete-char (- (match-end 0) (match-beginning 0)))
 	  (forward-line -1))
@@ -1424,7 +1450,7 @@ From a program, any arguments are passed to the `rcs2log' script."
 	  (setq buf (create-file-buffer file))
 	  (set-buffer buf))
 	(erase-buffer)
-	(insert-file-contents file nil)
+	(insert-file-contents file)
 	(set-buffer-modified-p nil)
 	(auto-save-mode nil)
 	(prog1
@@ -1602,7 +1628,7 @@ with RCS)."
    ;; should always be nil anyhow.  Don't fetch vc-your-latest-version, since
    ;; that is done in vc-find-cvs-master.
    (vc-log-info
-    "cvs" file 'BASE '("status")
+    "cvs" file 'WORKFILE '("status")
     ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
     ;; and CVS 1.4a1 says "Repository revision:".  The regexp below
     ;; matches much more, but because of the way vc-log-info is
@@ -1654,7 +1680,7 @@ with RCS)."
 			  (and comment (concat "-t-" comment))
 			  file))
 	  ((eq backend 'CVS)
-	   (vc-do-command 0 "cvs" file 'BASE ;; CVS
+	   (vc-do-command 0 "cvs" file 'WORKFILE ;; CVS
 			  "add"
 			  (and comment (not (string= comment ""))
 			       (concat "-m" comment)))
@@ -1737,7 +1763,7 @@ with RCS)."
 	      (unwind-protect
 		  (progn
 		    (apply 'vc-do-command
-			   0 "/bin/sh" file 'BASE "-c"
+			   0 "/bin/sh" file 'WORKFILE "-c"
 			   "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
 			   ""		; dummy argument for shell's $0
 			   workfile
@@ -1746,7 +1772,7 @@ with RCS)."
 			   vc-checkout-switches)
 		    (setq failed nil))
 		(and failed (file-exists-p filename) (delete-file filename))))
-	  (apply 'vc-do-command 0 "cvs" file 'BASE
+	  (apply 'vc-do-command 0 "cvs" file 'WORKFILE
 		 (and rev (concat "-r" rev))
 		 file
 		 vc-checkout-switches))
@@ -1791,7 +1817,7 @@ with RCS)."
 	     (concat "-m" comment)
 	     vc-checkin-switches)
       (progn
-	(apply 'vc-do-command 0 "cvs" file 'BASE 
+	(apply 'vc-do-command 0 "cvs" file 'WORKFILE 
 	       "ci" "-m" comment
 	       vc-checkin-switches)
 	(vc-file-setprop file 'vc-checkout-time 
@@ -1813,7 +1839,7 @@ with RCS)."
 		  "-f" "-u")
    (progn				  ;; CVS
      (delete-file file)
-     (vc-do-command 0 "cvs" file 'BASE "update"))
+     (vc-do-command 0 "cvs" file 'WORKFILE "update"))
    )
   (vc-file-setprop file 'vc-locking-user nil)
   (message "Reverting %s...done" file)
@@ -1853,14 +1879,14 @@ with RCS)."
    file
    (vc-do-command 0 "prs" file 'MASTER)
    (vc-do-command 0 "rlog" file 'MASTER)
-   (vc-do-command 0 "cvs" file 'BASE "rlog")))
+   (vc-do-command 0 "cvs" file 'WORKFILE "rlog")))
 
 (defun vc-backend-assign-name (file name)
   ;; Assign to a FILE's latest version a given NAME.
   (vc-backend-dispatch file
    (vc-add-triple name file (vc-latest-version file))   	;; SCCS
    (vc-do-command 0 "rcs" file 'MASTER (concat "-n" name ":"))	;; RCS
-   (vc-do-command 0 "cvs" file 'BASE "tag" name)	        ;; CVS
+   (vc-do-command 0 "cvs" file 'WORKFILE "tag" name)	        ;; CVS
    )
   )
 
@@ -1878,6 +1904,7 @@ with RCS)."
       (let* ((command (if (eq backend 'SCCS)
 			  "vcdiff"
 			"rcsdiff"))
+	     (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
 	     (options (append (list (and cmp "--brief")
 				    "-q"
 				    (and oldvers (concat "-r" oldvers))
@@ -1886,10 +1913,10 @@ with RCS)."
 				   (if (listp diff-switches)
 				       diff-switches
 				     (list diff-switches)))))
-	     (status (apply 'vc-do-command 2 command file options)))
+	     (status (apply 'vc-do-command 2 command file mode options)))
 	;; Some RCS versions don't understand "--brief"; work around this.
 	(if (eq status 2)
-	    (apply 'vc-do-command 1 command file 'MASTER
+	    (apply 'vc-do-command 1 command file 'WORKFILE
 		   (if cmp (cdr options) options))
 	  status)))
      ;; CVS is different.  
@@ -1901,12 +1928,12 @@ with RCS)."
 	  (if (or oldvers newvers)
 	      (error "No revisions of %s exists" file)
 	    (apply 'vc-do-command
-		   1 "diff" file 'BASE "/dev/null"
+		   1 "diff" file 'WORKFILE "/dev/null"
 		   (if (listp diff-switches)
 		       diff-switches
 		     (list diff-switches))))
 	(apply 'vc-do-command
-	       1 "cvs" file 'BASE "diff"
+	       1 "cvs" file 'WORKFILE "diff"
 	       (and oldvers (concat "-r" oldvers))
 	       (and newvers (concat "-r" newvers))
 	       (if (listp diff-switches)
@@ -1921,7 +1948,7 @@ with RCS)."
    file
    (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
    (error "vc-backend-merge-news not meaningful for RCS files")	;RCS
-   (vc-do-command 1 "cvs" file 'BASE "update") ;CVS
+   (vc-do-command 1 "cvs" file 'WORKFILE "update") ;CVS
    ))
 
 (defun vc-check-headers ()
@@ -2041,6 +2068,7 @@ Invoke FUNC f ARGS on each non-directory file f underneath it."
 	(lambda (f) (or
 		     (string-equal f ".")
 		     (string-equal f "..")
+		     (member f vc-directory-exclusion-list)
 		     (let ((dirf (concat dir f)))
 			(or
 			 (file-symlink-p dirf) ;; Avoid possible loops