Mercurial > emacs
comparison lisp/files.el @ 91882:c694afffaf41
(locate-dominating-file): Remove initial loop because it's
not careful enough. Detect the uid-change all within the main loop.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Sat, 16 Feb 2008 21:39:31 +0000 |
| parents | 178e852f7ddf |
| children | c54733a34155 |
comparison
equal
deleted
inserted
replaced
| 91881:6067cc57ab47 | 91882:c694afffaf41 |
|---|---|
| 725 ((null action) (try-completion string names)) | 725 ((null action) (try-completion string names)) |
| 726 (t (test-completion string names)))))) | 726 (t (test-completion string names)))))) |
| 727 | 727 |
| 728 (defun locate-dominating-file (file regexp) | 728 (defun locate-dominating-file (file regexp) |
| 729 "Look up the directory hierarchy from FILE for a file matching REGEXP." | 729 "Look up the directory hierarchy from FILE for a file matching REGEXP." |
| 730 (while (and file (not (file-directory-p file))) | |
| 731 (setq file (file-name-directory (directory-file-name file)))) | |
| 732 (catch 'found | 730 (catch 'found |
| 733 (let ((user (nth 2 (file-attributes file))) | 731 ;; `user' is not initialized yet because `file' may not exist, so we may |
| 732 ;; have to walk up part of the hierarchy before we find the "initial UID". | |
| 733 (let ((user nil) | |
| 734 ;; Abbreviate, so as to stop when we cross ~/. | 734 ;; Abbreviate, so as to stop when we cross ~/. |
| 735 (dir (abbreviate-file-name (file-name-as-directory file))) | 735 (dir (abbreviate-file-name (file-name-as-directory file))) |
| 736 files) | 736 files) |
| 737 ;; As a heuristic, we stop looking up the hierarchy of directories as | 737 (while (and dir |
| 738 ;; soon as we find a directory belonging to another user. This should | 738 ;; As a heuristic, we stop looking up the hierarchy of |
| 739 ;; save us from looking in things like /net and /afs. This assumes | 739 ;; directories as soon as we find a directory belonging to |
| 740 ;; that all the files inside a project belong to the same user. | 740 ;; another user. This should save us from looking in |
| 741 (while (and dir (equal user (nth 2 (file-attributes dir)))) | 741 ;; things like /net and /afs. This assumes that all the |
| 742 ;; files inside a project belong to the same user. | |
| 743 (let ((prev-user user)) | |
| 744 (setq user (nth 2 (file-attributes file))) | |
| 745 (not (or (null prev-user) (equal user prev-user))))) | |
| 742 (if (setq files (directory-files dir 'full regexp)) | 746 (if (setq files (directory-files dir 'full regexp)) |
| 743 (throw 'found (car files)) | 747 (throw 'found (car files)) |
| 744 (if (equal dir | 748 (if (equal dir |
| 745 (setq dir (file-name-directory | 749 (setq dir (file-name-directory |
| 746 (directory-file-name dir)))) | 750 (directory-file-name dir)))) |