static void
instantiate_widget_instance (widget_instance *instance)
{
widget_creation_function function = NULL;
#if defined (USE_LUCID)
if (!function)
function = find_in_table (instance->info->type, xlw_creation_table);
#endif
#if defined(USE_MOTIF)
if (!function)
function = find_in_table (instance->info->type, xm_creation_table);
#endif
#if defined (USE_XAW)
if (!function)
function = find_in_table (instance->info->type, xaw_creation_table);
#endif
if (!function)
{
if (dialog_spec_p (instance->info->type))
{
#if defined (USE_LUCID)
/* not yet */
#endif
#if defined(USE_MOTIF)
if (!function)
function = xm_create_dialog;
#endif
#if defined (USE_XAW)
if (!function)
function = xaw_create_dialog;
#endif
}
}
if (!function)
{
printf ("No creation function for widget type %s\n",
instance->info->type);
emacs_abort ();
}
instance->widget = (*function) (instance);
if (!instance->widget)
emacs_abort ();
/* XtRealizeWidget (instance->widget);*/
}
/* Add a new watch to watch-descriptor WD watching FILENAME and using
IMASK and CALLBACK. Return a cons (DESCRIPTOR . ID) uniquely
identifying the new watch. */
static Lisp_Object
add_watch (int wd, Lisp_Object filename,
uint32_t imask, Lisp_Object callback)
{
Lisp_Object descriptor = INTEGER_TO_CONS (wd);
Lisp_Object tail = assoc_no_quit (descriptor, watch_list);
Lisp_Object watch, watch_id;
Lisp_Object mask = INTEGER_TO_CONS (imask);
EMACS_INT id = 0;
if (NILP (tail))
{
tail = list1 (descriptor);
watch_list = Fcons (tail, watch_list);
}
else
{
/* Assign a watch ID that is not already in use, by looking
for a gap in the existing sorted list. */
for (; ! NILP (XCDR (tail)); tail = XCDR (tail), id++)
if (!EQ (XCAR (XCAR (XCDR (tail))), make_number (id)))
break;
if (MOST_POSITIVE_FIXNUM < id)
emacs_abort ();
}
/* Insert the newly-assigned ID into the previously-discovered gap,
which is possibly at the end of the list. Inserting it there
keeps the list sorted. */
watch_id = make_number (id);
watch = list4 (watch_id, filename, callback, mask);
XSETCDR (tail, Fcons (watch, XCDR (tail)));
return Fcons (descriptor, watch_id);
}
static void
set_frame_size (EmacsFrame ew)
{
/* The widget hierarchy is
argv[0] emacsShell pane Frame-NAME
ApplicationShell EmacsShell Paned EmacsFrame
We accept geometry specs in this order:
*Frame-NAME.geometry
*EmacsFrame.geometry
Emacs.geometry
Other possibilities for widget hierarchies might be
argv[0] frame pane Frame-NAME
ApplicationShell EmacsShell Paned EmacsFrame
or
argv[0] Frame-NAME pane Frame-NAME
ApplicationShell EmacsShell Paned EmacsFrame
or
argv[0] Frame-NAME pane emacsTextPane
ApplicationShell EmacsFrame Paned EmacsTextPane
With the current setup, the text-display-area is the part which is
an emacs "frame", since that's the only part managed by emacs proper
(the menubar and the parent of the menubar and all that sort of thing
are managed by lwlib.)
The EmacsShell widget is simply a replacement for the Shell widget
which is able to deal with using an externally-supplied window instead
of always creating its own. It is not actually emacs specific, and
should possibly have class "Shell" instead of "EmacsShell" to simplify
the resources.
*/
/* Hairily merged geometry */
struct frame *f = ew->emacs_frame.frame;
int w = FRAME_COLS (f);
int h = FRAME_LINES (f);
Widget wmshell = get_wm_shell ((Widget) ew);
Dimension pixel_width, pixel_height;
/* Each Emacs shell is now independent and top-level. */
if (! XtIsSubclass (wmshell, shellWidgetClass)) emacs_abort ();
char_to_pixel_size (ew, w, h, &pixel_width, &pixel_height);
ew->core.width = (frame_resize_pixelwise
? FRAME_PIXEL_WIDTH (f)
: pixel_width);
ew->core.height = (frame_resize_pixelwise
? FRAME_PIXEL_HEIGHT (f)
: pixel_height);
frame_size_history_add
(f, Qset_frame_size, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f),
list2 (make_number (ew->core.width), make_number (ew->core.height)));
}
static void
mark_shell_size_user_specified (Widget wmshell)
{
if (! XtIsWMShell (wmshell)) emacs_abort ();
/* This is kind of sleazy, but I can't see how else to tell it to make it
mark the WM_SIZE_HINTS size as user specified when appropriate. */
((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;
}
char *
tparam (const char *string, char *outstring, int len,
int arg1, int arg2, int arg3, int arg4)
{
char *temp;
/* Emacs always should pass a null OUTSTRING and zero LEN. */
if (outstring || len)
emacs_abort ();
temp = tparm (string, arg1, arg2, arg3, arg4);
return xstrdup (temp);
}
static void
alsa_choose_format (struct sound_device *sd, struct sound *s)
{
if (s->type == RIFF)
{
struct wav_header *h = (struct wav_header *) s->header;
if (h->precision == 8)
sd->format = SND_PCM_FORMAT_U8;
else if (h->precision == 16)
sd->format = SND_PCM_FORMAT_S16_LE;
else
error ("Unsupported WAV file format");
}
else if (s->type == SUN_AUDIO)
{
struct au_header *header = (struct au_header *) s->header;
switch (header->encoding)
{
case AU_ENCODING_ULAW_8:
sd->format = SND_PCM_FORMAT_MU_LAW;
break;
case AU_ENCODING_ALAW_8:
sd->format = SND_PCM_FORMAT_A_LAW;
break;
case AU_ENCODING_IEEE32:
sd->format = SND_PCM_FORMAT_FLOAT_BE;
break;
case AU_ENCODING_IEEE64:
sd->format = SND_PCM_FORMAT_FLOAT64_BE;
break;
case AU_ENCODING_8:
sd->format = SND_PCM_FORMAT_S8;
break;
case AU_ENCODING_16:
sd->format = SND_PCM_FORMAT_S16_BE;
break;
case AU_ENCODING_24:
sd->format = SND_PCM_FORMAT_S24_BE;
break;
case AU_ENCODING_32:
sd->format = SND_PCM_FORMAT_S32_BE;
break;
default:
error ("Unsupported AU file format");
}
}
else
emacs_abort ();
}
/*
* Terminals with magicwrap (xn) don't all behave identically.
* The VT100 leaves the cursor in the last column but will wrap before
* printing the next character. I hear that the Concept terminal does
* the wrap immediately but ignores the next newline it sees. And some
* terminals just have buggy firmware, and think that the cursor is still
* in limbo if we use direct cursor addressing from the phantom column.
* The only guaranteed safe thing to do is to emit a CRLF immediately
* after we reach the last column; this takes us to a known state.
*/
void
cmcheckmagic (struct tty_display_info *tty)
{
if (curX (tty) == FrameCols (tty))
{
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
emacs_abort ();
if (tty->termscript)
putc ('\r', tty->termscript);
putc ('\r', tty->output);
if (tty->termscript)
putc ('\n', tty->termscript);
putc ('\n', tty->output);
curX (tty) = 0;
curY (tty)++;
}
}
Widget
lw_make_widget (LWLIB_ID id, Widget parent, Boolean pop_up_p)
{
widget_instance* instance;
widget_info* info;
instance = find_instance (id, parent, pop_up_p);
if (!instance)
{
info = get_widget_info (id, False);
if (!info)
return NULL;
instance = allocate_widget_instance (info, parent, pop_up_p);
initialize_widget_instance (instance);
}
if (!instance->widget)
emacs_abort ();
return instance->widget;
}
static void
byte_char_debug_check (struct buffer *b, ptrdiff_t charpos, ptrdiff_t bytepos)
{
ptrdiff_t nchars;
if (NILP (BVAR (b, enable_multibyte_characters)))
return;
if (bytepos > BUF_GPT_BYTE (b))
nchars
= multibyte_chars_in_text (BUF_BEG_ADDR (b),
BUF_GPT_BYTE (b) - BUF_BEG_BYTE (b))
+ multibyte_chars_in_text (BUF_GAP_END_ADDR (b),
bytepos - BUF_GPT_BYTE (b));
else
nchars = multibyte_chars_in_text (BUF_BEG_ADDR (b),
bytepos - BUF_BEG_BYTE (b));
if (charpos - 1 != nchars)
emacs_abort ();
}
void
timerfd_callback (int fd, void *arg)
{
ptrdiff_t nbytes;
uint64_t expirations;
eassert (fd == timerfd);
nbytes = emacs_read (fd, &expirations, sizeof (expirations));
if (nbytes == sizeof (expirations))
{
/* Timer should expire just once. */
eassert (expirations == 1);
do_pending_atimers ();
}
else if (nbytes < 0)
/* For some not yet known reason, we may get weird event and no
data on timer descriptor. This can break Gnus at least, see:
http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00503.html. */
eassert (errno == EAGAIN);
else
/* I don't know what else can happen with this descriptor. */
emacs_abort ();
}
widget_value *
digest_single_submenu (int start, int end, bool top_level_items)
{
widget_value *wv, *prev_wv, *save_wv, *first_wv;
int i;
int submenu_depth = 0;
widget_value **submenu_stack;
bool panes_seen = 0;
struct frame *f = XFRAME (Vmenu_updating_frame);
USE_SAFE_ALLOCA;
SAFE_NALLOCA (submenu_stack, 1, menu_items_used);
wv = make_widget_value ("menu", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
save_wv = 0;
prev_wv = 0;
/* Loop over all panes and items made by the preceding call
to parse_single_submenu and construct a tree of widget_value objects.
Ignore the panes and items used by previous calls to
digest_single_submenu, even though those are also in menu_items. */
i = start;
while (i < end)
{
if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
i++;
}
else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name;
const char *pane_string;
panes_seen = 1;
pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
/* TTY menus display menu items via tty_write_glyphs, which
will encode the strings as appropriate. */
if (!FRAME_TERMCAP_P (f))
{
#ifdef HAVE_NTGUI
if (STRINGP (pane_name))
{
if (unicode_append_menu)
/* Encode as UTF-8 for now. */
pane_name = ENCODE_UTF_8 (pane_name);
else if (STRING_MULTIBYTE (pane_name))
pane_name = ENCODE_SYSTEM (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#elif defined (USE_LUCID) && defined (HAVE_XFT)
if (STRINGP (pane_name))
{
pane_name = ENCODE_UTF_8 (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
{
pane_name = ENCODE_MENU_STRING (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
#endif
}
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
/* If there is just one top-level pane, put all its items directly
under the top-level menu. */
if (menu_items_n_panes == 1)
pane_string = "";
/* If the pane has a meaningful name,
make the pane a top-level menu item
with its items as a submenu beneath it. */
if (strcmp (pane_string, ""))
{
/* Set value to 1 so update_submenu_strings can handle '@'. */
wv = make_widget_value (NULL, (char *) 1, true, Qnil);
if (save_wv)
save_wv->next = wv;
else
first_wv->contents = wv;
wv->lname = pane_name;
wv->button_type = BUTTON_TYPE_NONE;
save_wv = wv;
}
else
save_wv = first_wv;
prev_wv = 0;
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip, def, type, selected;
Lisp_Object help;
/* All items should be contained in panes. */
if (! panes_seen)
emacs_abort ();
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
/* TTY menu items and their descriptions will be encoded by
tty_write_glyphs. */
if (!FRAME_TERMCAP_P (f))
{
#ifdef HAVE_NTGUI
if (STRINGP (item_name))
{
if (unicode_append_menu)
item_name = ENCODE_UTF_8 (item_name);
else if (STRING_MULTIBYTE (item_name))
item_name = ENCODE_SYSTEM (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
{
descrip = ENCODE_SYSTEM (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#elif USE_LUCID
if (STRINGP (item_name))
{
item_name = ENCODE_UTF_8 (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip))
{
descrip = ENCODE_UTF_8 (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#elif !defined (HAVE_MULTILINGUAL_MENU)
if (STRING_MULTIBYTE (item_name))
{
item_name = ENCODE_MENU_STRING (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
{
descrip = ENCODE_MENU_STRING (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
#endif
}
wv = make_widget_value (NULL, NULL, !NILP (enable),
STRINGP (help) ? help : Qnil);
if (prev_wv)
prev_wv->next = wv;
else
save_wv->contents = wv;
wv->lname = item_name;
if (!NILP (descrip))
wv->lkey = descrip;
/* The intptr_t cast avoids a warning. There's no problem
as long as pointers have enough bits to hold small integers. */
wv->call_data = (!NILP (def) ? (void *) (intptr_t) i : 0);
if (NILP (type))
wv->button_type = BUTTON_TYPE_NONE;
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else
emacs_abort ();
wv->selected = !NILP (selected);
prev_wv = wv;
i += MENU_ITEMS_ITEM_LENGTH;
}
}
/* If we have just one "menu item"
that was originally a button, return it by itself. */
if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
{
wv = first_wv;
first_wv = first_wv->contents;
xfree (wv);
}
SAFE_FREE ();
return first_wv;
}
static void
calculate_scrolling (struct frame *frame,
/* matrix is of size window_size + 1 on each side. */
struct matrix_elt *matrix,
int window_size, int lines_below,
int *draw_cost, unsigned *old_hash, unsigned *new_hash,
int free_at_end)
{
int i, j;
int frame_total_lines = FRAME_TOTAL_LINES (frame);
struct matrix_elt *p, *p1;
int cost, cost1;
int lines_moved = window_size
+ (FRAME_SCROLL_REGION_OK (frame) ? 0 : lines_below);
/* first_insert_cost[I] is the cost of doing the first insert-line
at the i'th line of the lines we are considering,
where I is origin 1 (as it is below). */
int *first_insert_cost
= &FRAME_INSERT_COST (frame)[frame_total_lines - 1 - lines_moved];
int *first_delete_cost
= &FRAME_DELETE_COST (frame)[frame_total_lines - 1 - lines_moved];
int *next_insert_cost
= &FRAME_INSERTN_COST (frame)[frame_total_lines - 1 - lines_moved];
int *next_delete_cost
= &FRAME_DELETEN_COST (frame)[frame_total_lines - 1 - lines_moved];
/* Discourage long scrolls on fast lines.
Don't scroll nearly a full frame height unless it saves
at least 1/4 second. */
int extra_cost
= clip_to_bounds (1, baud_rate / (10 * 4) / frame_total_lines, INT_MAX / 2);
/* initialize the top left corner of the matrix */
matrix->writecost = 0;
matrix->insertcost = SCROLL_INFINITY;
matrix->deletecost = SCROLL_INFINITY;
matrix->insertcount = 0;
matrix->deletecount = 0;
/* initialize the left edge of the matrix */
cost = first_insert_cost[1] - next_insert_cost[1];
for (i = 1; i <= window_size; i++)
{
p = matrix + i * (window_size + 1);
cost += draw_cost[i] + next_insert_cost[i] + extra_cost;
p->insertcost = cost;
p->writecost = SCROLL_INFINITY;
p->deletecost = SCROLL_INFINITY;
p->insertcount = i;
p->deletecount = 0;
}
/* initialize the top edge of the matrix */
cost = first_delete_cost[1] - next_delete_cost[1];
for (j = 1; j <= window_size; j++)
{
cost += next_delete_cost[j];
matrix[j].deletecost = cost;
matrix[j].writecost = SCROLL_INFINITY;
matrix[j].insertcost = SCROLL_INFINITY;
matrix[j].deletecount = j;
matrix[j].insertcount = 0;
}
/* `i' represents the vpos among new frame contents.
`j' represents the vpos among the old frame contents. */
p = matrix + window_size + 2; /* matrix [1, 1] */
for (i = 1; i <= window_size; i++, p++)
for (j = 1; j <= window_size; j++, p++)
{
/* p contains the address of matrix [i, j] */
/* First calculate the cost assuming we do
not insert or delete above this line.
That is, if we update through line i-1
based on old lines through j-1,
and then just change old line j to new line i. */
p1 = p - window_size - 2; /* matrix [i-1, j-1] */
cost = p1->writecost;
if (cost > p1->insertcost)
cost = p1->insertcost;
if (cost > p1->deletecost)
cost = p1->deletecost;
if (old_hash[j] != new_hash[i])
cost += draw_cost[i];
p->writecost = cost;
/* Calculate the cost if we do an insert-line
before outputting this line.
That is, we update through line i-1
based on old lines through j,
do an insert-line on line i,
and then output line i from scratch,
leaving old lines starting from j for reuse below. */
p1 = p - window_size - 1; /* matrix [i-1, j] */
/* No need to think about doing a delete followed
immediately by an insert. It cannot be as good
as not doing either of them. */
if (free_at_end == i)
{
cost = p1->writecost;
cost1 = p1->insertcost;
}
else
{
cost = p1->writecost + first_insert_cost[i];
if (p1->insertcount > i)
emacs_abort ();
cost1 = p1->insertcost + next_insert_cost[i - p1->insertcount];
}
p->insertcost = min (cost, cost1) + draw_cost[i] + extra_cost;
p->insertcount = (cost < cost1) ? 1 : p1->insertcount + 1;
if (p->insertcount > i)
emacs_abort ();
/* Calculate the cost if we do a delete line after
outputting this line.
That is, we update through line i
based on old lines through j-1,
and throw away old line j. */
p1 = p - 1; /* matrix [i, j-1] */
/* No need to think about doing an insert followed
immediately by a delete. */
if (free_at_end == i)
{
cost = p1->writecost;
cost1 = p1->deletecost;
}
else
{
cost = p1->writecost + first_delete_cost[i];
cost1 = p1->deletecost + next_delete_cost[i];
}
p->deletecost = min (cost, cost1);
p->deletecount = (cost < cost1) ? 1 : p1->deletecount + 1;
}
}
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
w32_menu_show (struct frame *f, int x, int y, int menuflags,
Lisp_Object title, const char **error)
{
int i;
int menu_item_selection;
HMENU menu;
POINT pos;
widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
widget_value **submenu_stack
= (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
Lisp_Object *subprefix_stack
= (Lisp_Object *) alloca (menu_items_used * word_size);
int submenu_depth = 0;
bool first_pane;
*error = NULL;
if (menu_items_n_panes == 0)
return Qnil;
if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
{
*error = "Empty menu";
return Qnil;
}
block_input ();
/* Create a tree of widget_value objects
representing the panes and their items. */
wv = make_widget_value ("menu", NULL, true, Qnil);
wv->button_type = BUTTON_TYPE_NONE;
first_wv = wv;
first_pane = true;
/* Loop over all panes and items, filling in the tree. */
i = 0;
while (i < menu_items_used)
{
if (EQ (AREF (menu_items, i), Qnil))
{
submenu_stack[submenu_depth++] = save_wv;
save_wv = prev_wv;
prev_wv = 0;
first_pane = false;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prev_wv = save_wv;
save_wv = submenu_stack[--submenu_depth];
first_pane = false;
i++;
}
else if (EQ (AREF (menu_items, i), Qt)
&& submenu_depth != 0)
i += MENU_ITEMS_PANE_LENGTH;
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else if (EQ (AREF (menu_items, i), Qt))
{
/* Create a new pane. */
Lisp_Object pane_name, prefix;
const char *pane_string;
pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
if (STRINGP (pane_name))
{
if (unicode_append_menu)
pane_name = ENCODE_UTF_8 (pane_name);
else if (STRING_MULTIBYTE (pane_name))
pane_name = ENCODE_SYSTEM (pane_name);
ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
}
pane_string = (NILP (pane_name)
? "" : SSDATA (pane_name));
/* If there is just one top-level pane, put all its items directly
under the top-level menu. */
if (menu_items_n_panes == 1)
pane_string = "";
/* If the pane has a meaningful name,
make the pane a top-level menu item
with its items as a submenu beneath it. */
if (!(menuflags & MENU_KEYMAPS) && strcmp (pane_string, ""))
{
wv = make_widget_value (pane_string, NULL, true, Qnil);
if (save_wv)
save_wv->next = wv;
else
first_wv->contents = wv;
if ((menuflags & MENU_KEYMAPS) && !NILP (prefix))
wv->name++;
wv->button_type = BUTTON_TYPE_NONE;
save_wv = wv;
prev_wv = 0;
}
else if (first_pane)
{
save_wv = wv;
prev_wv = 0;
}
first_pane = false;
i += MENU_ITEMS_PANE_LENGTH;
}
else
{
/* Create a new item within current pane. */
Lisp_Object item_name, enable, descrip, def, type, selected, help;
item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
if (STRINGP (item_name))
{
if (unicode_append_menu)
item_name = ENCODE_UTF_8 (item_name);
else if (STRING_MULTIBYTE (item_name))
item_name = ENCODE_SYSTEM (item_name);
ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
}
if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
{
descrip = ENCODE_SYSTEM (descrip);
ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
}
wv = make_widget_value (SSDATA (item_name), NULL, !NILP (enable),
STRINGP (help) ? help : Qnil);
if (prev_wv)
prev_wv->next = wv;
else
save_wv->contents = wv;
if (!NILP (descrip))
wv->key = SSDATA (descrip);
/* Use the contents index as call_data, since we are
restricted to 16-bits. */
wv->call_data = !NILP (def) ? (void *) (UINT_PTR) i : 0;
if (NILP (type))
wv->button_type = BUTTON_TYPE_NONE;
else if (EQ (type, QCtoggle))
wv->button_type = BUTTON_TYPE_TOGGLE;
else if (EQ (type, QCradio))
wv->button_type = BUTTON_TYPE_RADIO;
else
emacs_abort ();
wv->selected = !NILP (selected);
prev_wv = wv;
i += MENU_ITEMS_ITEM_LENGTH;
}
}
/* Deal with the title, if it is non-nil. */
if (!NILP (title))
{
widget_value *wv_title;
widget_value *wv_sep = make_widget_value ("--", NULL, false, Qnil);
/* Maybe replace this separator with a bitmap or owner-draw item
so that it looks better. Having two separators looks odd. */
wv_sep->next = first_wv->contents;
if (unicode_append_menu)
title = ENCODE_UTF_8 (title);
else if (STRING_MULTIBYTE (title))
title = ENCODE_SYSTEM (title);
wv_title = make_widget_value (SSDATA (title), NULL, true, Qnil);
wv_title->title = TRUE;
wv_title->button_type = BUTTON_TYPE_NONE;
wv_title->next = wv_sep;
first_wv->contents = wv_title;
}
/* No selection has been chosen yet. */
menu_item_selection = 0;
/* Actually create the menu. */
current_popup_menu = menu = CreatePopupMenu ();
fill_in_menu (menu, first_wv->contents);
/* Adjust coordinates to be root-window-relative. */
pos.x = x;
pos.y = y;
ClientToScreen (FRAME_W32_WINDOW (f), &pos);
/* Display the menu. */
menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
WM_EMACS_TRACKPOPUPMENU,
(WPARAM)menu, (LPARAM)&pos);
/* Clean up extraneous mouse events which might have been generated
during the call. */
discard_mouse_events ();
FRAME_DISPLAY_INFO (f)->grabbed = 0;
/* Free the widget_value objects we used to specify the contents. */
free_menubar_widget_value_tree (first_wv);
DestroyMenu (menu);
/* Free the owner-drawn and help-echo menu strings. */
w32_free_menu_strings (FRAME_W32_WINDOW (f));
f->output_data.w32->menubar_active = 0;
/* Find the selected item, and its pane, to return
the proper value. */
if (menu_item_selection != 0)
{
Lisp_Object prefix, entry;
prefix = entry = Qnil;
i = 0;
while (i < menu_items_used)
{
if (EQ (AREF (menu_items, i), Qnil))
{
subprefix_stack[submenu_depth++] = prefix;
prefix = entry;
i++;
}
else if (EQ (AREF (menu_items, i), Qlambda))
{
prefix = subprefix_stack[--submenu_depth];
i++;
}
else if (EQ (AREF (menu_items, i), Qt))
{
prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
i += MENU_ITEMS_PANE_LENGTH;
}
/* Ignore a nil in the item list.
It's meaningful only for dialog boxes. */
else if (EQ (AREF (menu_items, i), Qquote))
i += 1;
else
{
entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
if (menu_item_selection == i)
{
if (menuflags & MENU_KEYMAPS)
{
int j;
entry = Fcons (entry, Qnil);
if (!NILP (prefix))
entry = Fcons (prefix, entry);
for (j = submenu_depth - 1; j >= 0; j--)
if (!NILP (subprefix_stack[j]))
entry = Fcons (subprefix_stack[j], entry);
}
unblock_input ();
return entry;
}
i += MENU_ITEMS_ITEM_LENGTH;
}
}
}
else if (!(menuflags & MENU_FOR_CLICK))
{
unblock_input ();
/* Make "Cancel" equivalent to C-g. */
Fsignal (Qquit, Qnil);
}
unblock_input ();
return Qnil;
}
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;
}