mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-01-30 04:10:54 -08:00
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.
This commit is contained in:
parent
72c70417d3
commit
b038f9fb95
5 changed files with 35 additions and 8 deletions
|
|
@ -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):
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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',
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue