locate-file in Emacs

[Hrvoje Niksic]

Several years ago I talked to Richard Stallman about incorporating the
`locate-file' function in Emacs.  `locate-file' is a very useful
XEmacs function that searches for a file in a path.

For example, to find an elisp file in load-path, one would use this:

    (locate-file "simple" load-path '(".elc" ".el"))
      => "/usr/local/lib/xemacs-21.4.6/lisp/simple.elc"

Or, to locate a Unix executable:

    (locate-file "ls" (split-string (getenv "PATH") path-separator)
                 nil 'executable)
      => "/bin/ls"

To make the same code work under Windows:

    (locate-file "links" (split-string (getenv "PATH") path-separator)
                 '("" ".exe") 'executable)
      => "/usr/bin/links"

I find that there are many uses for this kind of lookup across a list
of directories, and I would like to be able to use this function in
portable elisp programs.  The XEmacs version is written in C with
(probably) unclear copyright status, but Richard agreed to include a
Lisp version of the function.  I came back to that yesterday and wrote
one.

The code follows below.  Please let me know what you think.


(defun locate-file (filename path-list &optional suffixes mode)
  "Search for FILENAME through PATH-LIST.

If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching.

If MODE is non-nil, it should be a symbol or a list of symbols representing
requirements.  Allowed symbols are `exists', `executable', `writable', and
`readable'.  If MODE is nil, it defaults to `readable'."
  (let (all-file-names all-mode-functions)
    ;; Create a list of strings of FILENAME+suffix for each of
    ;; SUFFIXES, so we don't have to do it (and cons a new string)
    ;; once for each directory.
    (setq all-file-names
          (if suffixes
              (mapcar (lambda (suffix)
                        (concat filename suffix))
                      suffixes)
            (list filename)))

    ;; Convert MODE into a list of tests all of which need to return t
    ;; for a file to pass.
    (if (null mode)
        (setq all-mode-functions '(file-readable-p))
      (when (symbolp mode)
        (setq mode (list mode)))
      (setq all-mode-functions
            (mapcar
             (lambda (m)
               (cond ((eq m 'exists)
                      'file-exists-p)
                     ((eq m 'executable)
                      'file-executable-p)
                     ((eq m 'writable)
                      ;; file-writable-p returns t if the dir is
                      ;; writable and the file doesn't exist.
                      (lambda (f)
                        (and (file-exists-p f)
                             (file-writable-p f))))
                     ((eq m 'readable)
                      'file-readable-p)
                     (t
                      (error "Invalid mode: %s" m))))
             mode)))

    (catch 'found
      (dolist (directory path-list)
        (dolist (file all-file-names)
          (let ((full-name (expand-file-name file directory))
                (mode-functions all-mode-functions))
            (while (and mode-functions
                        (funcall (car mode-functions) full-name))
              (pop mode-functions))
            (when (null mode-functions)
              ;; All functions passed -- we found the one.
              (throw 'found full-name)))))
      nil)))