Commit 4127ed49 authored by Stefan Monnier's avatar Stefan Monnier

(vc-find-root): Walk up the tree to find an existing

`file' from which to start the search and fix case where `file' is the
current directory and the root as well.
parent 7d56ddc5
2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-hooks.el (vc-find-root): Walk up the tree to find an existing
`file' from which to start the search and fix case where `file' is the
current directory and the root as well.
* pcvs.el (cvs-mode-add-change-log-entry-other-window): Use a directory
name for buffer-file-name if it refers to a directory.
......@@ -314,22 +314,25 @@ The function walks up the directory tree from FILE looking for WITNESS.
If WITNESS if not found, return nil, otherwise return the root."
;; 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))))
(while (not (or root
(equal file (setq file (file-name-directory file)))
(null file)
;; As a heuristic, we stop looking up the hierarchy of
;; directories as soon as we find a directory belonging
;; to another user. This should save us from looking in
;; things like /net and /afs. This assumes that all the
;; files inside a project belong to the same user.
(not (equal user (nth 2 (file-attributes file))))
(string-match vc-ignore-dir-regexp file)))
(null file)
;; As a heuristic, we stop looking up the hierarchy of
;; directories as soon as we find a directory belonging
;; to another user. This should save us from looking in
;; things like /net and /afs. This assumes that all the
;; 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)
(setq file (directory-file-name file))))
(setq root file)
(if (equal file
(setq file (file-name-directory (directory-file-name file))))
(setq file nil))))
root))
;; Access functions to file properties
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment