Commit 86d00812 authored by Stefan Monnier's avatar Stefan Monnier

(openp): Change arg exec_only to predicate.

(build_load_history): Use XCAR/XCDR.
(Flocate_file_internal): New fun.
(syms_of_lread): Defsubr it.
(Fload): Update call to openp.
parent cae578a8
...@@ -694,7 +694,7 @@ Return t if file exists. */) ...@@ -694,7 +694,7 @@ Return t if file exists. */)
: Fappend (2, (tmp[0] = Vload_suffixes, : Fappend (2, (tmp[0] = Vload_suffixes,
tmp[1] = default_suffixes, tmp[1] = default_suffixes,
tmp))), tmp))),
&found, 0); &found, Qnil);
UNGCPRO; UNGCPRO;
} }
...@@ -942,6 +942,24 @@ complete_filename_p (pathname) ...@@ -942,6 +942,24 @@ complete_filename_p (pathname)
); );
} }
DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
doc: /* Search for FILENAME through PATH.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching.
If non-nil, PREDICATE is used instead of `file-readable-p'.
PREDICATE can also be an integer to pass to the access(2) function,
in which case file-name-handlers are ignored. */)
(filename, path, suffixes, predicate)
Lisp_Object filename, path, suffixes, predicate;
{
Lisp_Object file;
int fd = openp (path, filename, suffixes, &file, predicate);
if (NILP (predicate) && fd > 0)
close (fd);
return file;
}
/* Search for a file whose name is STR, looking in directories /* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX. in the Lisp list PATH, and trying suffixes from SUFFIX.
On success, returns a file descriptor. On failure, returns -1. On success, returns a file descriptor. On failure, returns -1.
...@@ -949,24 +967,25 @@ complete_filename_p (pathname) ...@@ -949,24 +967,25 @@ complete_filename_p (pathname)
SUFFIXES is a list of strings containing possible suffixes. SUFFIXES is a list of strings containing possible suffixes.
The empty suffix is automatically added iff the list is empty. The empty suffix is automatically added iff the list is empty.
EXEC_ONLY nonzero means don't open the files, PREDICATE non-nil means don't open the files,
just look for one that is executable. In this case, just look for one that satisfies the predicate. In this case,
returns 1 on success. returns 1 on success. The predicate can be a lisp function or
an integer to pass to `access' (in which case file-name-handlers
are ignored).
If STOREPTR is nonzero, it points to a slot where the name of If STOREPTR is nonzero, it points to a slot where the name of
the file actually found should be stored as a Lisp string. the file actually found should be stored as a Lisp string.
nil is stored there on failure. nil is stored there on failure.
If the file we find is remote, return -2 If the file we find is remote, return -2
but store the found remote file name in *STOREPTR. but store the found remote file name in *STOREPTR. */
We do not check for remote files if EXEC_ONLY is nonzero. */
int int
openp (path, str, suffixes, storeptr, exec_only) openp (path, str, suffixes, storeptr, predicate)
Lisp_Object path, str; Lisp_Object path, str;
Lisp_Object suffixes; Lisp_Object suffixes;
Lisp_Object *storeptr; Lisp_Object *storeptr;
int exec_only; Lisp_Object predicate;
{ {
register int fd; register int fd;
int fn_size = 100; int fn_size = 100;
...@@ -1054,9 +1073,12 @@ openp (path, str, suffixes, storeptr, exec_only) ...@@ -1054,9 +1073,12 @@ openp (path, str, suffixes, storeptr, exec_only)
(load "/bar.el") where the file is actually "/bar.el.gz". */ (load "/bar.el") where the file is actually "/bar.el.gz". */
handler = Ffind_file_name_handler (filename, Qfile_exists_p); handler = Ffind_file_name_handler (filename, Qfile_exists_p);
string = build_string (fn); string = build_string (fn);
if (!NILP (handler) && !exec_only) if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{ {
exists = !NILP (Ffile_readable_p (string)); if (NILP (predicate))
exists = !NILP (Ffile_readable_p (string));
else
exists = !NILP (call1 (predicate, string));
if (exists && !NILP (Ffile_directory_p (string))) if (exists && !NILP (Ffile_directory_p (string)))
exists = 0; exists = 0;
...@@ -1080,8 +1102,8 @@ openp (path, str, suffixes, storeptr, exec_only) ...@@ -1080,8 +1102,8 @@ openp (path, str, suffixes, storeptr, exec_only)
if (exists) if (exists)
{ {
/* Check that we can access or open it. */ /* Check that we can access or open it. */
if (exec_only) if (NATNUMP (predicate))
fd = (access (pfn, X_OK) == 0) ? 1 : -1; fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
else else
fd = emacs_open (pfn, O_RDONLY, 0); fd = emacs_open (pfn, O_RDONLY, 0);
...@@ -1123,9 +1145,9 @@ build_load_history (stream, source) ...@@ -1123,9 +1145,9 @@ build_load_history (stream, source)
tail = Vload_history; tail = Vload_history;
prev = Qnil; prev = Qnil;
foundit = 0; foundit = 0;
while (!NILP (tail)) while (CONSP (tail))
{ {
tem = Fcar (tail); tem = XCAR (tail);
/* Find the feature's previous assoc list... */ /* Find the feature's previous assoc list... */
if (!NILP (Fequal (source, Fcar (tem)))) if (!NILP (Fequal (source, Fcar (tem))))
...@@ -1134,11 +1156,11 @@ build_load_history (stream, source) ...@@ -1134,11 +1156,11 @@ build_load_history (stream, source)
/* If we're loading, remove it. */ /* If we're loading, remove it. */
if (loading) if (loading)
{ {
if (NILP (prev)) if (NILP (prev))
Vload_history = Fcdr (tail); Vload_history = XCDR (tail);
else else
Fsetcdr (prev, Fcdr (tail)); Fsetcdr (prev, XCDR (tail));
} }
/* Otherwise, cons on new symbols that are not already members. */ /* Otherwise, cons on new symbols that are not already members. */
...@@ -1148,20 +1170,20 @@ build_load_history (stream, source) ...@@ -1148,20 +1170,20 @@ build_load_history (stream, source)
while (CONSP (tem2)) while (CONSP (tem2))
{ {
newelt = Fcar (tem2); newelt = XCAR (tem2);
if (NILP (Fmemq (newelt, tem))) if (NILP (Fmemq (newelt, tem)))
Fsetcar (tail, Fcons (Fcar (tem), Fsetcar (tail, Fcons (XCAR (tem),
Fcons (newelt, Fcdr (tem)))); Fcons (newelt, XCDR (tem))));
tem2 = Fcdr (tem2); tem2 = XCDR (tem2);
QUIT; QUIT;
} }
} }
} }
else else
prev = tail; prev = tail;
tail = Fcdr (tail); tail = XCDR (tail);
QUIT; QUIT;
} }
...@@ -3594,6 +3616,7 @@ syms_of_lread () ...@@ -3594,6 +3616,7 @@ syms_of_lread ()
defsubr (&Sread_event); defsubr (&Sread_event);
defsubr (&Sget_file_char); defsubr (&Sget_file_char);
defsubr (&Smapatoms); defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
DEFVAR_LISP ("obarray", &Vobarray, DEFVAR_LISP ("obarray", &Vobarray,
doc: /* Symbol table for use by `intern' and `read'. doc: /* Symbol table for use by `intern' and `read'.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment