3 files changed, 89 insertions, 63 deletions

diff --git a/lisp/files.el b/lisp/files.el
index 1fd6265e949..710c2a4f367 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -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))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 7f35e300994..b5856f3e115 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -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
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 7910c068833..97dca35463d 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -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)))