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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f9b574570951695b0b3028b0b5ee744e275c2fc0..82f619341bd2cca461b7bfcd7f8e4e1aa2640f7f 100644 (file)
--- 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 cc4cd47cfe74b7b6c7fc6d7571a9583ec0e62dd7..717407d2cbd049445226f2f7b07e2f03c3bd1890 100644 (file)
--- 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 5c0d839e24dbcaec9bd5762ebe44681c76ec65e6..4f26a2e7e7921697c50d9eac90ce85d91bbe19e8 100644 (file)
--- 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 9ba1226301f91edcec8c8626b7a68c2c618d8d2a..0f2551d49a3221a48063929aab7ad834e54deb02 100644 (file)
--- 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 868680375cbbb5d10ef8912943c1d5d1e985de9a..92374be84fa773e154ac47a782d6997cfe61e6f4 100644 (file)
--- 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',