diff options
| author | Stefan Monnier | 2008-02-16 21:39:31 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2008-02-16 21:39:31 +0000 |
| commit | 5ffc4c051fbd91cd53430b560c6fd914c8b676a0 (patch) | |
| tree | 2dfb650b3fa39e8b46c1e868e34c417a4f25a4bb | |
| parent | 6c7b01b61e42336eb57a722eb51ed04ce1a87376 (diff) | |
| download | emacs-5ffc4c051fbd91cd53430b560c6fd914c8b676a0.tar.gz emacs-5ffc4c051fbd91cd53430b560c6fd914c8b676a0.zip | |
(locate-dominating-file): Remove initial loop because it's
not careful enough. Detect the uid-change all within the main loop.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/files.el | 20 |
2 files changed, 17 insertions, 8 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5d565c9015e..08664b7b346 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2008-02-16 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * files.el (locate-dominating-file): Remove initial loop because it's | ||
| 4 | not careful enough. Detect the uid-change all within the main loop. | ||
| 5 | |||
| 1 | 2008-02-16 Lawrence Mitchell <wence@gmx.li> (tiny change) | 6 | 2008-02-16 Lawrence Mitchell <wence@gmx.li> (tiny change) |
| 2 | 7 | ||
| 3 | * ielm.el (ielm-is-whitespace-or-comment): Docstring fix. | 8 | * ielm.el (ielm-is-whitespace-or-comment): Docstring fix. |
diff --git a/lisp/files.el b/lisp/files.el index ffa8e0a328f..82f190a013f 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -727,18 +727,22 @@ PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)." | |||
| 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 |