void
record_insert (ptrdiff_t beg, ptrdiff_t length)
{
Lisp_Object lbeg, lend;
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
record_point (beg);
/* If this is following another insertion and consecutive with it
in the buffer, combine the two. */
if (CONSP (BVAR (current_buffer, undo_list)))
{
Lisp_Object elt;
elt = XCAR (BVAR (current_buffer, undo_list));
if (CONSP (elt)
&& INTEGERP (XCAR (elt))
&& INTEGERP (XCDR (elt))
&& XINT (XCDR (elt)) == beg)
{
XSETCDR (elt, make_number (beg + length));
return;
}
}
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
bset_undo_list (current_buffer,
Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
}
/* 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 Lisp_Object
inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev)
{
Lisp_Object name;
uint32_t mask;
CONS_TO_INTEGER (Fnth (make_number (3), watch), uint32_t, mask);
if (! (mask & ev->mask))
return Qnil;
if (ev->len > 0)
{
size_t const len = strlen (ev->name);
name = make_unibyte_string (ev->name, min (len, ev->len));
name = DECODE_FILE (name);
}
else
name = XCAR (XCDR (watch));
return list2 (list4 (Fcons (INTEGER_TO_CONS (ev->wd), XCAR (watch)),
mask_to_aspects (ev->mask),
name,
INTEGER_TO_CONS (ev->cookie)),
Fnth (make_number (2), watch));
}
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;
}
}
/* Generate a file notification event. */
static void
kqueue_generate_event (Lisp_Object watch_object, Lisp_Object actions,
Lisp_Object file, Lisp_Object file1)
{
Lisp_Object flags, action, entry;
struct input_event event;
/* Check, whether all actions shall be monitored. */
flags = Fnth (make_number (2), watch_object);
action = actions;
do {
if (NILP (action))
break;
entry = XCAR (action);
if (NILP (Fmember (entry, flags))) {
action = XCDR (action);
actions = Fdelq (entry, actions);
} else
action = XCDR (action);
} while (1);
/* Store it into the input event queue. */
if (! NILP (actions)) {
EVENT_INIT (event);
event.kind = FILE_NOTIFY_EVENT;
event.frame_or_window = Qnil;
event.arg = list2 (Fcons (XCAR (watch_object),
Fcons (actions,
NILP (file1)
? Fcons (file, Qnil)
: list2 (file, file1))),
Fnth (make_number (3), watch_object));
kbd_buffer_store_event (&event);
}
}
/* Invalidate the line number cache positions that lie after POS. */
static void
invalidate_line_number_cache (struct buffer *b, Charbpos pos)
{
EMACS_INT i, j;
Lisp_Object *ring = XVECTOR_DATA (LINE_NUMBER_RING (b));
for (i = 0; i < LINE_NUMBER_RING_SIZE; i++)
{
if (!CONSP (ring[i]))
break;
/* As the marker stays behind the insertions, this check might
as well be `>'. However, Finsert_before_markers can advance
the marker anyway, which bites in shell buffers.
#### This forces recreation of the cached marker (and
recalculation of newlines) every time a newline is inserted
at point, which is way losing. Isn't there a way to make a
marker impervious to Finsert_before_markers()?? Maybe I
should convert the code to use extents. */
if (marker_position (XCAR (ring[i])) >= pos)
{
/* Get the marker out of the way. */
Fset_marker (XCAR (ring[i]), Qnil, Qnil);
/* ...and shift the ring elements, up to the first nil. */
for (j = i; !NILP (ring[j]) && j < LINE_NUMBER_RING_SIZE - 1; j++)
ring[j] = ring[j + 1];
ring[j] = Qnil;
/* Must recheck position i. */
i--;
}
}
}
/* Generate a list from the directory_files_internal output.
Items are (INODE FILE-NAME LAST-MOD LAST-STATUS-MOD SIZE). */
Lisp_Object
kqueue_directory_listing (Lisp_Object directory_files)
{
Lisp_Object dl, result = Qnil;
for (dl = directory_files; ! NILP (dl); dl = XCDR (dl)) {
/* We ignore "." and "..". */
if ((strcmp (".", SSDATA (XCAR (XCAR (dl)))) == 0) ||
(strcmp ("..", SSDATA (XCAR (XCAR (dl)))) == 0))
continue;
result = Fcons
(list5 (/* inode. */
Fnth (make_number (11), XCAR (dl)),
/* filename. */
XCAR (XCAR (dl)),
/* last modification time. */
Fnth (make_number (6), XCAR (dl)),
/* last status change time. */
Fnth (make_number (7), XCAR (dl)),
/* size. */
Fnth (make_number (8), XCAR (dl))),
result);
}
return result;
}
static Lisp_Object
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
int local_request, struct mac_display_info *dpyinfo)
{
Lisp_Object local_value;
Lisp_Object handler_fn, value, type, check;
if (!x_selection_owner_p (selection_symbol, dpyinfo))
return Qnil;
local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
/* TIMESTAMP is a special case. */
if (EQ (target_type, QTIMESTAMP))
{
handler_fn = Qnil;
value = XCAR (XCDR (XCDR (local_value)));
}
else
{
/* Don't allow a quit within the converter.
When the user types C-g, he would be surprised
if by luck it came during a converter. */
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qinhibit_quit, Qt);
CHECK_SYMBOL (target_type);
handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
/* gcpro is not needed here since nothing but HANDLER_FN
is live, and that ought to be a symbol. */
if (!NILP (handler_fn))
value = call3 (handler_fn,
selection_symbol, (local_request ? Qnil : target_type),
XCAR (XCDR (local_value)));
else
value = Qnil;
unbind_to (count, Qnil);
}
if (local_request)
return value;
/* Make sure this value is of a type that we could transmit
to another application. */
type = target_type;
check = value;
if (CONSP (value)
&& SYMBOLP (XCAR (value)))
type = XCAR (value),
check = XCDR (value);
if (NILP (value) || mac_valid_selection_value_p (check, type))
return value;
signal_error ("Invalid data returned by selection-conversion function",
list2 (handler_fn, value));
}
static Lisp_Object
find_descriptor (Lisp_Object descriptor)
{
Lisp_Object tail, prevtail = Qt;
for (tail = watch_list; !NILP (tail); prevtail = tail, tail = XCDR (tail))
if (equal_no_quit (XCAR (XCAR (tail)), descriptor))
return prevtail;
return Qnil;
}
static void
record_point (EMACS_INT pt)
{
int at_boundary;
/* Don't record position of pt when undo_inhibit_record_point holds. */
if (undo_inhibit_record_point)
return;
/* Allocate a cons cell to be the undo boundary after this command. */
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
if ((current_buffer != last_undo_buffer)
/* Don't call Fundo_boundary for the first change. Otherwise we
risk overwriting last_boundary_position in Fundo_boundary with
PT of the current buffer and as a consequence not insert an
undo boundary because last_boundary_position will equal pt in
the test at the end of the present function (Bug#731). */
&& (MODIFF > SAVE_MODIFF))
Fundo_boundary ();
last_undo_buffer = current_buffer;
if (CONSP (BVAR (current_buffer, undo_list)))
{
/* Set AT_BOUNDARY to 1 only when we have nothing other than
marker adjustment before undo boundary. */
Lisp_Object tail = BVAR (current_buffer, undo_list), elt;
while (1)
{
if (NILP (tail))
elt = Qnil;
else
elt = XCAR (tail);
if (NILP (elt) || ! (CONSP (elt) && MARKERP (XCAR (elt))))
break;
tail = XCDR (tail);
}
at_boundary = NILP (elt);
}
else
at_boundary = 1;
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
/* If we are just after an undo boundary, and
point wasn't at start of deleted range, record where it was. */
if (at_boundary
&& current_buffer == last_boundary_buffer
&& last_boundary_position != pt)
BVAR (current_buffer, undo_list)
= Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list));
}
static void
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
CALLN (Fmessage, format,
(SYMBOLP (obj)
? SYMBOL_NAME (obj)
: build_string ("<anonymous>")));
}
}
}
static void
restore_menu_items (Lisp_Object saved)
{
menu_items = XCAR (saved);
menu_items_inuse = (! NILP (menu_items) ? Qt : Qnil);
menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
saved = XCDR (saved);
menu_items_used = XINT (XCAR (saved));
saved = XCDR (saved);
menu_items_n_panes = XINT (XCAR (saved));
saved = XCDR (saved);
menu_items_submenu_depth = XINT (XCAR (saved));
}
/* Remove all watches associated with the watch list element after
PREVTAIL, or after the first element if PREVTAIL is t. If INVALID_P
is true, the descriptor is already invalid, i.e., it received a
IN_IGNORED event. In this case skip calling inotify_rm_watch. */
static void
remove_descriptor (Lisp_Object prevtail, bool invalid_p)
{
Lisp_Object tail = CONSP (prevtail) ? XCDR (prevtail) : watch_list;
int inotify_errno = 0;
if (! invalid_p)
{
int wd;
CONS_TO_INTEGER (XCAR (XCAR (tail)), int, wd);
if (inotify_rm_watch (inotifyfd, wd) != 0)
inotify_errno = errno;
}
if (CONSP (prevtail))
XSETCDR (prevtail, XCDR (tail));
else
{
watch_list = XCDR (tail);
if (NILP (watch_list))
{
delete_read_fd (inotifyfd);
emacs_close (inotifyfd);
inotifyfd = -1;
}
}
if (inotify_errno != 0)
{
errno = inotify_errno;
report_file_notify_error ("Could not rm watch", XCAR (tail));
}
}
/* Get the nearest known position we know the line number of
(i.e. BUF_BEGV, and cached positions). The return position will be
either closer than BEG, or BEG. The line of this known position
will be stored in LINE.
*LINE should be initialized to the line number of BEG (normally,
BEG will be BUF_BEGV, and *LINE will be XFIXNUM (LINE_NUMBER_BEGV).
This will initialize the cache, if necessary. */
static void
get_nearest_line_number (struct buffer *b, Charbpos *beg, Charbpos pos,
EMACS_INT *line)
{
EMACS_INT i;
Lisp_Object *ring = XVECTOR_DATA (LINE_NUMBER_RING (b));
Charcount length = pos - *beg;
if (length < 0)
length = -length;
/* Find the ring entry closest to POS, if it is closer than BEG. */
for (i = 0; i < LINE_NUMBER_RING_SIZE && CONSP (ring[i]); i++)
{
Charbpos newpos = marker_position (XCAR (ring[i]));
Charcount howfar = newpos - pos;
if (howfar < 0)
howfar = -howfar;
if (howfar < length)
{
length = howfar;
*beg = newpos;
*line = XFIXNUM (XCDR (ring[i]));
}
}
}
static int
x_selection_owner_p (Lisp_Object selection, struct mac_display_info *dpyinfo)
{
OSStatus err;
Selection sel;
Lisp_Object local_selection_data;
int result = 0;
local_selection_data = LOCAL_SELECTION (selection, dpyinfo);
if (NILP (local_selection_data))
return 0;
block_input ();
err = mac_get_selection_from_symbol (selection, 0, &sel);
if (err == noErr && sel)
{
Lisp_Object ownership_info;
ownership_info = XCAR (XCDR (XCDR (XCDR (XCDR (local_selection_data)))));
if (!NILP (Fequal (ownership_info,
mac_get_selection_ownership_info (sel))))
result = 1;
}
else
result = 1;
unblock_input ();
return result;
}
/* Record point, if necessary, as it was at beginning of this command.
BEG is the position of point that will naturally occur as a result
of the undo record that will be added just after this command
terminates. */
static void
record_point (ptrdiff_t beg)
{
/* Don't record position of pt when undo_inhibit_record_point holds. */
if (undo_inhibit_record_point)
return;
bool at_boundary;
/* Check whether we are at a boundary now, in case we record the
first change. FIXME: This check is currently dependent on being
called before record_first_change, but could be made not to by
ignoring timestamp undo entries */
at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
|| NILP (XCAR (BVAR (current_buffer, undo_list)));
/* If this is the first change since save, then record this.*/
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
/* We may need to record point if we are immediately after a
boundary, so that this will be restored correctly after undo. We
do not need to do this if point is at the start of a change
region since it will be restored there anyway, and we must not do
this if the buffer has changed since the last command, since the
value of point that we have will be for that buffer, not this.*/
if (at_boundary
&& point_before_last_command_or_undo != beg
&& buffer_before_last_command_or_undo == current_buffer )
bset_undo_list (current_buffer,
Fcons (make_number (point_before_last_command_or_undo),
BVAR (current_buffer, undo_list)));
}
static int
memq_no_quit (Lisp_Object elt, Lisp_Object list)
{
while (CONSP (list) && ! EQ (XCAR (list), elt))
list = XCDR (list);
return (CONSP (list));
}
static int
parse_sound (Lisp_Object sound, Lisp_Object *attrs)
{
/* SOUND must be a list starting with the symbol `sound'. */
if (!CONSP (sound) || !EQ (XCAR (sound), Qsound))
return 0;
sound = XCDR (sound);
attrs[SOUND_FILE] = Fplist_get (sound, QCfile);
attrs[SOUND_DATA] = Fplist_get (sound, QCdata);
attrs[SOUND_DEVICE] = Fplist_get (sound, QCdevice);
attrs[SOUND_VOLUME] = Fplist_get (sound, QCvolume);
#ifndef WINDOWSNT
/* File name or data must be specified. */
if (!STRINGP (attrs[SOUND_FILE])
&& !STRINGP (attrs[SOUND_DATA]))
return 0;
#else /* WINDOWSNT */
/*
Data is not supported in Windows. Therefore a
File name MUST be supplied.
*/
if (!STRINGP (attrs[SOUND_FILE]))
{
return 0;
}
#endif /* WINDOWSNT */
/* Volume must be in the range 0..100 or unspecified. */
if (!NILP (attrs[SOUND_VOLUME]))
{
if (INTEGERP (attrs[SOUND_VOLUME]))
{
if (XINT (attrs[SOUND_VOLUME]) < 0
|| XINT (attrs[SOUND_VOLUME]) > 100)
return 0;
}
else if (FLOATP (attrs[SOUND_VOLUME]))
{
if (XFLOAT_DATA (attrs[SOUND_VOLUME]) < 0
|| XFLOAT_DATA (attrs[SOUND_VOLUME]) > 1)
return 0;
}
else
return 0;
}
#ifndef WINDOWSNT
/* Device must be a string or unspecified. */
if (!NILP (attrs[SOUND_DEVICE])
&& !STRINGP (attrs[SOUND_DEVICE]))
return 0;
#endif /* WINDOWSNT */
/*
Since device is ignored in Windows, it does not matter
what it is.
*/
return 1;
}
static void
record_point (ptrdiff_t pt)
{
bool at_boundary;
/* Don't record position of pt when undo_inhibit_record_point holds. */
if (undo_inhibit_record_point)
return;
/* Allocate a cons cell to be the undo boundary after this command. */
if (NILP (pending_boundary))
pending_boundary = Fcons (Qnil, Qnil);
run_undoable_change ();
at_boundary = ! CONSP (BVAR (current_buffer, undo_list))
|| NILP (XCAR (BVAR (current_buffer, undo_list)));
if (MODIFF <= SAVE_MODIFF)
record_first_change ();
/* If we are just after an undo boundary, and
point wasn't at start of deleted range, record where it was. */
if (at_boundary
&& current_buffer == last_boundary_buffer
&& last_boundary_position != pt)
bset_undo_list (current_buffer,
Fcons (make_number (last_boundary_position),
BVAR (current_buffer, undo_list)));
}
static bool
xfont_chars_supported (Lisp_Object chars, XFontStruct *xfont,
struct charset *encoding, struct charset *repertory)
{
struct charset *charset = repertory ? repertory : encoding;
if (CONSP (chars))
{
for (; CONSP (chars); chars = XCDR (chars))
{
int c = XINT (XCAR (chars));
unsigned code = ENCODE_CHAR (charset, c);
XChar2b char2b;
if (code == CHARSET_INVALID_CODE (charset))
break;
if (! xfont)
continue;
if (code >= 0x10000)
break;
char2b.byte1 = code >> 8;
char2b.byte2 = code & 0xFF;
if (! xfont_get_pcm (xfont, &char2b))
break;
}
return (NILP (chars));
}
else if (VECTORP (chars))
static void
xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity)
{
Lisp_Object tail;
int ival;
for (tail = AREF (entity, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object key = XCAR (XCAR (tail));
Lisp_Object val = XCDR (XCAR (tail));
if (EQ (key, QCantialias))
FcPatternAddBool (pat, FC_ANTIALIAS, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QChinting))
FcPatternAddBool (pat, FC_HINTING, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QCautohint))
FcPatternAddBool (pat, FC_AUTOHINT, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QChintstyle))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_HINT_STYLE, XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_HINT_STYLE, ival);
}
else if (EQ (key, QCrgba))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_RGBA, XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_RGBA, ival);
}
else if (EQ (key, QClcdfilter))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_LCD_FILTER, ival);
}
#ifdef FC_EMBOLDEN
else if (EQ (key, QCembolden))
FcPatternAddBool (pat, FC_EMBOLDEN, NILP (val) ? FcFalse : FcTrue);
#endif
}
}
/* Remove watch associated with (descriptor, id). */
static void
remove_watch (Lisp_Object descriptor, Lisp_Object id)
{
Lisp_Object prevtail = find_descriptor (descriptor);
if (NILP (prevtail))
return;
Lisp_Object elt = XCAR (CONSP (prevtail) ? XCDR (prevtail) : watch_list);
for (Lisp_Object prev = elt; !NILP (XCDR (prev)); prev = XCDR (prev))
if (EQ (id, XCAR (XCAR (XCDR (prev)))))
{
XSETCDR (prev, XCDR (XCDR (prev)));
if (NILP (XCDR (elt)))
remove_descriptor (prevtail, false);
break;
}
}
static widget_value *gui_items_to_widget_values_1(Lisp_Object
gui_object_instance,
Lisp_Object items,
widget_value * parent,
widget_value * prev,
int accel_p)
{
widget_value *wv = 0;
assert((parent || prev) && !(parent && prev));
/* now walk the tree creating widget_values as appropriate */
if (!CONSP(items)) {
wv = xmalloc_widget_value();
if (parent)
parent->contents = wv;
else
prev->next = wv;
if (!button_item_to_widget_value(gui_object_instance,
items, wv, 0, 1, 0, accel_p)) {
free_widget_value_tree(wv);
if (parent)
parent->contents = 0;
else
prev->next = 0;
} else
wv->value = xstrdup(wv->name); /* what a mess... */
} else {
/* first one is the parent */
if (CONSP(XCAR(items)))
syntax_error("parent item must not be a list",
XCAR(items));
if (parent)
wv = gui_items_to_widget_values_1(gui_object_instance,
XCAR(items), parent,
0, accel_p);
else
wv = gui_items_to_widget_values_1(gui_object_instance,
XCAR(items), 0, prev,
accel_p);
/* the rest are the children */
gui_item_children_to_widget_values(gui_object_instance,
XCDR(items), wv, accel_p);
}
return wv;
}
static Lisp_Object
xftfont_list (struct frame *f, Lisp_Object spec)
{
Lisp_Object list = ftfont_driver.list (f, spec), tail;
for (tail = list; CONSP (tail); tail = XCDR (tail))
ASET (XCAR (tail), FONT_TYPE_INDEX, Qxft);
return list;
}
/* This is the callback function for arriving input on kqueuefd. It
shall create a Lisp event, and put it into the Emacs input queue. */
static void
kqueue_callback (int fd, void *data)
{
for (;;) {
struct kevent kev;
static const struct timespec nullts = { 0, 0 };
Lisp_Object descriptor, watch_object, file, actions;
/* Read one event. */
int ret = kevent (kqueuefd, NULL, 0, &kev, 1, &nullts);
if (ret < 1) {
/* All events read. */
return;
}
/* Determine descriptor and file name. */
descriptor = make_number (kev.ident);
watch_object = assq_no_quit (descriptor, watch_list);
if (CONSP (watch_object))
file = XCAR (XCDR (watch_object));
else
continue;
/* Determine event actions. */
actions = Qnil;
if (kev.fflags & NOTE_DELETE)
actions = Fcons (Qdelete, actions);
if (kev.fflags & NOTE_WRITE) {
/* Check, whether this is a directory event. */
if (NILP (Fnth (make_number (4), watch_object)))
actions = Fcons (Qwrite, actions);
else
kqueue_compare_dir_list (watch_object);
}
if (kev.fflags & NOTE_EXTEND)
actions = Fcons (Qextend, actions);
if (kev.fflags & NOTE_ATTRIB)
actions = Fcons (Qattrib, actions);
if (kev.fflags & NOTE_LINK)
actions = Fcons (Qlink, actions);
/* It would be useful to know the target of the rename operation.
At this point, it is not possible. Happens only when the upper
directory is monitored. */
if (kev.fflags & NOTE_RENAME)
actions = Fcons (Qrename, actions);
/* Create the event. */
if (! NILP (actions))
kqueue_generate_event (watch_object, actions, file, Qnil);
/* Cancel monitor if file or directory is deleted or renamed. */
if (kev.fflags & (NOTE_DELETE | NOTE_RENAME))
Fkqueue_rm_watch (descriptor);
}
return;
}
static void
gui_item_children_to_widget_values(Lisp_Object gui_object_instance,
Lisp_Object items, widget_value * parent,
int accel_p)
{
widget_value *wv = 0, *prev = 0;
Lisp_Object rest;
CHECK_CONS(items);
/* first one is master */
prev = gui_items_to_widget_values_1(gui_object_instance, XCAR(items),
parent, 0, accel_p);
/* the rest are the children */
LIST_LOOP(rest, XCDR(items)) {
Lisp_Object tab = XCAR(rest);
wv = gui_items_to_widget_values_1(gui_object_instance, tab, 0,
prev, accel_p);
prev = wv;
}
static bool
is_simple_dialog (Lisp_Object contents)
{
Lisp_Object options;
Lisp_Object name, yes, no, other;
if (!CONSP (contents))
return false;
options = XCDR (contents);
yes = build_string ("Yes");
no = build_string ("No");
if (!CONSP (options))
return false;
name = XCAR (options);
if (!CONSP (name))
return false;
name = XCAR (name);
if (!NILP (Fstring_equal (name, yes)))
other = no;
else if (!NILP (Fstring_equal (name, no)))
other = yes;
else
return false;
options = XCDR (options);
if (!CONSP (options))
return false;
name = XCAR (options);
if (!CONSP (name))
return false;
name = XCAR (name);
if (NILP (Fstring_equal (name, other)))
return false;
/* Check there are no more options. */
options = XCDR (options);
return !(CONSP (options));
}
static void
store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* Use EMACS_INT because we get offset from pointer subtraction. */
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
}
}
static cons_t* merge_cons(cons_t *A, cons_t *B, cmp_fun cmp){
cons_t *ret = NULL;
while(A && B){
if(cmp(XCAR(A),XCAR(B))){
ret = make_cons(XCAR(A), ret);
A = XCDR(A);
} else {
ret = make_cons(XCDR(B), ret);
B = XCDR(B);
}
}
//Only one of these loops will run
while(A){
ret = make_cons(XCAR(A), ret);
}
while(B){
ret = make_cons(XCAR(B), ret);
}
}
static void
single_keymap_panes (Lisp_Object keymap, Lisp_Object pane_name,
Lisp_Object prefix, int maxdepth)
{
struct skp skp;
struct gcpro gcpro1;
skp.pending_maps = Qnil;
skp.maxdepth = maxdepth;
skp.notbuttons = 0;
if (maxdepth <= 0)
return;
push_menu_pane (pane_name, prefix);
if (!have_boxes ())
{
/* Remember index for first item in this pane so we can go back
and add a prefix when (if) we see the first button. After
that, notbuttons is set to 0, to mark that we have seen a
button and all non button items need a prefix. */
skp.notbuttons = menu_items_used;
}
GCPRO1 (skp.pending_maps);
map_keymap_canonical (keymap, single_menu_item, Qnil, &skp);
UNGCPRO;
/* Process now any submenus which want to be panes at this level. */
while (CONSP (skp.pending_maps))
{
Lisp_Object elt, eltcdr, string;
elt = XCAR (skp.pending_maps);
eltcdr = XCDR (elt);
string = XCAR (eltcdr);
/* We no longer discard the @ from the beginning of the string here.
Instead, we do this in *menu_show. */
single_keymap_panes (Fcar (elt), string, XCDR (eltcdr), maxdepth - 1);
skp.pending_maps = XCDR (skp.pending_maps);
}
}
