EXTERNAL_LIST_LOOP (path_entry, path)
{
/* Verify that DESC describes a menu, not single item */
if (!CONSP (desc))
RETURN_UNGCPRO (Qnil);
/* Parse this menu */
desc = menu_parse_submenu_keywords (desc, gui_item);
/* Check that this (sub)menu is active */
if (!gui_item_active_p (gui_item))
RETURN_UNGCPRO (Qnil);
/* Apply :filter */
if (!NILP (pgui_item->filter))
desc = call1 (pgui_item->filter, desc);
/* Find the next menu on the path inside this one */
EXTERNAL_LIST_LOOP (submenu_desc, desc)
{
submenu = XCAR (submenu_desc);
if (CONSP (submenu)
&& STRINGP (XCAR (submenu))
&& !NILP (Fstring_equal (XCAR (submenu), XCAR (path_entry))))
{
desc = submenu;
goto descend;
}
}
static Lisp_Object
gtk_canonicalize_device_connection (Lisp_Object connection, Error_behavior errb)
{
struct gcpro gcpro1;
GCPRO1 (connection);
connection = build_string("gtk");
RETURN_UNGCPRO (connection);
}
static Lisp_Object
build_syscolor_cons (int index1, int index2)
{
Lisp_Object color1, color2;
struct gcpro gcpro1;
GCPRO1 (color1);
color1 = build_syscolor_string (index1);
color2 = build_syscolor_string (index2);
RETURN_UNGCPRO (Fcons (color1, color2));
}
static Lisp_Object
read_file_name (Lisp_Object default_filename, Lisp_Object mustmatch,
Lisp_Object initial, Lisp_Object predicate)
{
struct gcpro gcpro1;
GCPRO1 (default_filename);
RETURN_UNGCPRO (CALLN (Ffuncall, intern ("read-file-name"),
callint_message, Qnil, default_filename,
mustmatch, initial, predicate));
}
static Lisp_Object
gtk_canonicalize_console_connection (Lisp_Object connection, Error_behavior errb)
{
Lisp_Object hostname = Qnil;
struct gcpro gcpro1, gcpro2;
GCPRO2 (connection, hostname);
connection = build_string ("gtk");
RETURN_UNGCPRO (connection);
}
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
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);
}