Re: locate-file in Emacs

[Hrvoje Niksic]

"Stefan Monnier" <monnier+gnu/address@hidden> writes:

>> PREDICATE might make sense, but I don't remember needing it in
>> practice.  Plus, it'd change the interface and hence undermine the
>> whole point of sharing the function.
>
> Well, I was wondering if it was possible to get XEmacs to adopt it
> as well ;-)

That would break backward compatibility, which is fairly important in
this case because I've already changed the interface once.  (But I've
kept the compatibility with the old interface.)

I've fixed the function to always check for non-directoriness, which
the XEmacs version does, too.  Please let me know if you include the
function (which Richard promised to do, but that was some time ago):

(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))
            (when (not (file-directory-p full-name))
              (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)))