changeset 91956:7bc22dad5f9a

Make sure all backends support vc-BACKEND-root. * vc-hooks.el (vc-find-root): Take optional arg INVERT. If non-nil, reverse the sense of the check. * vc-rcs.el (vc-rcs-root): New func. * vc-cvs.el (vc-cvs-root): New func. * vc-svn.el (vc-svn-root): New func.

--- a/lisp/vc-cvs.el	Tue Feb 19 11:25:30 2008 +0000
+++ b/lisp/vc-cvs.el	Tue Feb 19 11:43:17 2008 +0000
@@ -733,6 +733,9 @@
 ;;; Internal functions
 ;;;
 
+(defun vc-cvs-root (dir)
+  (vc-find-root dir "CVS" t))
+
 (defun vc-cvs-command (buffer okstatus files &rest flags)
   "A wrapper around `vc-do-command' for use in vc-cvs.el.
 The difference to vc-do-command is that this function always invokes `cvs',

--- a/lisp/vc-hooks.el	Tue Feb 19 11:25:30 2008 +0000
+++ b/lisp/vc-hooks.el	Tue Feb 19 11:43:17 2008 +0000
@@ -325,17 +325,21 @@
     (set-buffer-modified-p nil)
     t))
 
-(defun vc-find-root (file witness)
+(defun vc-find-root (file witness &optional invert)
   "Find the root of a checked out project.
 The function walks up the directory tree from FILE looking for WITNESS.
-If WITNESS if not found, return nil, otherwise return the root."
+If WITNESS if not found, return nil, otherwise return the root.
+Optional arg INVERT non-nil reverses the sense of the check;
+the root is the last directory for which WITNESS *is* found."
   ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
   ;; witnesses in /home or in /.
   (while (not (file-directory-p file))
     (setq file (file-name-directory (directory-file-name file))))
   (setq file (abbreviate-file-name file))
   (let ((root nil)
-        (user (nth 2 (file-attributes file))))
+        (prev-file file)
+        (user (nth 2 (file-attributes file)))
+        try)
     (while (not (or root
                     (null file)
                     ;; As a heuristic, we stop looking up the hierarchy of
@@ -345,11 +349,17 @@
                     ;; files inside a project belong to the same user.
                     (not (equal user (nth 2 (file-attributes file))))
                     (string-match vc-ignore-dir-regexp file)))
-      (if (file-exists-p (expand-file-name witness file))
-          (setq root file)
-        (if (equal file
-                   (setq file (file-name-directory (directory-file-name file))))
-            (setq file nil))))
+      (setq try (file-exists-p (expand-file-name witness file)))
+      (cond ((and invert (not try)) (setq root prev-file))
+            ((and (not invert) try) (setq root file))
+            ((equal file (setq prev-file file
+                               file (file-name-directory
+                                     (directory-file-name file))))
+             (setq file nil))))
+    ;; Handle the case where ~/WITNESS exists and the original FILE is "~".
+    ;; (This occurs, for example, when placing dotfiles under RCS.)
+    (when (and (not root) invert prev-file)
+      (setq root prev-file))
     root))
 
 ;; Access functions to file properties

--- a/lisp/vc-rcs.el	Tue Feb 19 11:25:30 2008 +0000
+++ b/lisp/vc-rcs.el	Tue Feb 19 11:43:17 2008 +0000
@@ -792,6 +792,9 @@
 ;;; Internal functions
 ;;;
 
+(defun vc-rcs-root (dir)
+  (vc-find-root dir "RCS" t))
+
 (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

--- a/lisp/vc-svn.el	Tue Feb 19 11:25:30 2008 +0000
+++ b/lisp/vc-svn.el	Tue Feb 19 11:43:17 2008 +0000
@@ -532,6 +532,9 @@
   :type 'string
   :group 'vc)
 
+(defun vc-svn-root (dir)
+  (vc-find-root dir vc-svn-admin-directory t))
+
 (defun vc-svn-command (buffer okstatus file-or-list &rest flags)
   "A wrapper around `vc-do-command' for use in vc-svn.el.
 The difference to vc-do-command is that this function always invokes `svn',