mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* files.el (locate-dominating-stop-dir-regexp): New var.

Browse source 
(locate-dominating-file): Change arg from a regexp to a file name.
Rewrite using the vc-find-root code to avoid directory-files which is
too slow.  Obey locate-dominating-stop-dir-regexp.
Don't pay attention to changes in owner.
(project-find-settings-file): Adjust call to locate-dominating-file.

* progmodes/flymake.el (flymake-find-buildfile):
Adjust call to locate-dominating-file.

* vc-hooks.el (vc-find-root): Use locate-dominating-file.
(vc-ignore-dir-regexp): Use locate-dominating-stop-dir-regexp.
This commit is contained in:
Stefan Monnier 2008-10-25 15:18:53 +00:00
parent 520b29e7aa
commit 8cd56959b4
3 changed files with 89 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

109
lisp/files.el
View file

@ -716,33 +716,84 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
string nil action))
(make-obsolete 'locate-file-completion 'locate-file-completion-table "23.1")
(defun locate-dominating-file (file regexp)
"Look up the directory hierarchy from FILE for a file matching REGEXP."
(catch 'found
;; `user' is not initialized yet because `file' may not exist, so we may
;; have to walk up part of the hierarchy before we find the "initial UID".
(let ((user nil)
;; Abbreviate, so as to stop when we cross ~/.
(dir (abbreviate-file-name (file-name-as-directory file)))
files)
(while (and dir
;; 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.
(let ((prev-user user))
(setq user (nth 2 (file-attributes dir)))
(or (null prev-user) (equal user prev-user))))
(if (setq files (condition-case nil
(directory-files dir 'full regexp)
(error nil)))
(throw 'found (car files))
(if (equal dir
(setq dir (file-name-directory
(directory-file-name dir))))
(setq dir nil))))
nil)))
(defvar locate-dominating-stop-dir-regexp
"\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\\.\\.\\)/\\)\\'"
"Regexp of directory names which stop the search in `locate-dominating-file'.
Any directory whose name matches this regexp will be treated like
a kind of root directory by `locate-dominating-file' which will stop its search
when it bumps into it.
The default regexp prevents fruitless and time-consuming attempts to find
special files in directories in which filenames are interpreted as hostnames.")
;; (defun locate-dominating-files (file regexp)
;; "Look up the directory hierarchy from FILE for a file matching REGEXP.
;; Stop at the first parent where a matching file is found and return the list
;; of files that that match in this directory."
;; (catch 'found
;; ;; `user' is not initialized yet because `file' may not exist, so we may
;; ;; have to walk up part of the hierarchy before we find the "initial UID".
;; (let ((user nil)
;; ;; Abbreviate, so as to stop when we cross ~/.
;; (dir (abbreviate-file-name (file-name-as-directory file)))
;; files)
;; (while (and dir
;; ;; 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.
;; (let ((prev-user user))
;; (setq user (nth 2 (file-attributes dir)))
;; (or (null prev-user) (equal user prev-user))))
;; (if (setq files (condition-case nil
;; (directory-files dir 'full regexp 'nosort)
;; (error nil)))
;; (throw 'found files)
;; (if (equal dir
;; (setq dir (file-name-directory
;; (directory-file-name dir))))
;; (setq dir nil))))
;; nil)))
(defun locate-dominating-file (file name)
"Look up the directory hierarchy from FILE for a file named NAME.
Stop at the first parent directory containing a file NAME return the directory.
Return nil if not found."
;; We used to use the above locate-dominating-files code, but the
;; directory-files call is very costly, so we're much better off doing
;; multiple calls using the code in here.
;;
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /.
(setq file (abbreviate-file-name file))
(let ((root nil)
(prev-file file)
;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the
;; hierarchy before we find the "initial UID".
(user nil)
try)
(while (not (or root
(null file)
;; FIXME: Disabled this heuristic because it is sometimes
;; inappropriate.
;; 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.
;; (let ((prev-user user))
;; (setq user (nth 2 (file-attributes file)))
;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
(setq try (file-exists-p (expand-file-name name file)))
(cond (try (setq root file))
((equal file (setq prev-file file
file (file-name-directory
(directory-file-name file))))
(setq file nil))))
root))
(defun executable-find (command)
"Search for COMMAND in `exec-path' and return the absolute file name.
@ -3159,10 +3210,10 @@ If the file is in a registered project, a cons from
`project-directory-alist' is returned.
Otherwise this returns nil."
(setq file (expand-file-name file))
(let* ((settings (locate-dominating-file file "\\`\\.dir-settings\\.el\\'"))
(let* ((settings (locate-dominating-file file ".dir-settings.el"))
(pda nil))
;; `locate-dominating-file' may have abbreviated the name.
(if settings (setq settings (expand-file-name settings)))
(if settings (setq settings (expand-file-name ".dir-settings.el" settings)))
(dolist (x project-directory-alist)
(when (and (eq t (compare-strings file nil (length (car x))
(car x) nil nil))

5
lisp/progmodes/flymake.el
View file

@ -340,13 +340,10 @@ Return nil if we cannot, non-nil if we can."
Buildfile includes Makefile, build.xml etc.
Return its file name if found, or nil if not found."
(or (flymake-get-buildfile-from-cache source-dir-name)
(let* ((file (locate-dominating-file
source-dir-name
(concat "\\`" (regexp-quote buildfile-name) "\\'"))))
(let* ((file (locate-dominating-file source-dir-name buildfile-name)))
(if file
(progn
(flymake-log 3 "found buildfile at %s" file)
(setq file (file-name-directory file))
(flymake-add-buildfile-to-cache source-dir-name file)
file)
(progn

38
lisp/vc-hooks.el
View file

@ -52,7 +52,7 @@ BACKEND, use `vc-handled-backends'."
(defcustom vc-ignore-dir-regexp
;; Stop SMB, automounter, AFS, and DFS host lookups.
"\\`\\(?:[\\/][\\/]\\|/\\(?:net\\|afs\\|\\.\\\.\\.\\)/\\)\\'"
locate-dominating-stop-dir-regexp
"Regexp matching directory names that are not under VC's control.
The default regexp prevents fruitless and time-consuming attempts
to determine the VC status in directories in which filenames are
@ -331,34 +331,11 @@ non-nil if FILE exists and its contents were successfully inserted."
"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."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; witnesses in /home or in /.
(setq file (abbreviate-file-name file))
(let ((root nil)
(prev-file file)
;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the
;; hierarchy before we find the "initial UID".
(user nil)
try)
(while (not (or root
(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.
(let ((prev-user user))
(setq user (nth 2 (file-attributes file)))
(and prev-user (not (equal user prev-user))))
(string-match vc-ignore-dir-regexp file)))
(setq try (file-exists-p (expand-file-name witness file)))
(cond (try (setq root file))
((equal file (setq prev-file file
file (file-name-directory
(directory-file-name file))))
(setq file nil))))
root))
(let ((locate-dominating-stop-dir-regexp
(or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp)))
(locate-dominating-file file witness)))
(define-obsolete-function-alias 'vc-find-root 'locate-dominating-file "23.1")
;; Access functions to file properties
;; (Properties should be _set_ using vc-file-setprop, but
@ -378,7 +355,8 @@ file was previously registered under a certain backend, then that
backend is tried first."
(let (handler)
(cond
((and (file-name-directory file) (string-match vc-ignore-dir-regexp (file-name-directory file)))
((and (file-name-directory file)
(string-match vc-ignore-dir-regexp (file-name-directory file)))
nil)
((and (boundp 'file-name-handler-alist)
(setq handler (find-file-name-handler file 'vc-registered)))