From b038f9fb955989de99795504c8facfac21e5fbd9 Mon Sep 17 00:00:00 2001 From: Thien-Thi Nguyen Date: Tue, 19 Feb 2008 11:45:54 +0000 Subject: [PATCH] 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. --- lisp/ChangeLog | 8 ++++++++ lisp/vc-cvs.el | 3 +++ lisp/vc-hooks.el | 26 ++++++++++++++++++-------- lisp/vc-rcs.el | 3 +++ lisp/vc-svn.el | 3 +++ 5 files changed, 35 insertions(+), 8 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f9b5745709..82f619341b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2008-02-19 Thien-Thi Nguyen + + * 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 * language/japan-util.el (setup-japanese-environment-internal): diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index cc4cd47cfe..717407d2cb 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 5c0d839e24..4f26a2e7e7 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 9ba1226301..0f2551d49a 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 868680375c..92374be84f 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', -- 2.20.1