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.

5 files changed, 35 insertions, 8 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f9b57457095..82f619341bd 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2008-02-19  Thien-Thi Nguyen  <ttn@gnuvola.org>
+
+        * 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.
+
 2008-02-18  Kenichi Handa  <handa@ni.aist.go.jp>
 
         * language/japan-util.el (setup-japanese-environment-internal):
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index cc4cd47cfe7..717407d2cbd 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -733,6 +733,9 @@ If UPDATE is non-nil, then update (resynch) any affected buffers."
 ;;; 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',
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 5c0d839e24d..4f26a2e7e79 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -325,17 +325,21 @@ non-nil if FILE exists and its contents were successfully inserted."
     (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 @@ If WITNESS if not found, return nil, otherwise return the root."
                     ;; 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
diff --git a/lisp/vc-rcs.el b/lisp/vc-rcs.el
index 9ba1226301f..0f2551d49a3 100644
--- a/lisp/vc-rcs.el
+++ b/lisp/vc-rcs.el
@@ -792,6 +792,9 @@ systime, or nil if there is none.  Also, reposition point."
 ;;; 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
diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el
index 868680375cb..92374be84fa 100644
--- a/lisp/vc-svn.el
+++ b/lisp/vc-svn.el
@@ -532,6 +532,9 @@ NAME is assumed to be a URL."
   :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',