Lisp_Object
encode_current_directory (void)
{
Lisp_Object dir;
dir = BVAR (current_buffer, directory);
dir = Funhandled_file_name_directory (dir);
/* If the file name handler says that dir is unreachable, use
a sensible default. */
if (NILP (dir))
dir = build_string ("~");
dir = expand_and_dir_to_file (dir, Qnil);
if (NILP (Ffile_accessible_directory_p (dir)))
report_file_error ("Setting current directory",
BVAR (current_buffer, directory));
/* Remove "/:" from DIR and encode it. */
dir = ENCODE_FILE (remove_slash_colon (dir));
if (! file_accessible_directory_p (dir))
report_file_error ("Setting current directory",
BVAR (current_buffer, directory));
return dir;
}
static Lisp_Object
conv_filename_to_w32_unicode (Lisp_Object in, int absolute_p)
{
ssize_t converted_len;
Lisp_Object converted;
unsigned flags;
int count = SPECPDL_INDEX ();
chdir_to_default_directory ();
flags = CCP_POSIX_TO_WIN_W;
if (!absolute_p) {
flags |= CCP_RELATIVE;
}
in = ENCODE_FILE (in);
converted_len = cygwin_conv_path (flags, SDATA (in), NULL, 0);
if (converted_len < 2)
error ("cygwin_conv_path: %s", strerror (errno));
converted = make_uninit_string (converted_len - 1);
if (cygwin_conv_path (flags, SDATA (in),
SDATA (converted), converted_len))
error ("cygwin_conv_path: %s", strerror (errno));
return unbind_to (count, converted);
}
void
lock_file (Lisp_Object fn)
{
register Lisp_Object attack, orig_fn, encoded_fn;
register char *lfname, *locker;
lock_info_type lock_info;
struct gcpro gcpro1;
/* Don't do locking while dumping Emacs.
Uncompressing wtmp files uses call-process, which does not work
in an uninitialized Emacs. */
if (! NILP (Vpurify_flag))
return;
orig_fn = fn;
GCPRO1 (fn);
fn = Fexpand_file_name (fn, Qnil);
encoded_fn = ENCODE_FILE (fn);
/* Create the name of the lock-file for file fn */
MAKE_LOCK_NAME (lfname, encoded_fn);
/* See if this file is visited and has changed on disk since it was
visited. */
{
register Lisp_Object subject_buf;
subject_buf = get_truename_buffer (orig_fn);
if (!NILP (subject_buf)
&& NILP (Fverify_visited_file_modtime (subject_buf))
&& !NILP (Ffile_exists_p (fn)))
call1 (intern ("ask-user-about-supersession-threat"), fn);
}
UNGCPRO;
/* Try to lock the lock. */
if (lock_if_free (&lock_info, lfname) <= 0)
/* Return now if we have locked it, or if lock creation failed */
return;
/* Else consider breaking the lock */
locker = (char *) alloca (strlen (lock_info.user) + strlen (lock_info.host)
+ LOCK_PID_MAX + 9);
sprintf (locker, "%s@%s (pid %lu)", lock_info.user, lock_info.host,
lock_info.pid);
FREE_LOCK_INFO (lock_info);
attack = call2 (intern ("ask-user-about-lock"), fn, build_string (locker));
if (!NILP (attack))
/* User says take the lock */
{
lock_file_1 (lfname, 1);
return;
}
/* User says ignore the lock */
}
void
unlock_file (register Lisp_Object fn)
{
register char *lfname;
fn = Fexpand_file_name (fn, Qnil);
fn = ENCODE_FILE (fn);
MAKE_LOCK_NAME (lfname, fn);
if (current_lock_owner (0, lfname) == 2)
unlink (lfname);
}
static void
chdir_to_default_directory (void)
{
Lisp_Object new_cwd;
int old_cwd_fd = emacs_open (".", O_RDONLY | O_DIRECTORY, 0);
if (old_cwd_fd == -1)
error ("could not open current directory: %s", strerror (errno));
record_unwind_protect_int (fchdir_unwind, old_cwd_fd);
new_cwd = Funhandled_file_name_directory (
Fexpand_file_name (build_string ("."), Qnil));
if (!STRINGP (new_cwd))
new_cwd = build_string ("/");
if (chdir (SSDATA (ENCODE_FILE (new_cwd))))
error ("could not chdir: %s", strerror (errno));
}
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
Lisp_Object id_format)
{
DIR *d;
int fd;
ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
bool needsep = 0;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct dirent *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Don't let the compiler optimize away all copies of DIRECTORY,
which would break GC; see Bug#16986. Although this is required
only in the common case where GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS,
it shouldn't break anything in the other cases. */
Lisp_Object volatile directory_volatile = directory;
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
/* MATCH might be a flawed regular expression. Rather than
catching and signaling our own errors, we just call
compile_pattern to do the work for us. */
/* Pass 1 for the MULTIBYTE arg
because we do make multibyte strings if the contents warrant. */
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
BVAR (&buffer_defaults, case_canon_table), 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */
}
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
if (STRING_MULTIBYTE (dirfilename))
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = (STRING_MULTIBYTE (directory)
? ENCODE_FILE (directory) : directory);
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
d = open_directory (SSDATA (dirfilename), &fd);
if (d == NULL)
report_file_error ("Opening directory", directory);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
{
extern int is_slow_fs (const char *);
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Loop reading blocks until EOF or error. */
for (;;)
{
ptrdiff_t len;
bool wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
errno = 0;
dp = readdir (d);
if (!dp)
{
if (errno == EAGAIN || errno == EINTR)
{
QUIT;
continue;
}
break;
}
len = dirent_namelen (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
immediate_quit = 1;
QUIT;
if (NILP (match)
|| re_search (bufp, SSDATA (name), len, 0, len, 0) >= 0)
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
ptrdiff_t nbytes = len + directory_nbytes + needsep;
ptrdiff_t nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
emacs_abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
Lisp_Object fileattrs
= file_attributes (fd, dp->d_name, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
block_input ();
closedir (d);
unblock_input ();
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
RETURN_UNGCPRO (list);
}
Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
char *from, *to, *name, *p, *p1;
int fd;
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
ptrdiff_t count;
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
pos = filepos;
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
pos = XCDR (filepos);
}
else
return Qnil;
position = eabs (XINT (pos));
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
Lisp_Object docdir
= NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
lispstpcpy (lispstpcpy (name, docdir), file);
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
lispstpcpy (stpcpy (name, sibling_etc), file);
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
{
if (errno == EMFILE || errno == ENFILE)
report_file_error ("Read error on documentation file", file);
SAFE_FREE ();
AUTO_STRING (cannot_open, "Cannot open doc string file \"");
AUTO_STRING (quote_nl, "\"\n");
return concat3 (cannot_open, file, quote_nl);
}
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left <= 0)
{
ptrdiff_t in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer
= xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
16 * 1024, -1, 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
unbind_to (count, Qnil);
SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
/* A dynamic docstring should be either at the very beginning of a "#@
comment" or right after a dynamic docstring delimiter (in case we
pack several such docstrings within the same comment). */
if (get_doc_string_buffer[offset - test] != '\037')
{
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
ptrdiff_t nchars
= multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
Lisp_Object
get_doc_string (Lisp_Object filepos, int unibyte, int definition)
{
char *from, *to;
register int fd;
register char *name;
register char *p, *p1;
EMACS_INT minsize;
EMACS_INT offset, position;
Lisp_Object file, tem;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
position = XINT (filepos);
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
position = XINT (XCDR (filepos));
}
else
return Qnil;
if (position < 0)
position = - position;
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
if (NILP (tem))
{
Lisp_Object docdir = ENCODE_FILE (Vdoc_directory);
minsize = SCHARS (docdir);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
name = (char *) alloca (minsize + SCHARS (file) + 8);
strcpy (name, SSDATA (docdir));
strcat (name, SSDATA (file));
}
else
{
name = SSDATA (file);
}
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
strcat (name, SSDATA (file));
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
error ("Cannot open doc string file \"%s\"", name);
}
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left <= 0)
{
ptrdiff_t in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer =
xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
16 * 1024, -1, 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
{
emacs_close (fd);
error ("Read error on documentation file");
}
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
emacs_close (fd);
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
EMACS_INT nchars =
multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object match, Lisp_Object nosort, int attrs, Lisp_Object id_format)
{
DIR *d;
int directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
struct re_pattern_buffer *bufp = NULL;
int needsep = 0;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
DIRENTRY *dp;
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
GCPRO5 (match, directory, list, dirfilename, encoded_directory);
dirfilename = Fdirectory_file_name (directory);
if (!NILP (match))
{
CHECK_STRING (match);
/* MATCH might be a flawed regular expression. Rather than
catching and signaling our own errors, we just call
compile_pattern to do the work for us. */
/* Pass 1 for the MULTIBYTE arg
because we do make multibyte strings if the contents warrant. */
# ifdef WINDOWSNT
/* Windows users want case-insensitive wildcards. */
bufp = compile_pattern (match, 0,
buffer_defaults.case_canon_table, 0, 1);
# else /* !WINDOWSNT */
bufp = compile_pattern (match, 0, Qnil, 0, 1);
# endif /* !WINDOWSNT */
}
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
if (STRING_MULTIBYTE (dirfilename))
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = (STRING_MULTIBYTE (directory)
? ENCODE_FILE (directory) : directory);
/* Now *bufp is the compiled form of MATCH; don't call anything
which might compile a new regexp until we're done with the loop! */
BLOCK_INPUT;
d = opendir (SDATA (dirfilename));
UNBLOCK_INPUT;
if (d == NULL)
report_file_error ("Opening directory", Fcons (directory, Qnil));
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect (directory_files_internal_unwind,
make_save_value (d, 0));
#ifdef WINDOWSNT
if (attrs)
{
extern int is_slow_fs (const char *);
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call Ffile_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Loop reading blocks until EOF or error. */
for (;;)
{
errno = 0;
dp = readdir (d);
if (dp == NULL && (0
#ifdef EAGAIN
|| errno == EAGAIN
#endif
#ifdef EINTR
|| errno == EINTR
#endif
))
{ QUIT; continue; }
if (dp == NULL)
break;
if (DIRENTRY_NONEMPTY (dp))
{
int len;
int wanted = 0;
Lisp_Object name, finalname;
struct gcpro gcpro1, gcpro2;
len = NAMLEN (dp);
name = finalname = make_unibyte_string (dp->d_name, len);
GCPRO2 (finalname, name);
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
immediate_quit = 1;
QUIT;
if (NILP (match)
|| (0 <= re_search (bufp, SDATA (name), len, 0, len, 0)))
wanted = 1;
immediate_quit = 0;
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
int nbytes = len + directory_nbytes + needsep;
int nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
/* Construct an expanded filename for the directory entry.
Use the decoded names for input to Ffile_attributes. */
Lisp_Object decoded_fullname, fileattrs;
struct gcpro gcpro1, gcpro2;
decoded_fullname = fileattrs = Qnil;
GCPRO2 (decoded_fullname, fileattrs);
/* Both Fexpand_file_name and Ffile_attributes can GC. */
decoded_fullname = Fexpand_file_name (name, directory);
fileattrs = Ffile_attributes (decoded_fullname, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
UNGCPRO;
}
else
list = Fcons (finalname, list);
}
UNGCPRO;
}
}
BLOCK_INPUT;
closedir (d);
UNBLOCK_INPUT;
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
RETURN_UNGCPRO (list);
}
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
Lisp_Object match, Lisp_Object nosort, bool attrs,
Lisp_Object id_format)
{
ptrdiff_t directory_nbytes;
Lisp_Object list, dirfilename, encoded_directory;
bool needsep = 0;
ptrdiff_t count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
Lisp_Object w32_save = Qnil;
#endif
/* Don't let the compiler optimize away all copies of DIRECTORY,
which would break GC; see Bug#16986. */
Lisp_Object volatile directory_volatile = directory;
/* Because of file name handlers, these functions might call
Ffuncall, and cause a GC. */
list = encoded_directory = dirfilename = Qnil;
dirfilename = Fdirectory_file_name (directory);
/* Note: ENCODE_FILE and DECODE_FILE can GC because they can run
run_pre_post_conversion_on_str which calls Lisp directly and
indirectly. */
dirfilename = ENCODE_FILE (dirfilename);
encoded_directory = ENCODE_FILE (directory);
int fd;
DIR *d = open_directory (dirfilename, &fd);
/* Unfortunately, we can now invoke expand-file-name and
file-attributes on filenames, both of which can throw, so we must
do a proper unwind-protect. */
record_unwind_protect_ptr (directory_files_internal_unwind, d);
#ifdef WINDOWSNT
if (attrs)
{
/* Do this only once to avoid doing it (in w32.c:stat) for each
file in the directory, when we call file_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
if (EQ (Vw32_get_true_file_attributes, Qlocal))
{
/* w32.c:stat will notice these bindings and avoid calling
GetDriveType for each file. */
if (is_slow_fs (SSDATA (dirfilename)))
Vw32_get_true_file_attributes = Qnil;
else
Vw32_get_true_file_attributes = Qt;
}
}
#endif
directory_nbytes = SBYTES (directory);
re_match_object = Qt;
/* Decide whether we need to add a directory separator. */
if (directory_nbytes == 0
|| !IS_ANY_SEP (SREF (directory, directory_nbytes - 1)))
needsep = 1;
/* Windows users want case-insensitive wildcards. */
Lisp_Object case_table =
#ifdef WINDOWSNT
BVAR (&buffer_defaults, case_canon_table)
#else
Qnil
#endif
;
if (!NILP (match))
CHECK_STRING (match);
/* Loop reading directory entries. */
for (struct dirent *dp; (dp = read_dirent (d, directory)); )
{
ptrdiff_t len = dirent_namelen (dp);
Lisp_Object name = make_unibyte_string (dp->d_name, len);
Lisp_Object finalname = name;
/* Note: DECODE_FILE can GC; it should protect its argument,
though. */
name = DECODE_FILE (name);
len = SBYTES (name);
/* Now that we have unwind_protect in place, we might as well
allow matching to be interrupted. */
maybe_quit ();
bool wanted = (NILP (match) ||
fast_string_match_internal (
match, name, case_table) >= 0);
if (wanted)
{
if (!NILP (full))
{
Lisp_Object fullname;
ptrdiff_t nbytes = len + directory_nbytes + needsep;
ptrdiff_t nchars;
fullname = make_uninit_multibyte_string (nbytes, nbytes);
memcpy (SDATA (fullname), SDATA (directory),
directory_nbytes);
if (needsep)
SSET (fullname, directory_nbytes, DIRECTORY_SEP);
memcpy (SDATA (fullname) + directory_nbytes + needsep,
SDATA (name), len);
nchars = multibyte_chars_in_text (SDATA (fullname), nbytes);
/* Some bug somewhere. */
if (nchars > nbytes)
emacs_abort ();
STRING_SET_CHARS (fullname, nchars);
if (nchars == nbytes)
STRING_SET_UNIBYTE (fullname);
finalname = fullname;
}
else
finalname = name;
if (attrs)
{
Lisp_Object fileattrs
= file_attributes (fd, dp->d_name, directory, name, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
}
else
list = Fcons (finalname, list);
}
}
closedir (d);
#ifdef WINDOWSNT
if (attrs)
Vw32_get_true_file_attributes = w32_save;
#endif
/* Discard the unwind protect. */
specpdl_ptr = specpdl + count;
if (NILP (nosort))
list = Fsort (Fnreverse (list),
attrs ? Qfile_attributes_lessp : Qstring_lessp);
(void) directory_volatile;
return list;
}
