Mercurial > emacs
changeset 99130:e152a404d947
* files.el (locate-dominating-stop-dir-regexp): New var.
(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.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sat, 25 Oct 2008 15:18:53 +0000 |
| parents | 477b24ba46d7 |
| children | f6f4d415536b |
| files | lisp/files.el lisp/progmodes/flymake.el lisp/vc-hooks.el |
| diffstat | 3 files changed, 89 insertions(+), 63 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/files.el Sat Oct 25 10:09:42 2008 +0000 +++ b/lisp/files.el Sat Oct 25 15:18:53 2008 +0000 @@ -716,33 +716,84 @@ 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 @@ `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))
--- a/lisp/progmodes/flymake.el Sat Oct 25 10:09:42 2008 +0000 +++ b/lisp/progmodes/flymake.el Sat Oct 25 15:18:53 2008 +0000 @@ -340,13 +340,10 @@ 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
--- a/lisp/vc-hooks.el Sat Oct 25 10:09:42 2008 +0000 +++ b/lisp/vc-hooks.el Sat Oct 25 15:18:53 2008 +0000 @@ -52,7 +52,7 @@ (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 @@ "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 @@ 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)))