Lisp_Object
menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item)
{
Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
/* Menu descriptor should be a list */
CHECK_CONS (desc);
/* First element may be menu name, although can be omitted.
Let's think that if stuff begins with anything than a keyword
or a list (submenu), this is a menu name, expected to be a string */
if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc)))
{
CHECK_STRING (XCAR (desc));
pgui_item->name = XCAR (desc);
desc = XCDR (desc);
if (!NILP (desc))
CHECK_CONS (desc);
}
/* Walk along all key-value pairs */
while (!NILP(desc) && KEYWORDP (XCAR (desc)))
{
Lisp_Object key, val;
key = XCAR (desc);
desc = XCDR (desc);
CHECK_CONS (desc);
val = XCAR (desc);
desc = XCDR (desc);
if (!NILP (desc))
CHECK_CONS (desc);
gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME);
}
/* Return the rest - supposed to be a list of items */
return desc;
}
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;
}
/* Push all the panes and items of a menu described by the
alist-of-alists MENU.
This handles old-fashioned calls to x-popup-menu. */
void
list_of_panes (Lisp_Object menu)
{
Lisp_Object tail;
init_menu_items ();
for (tail = menu; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt, pane_name, pane_data;
elt = XCAR (tail);
pane_name = Fcar (elt);
CHECK_STRING (pane_name);
push_menu_pane (encode_menu_string (pane_name), Qnil);
pane_data = Fcdr (elt);
CHECK_CONS (pane_data);
list_of_items (pane_data);
}
finish_menu_items ();
}
EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
{
/* Host */
if (EQ (keyword, Qhost))
{
CHECK_STRING (value);
ldap_host = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_host, (char *)XSTRING_DATA (value));
}
/* Filter */
else if (EQ (keyword, Qfilter))
{
CHECK_STRING (value);
ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_filter, (char *)XSTRING_DATA (value));
}
/* Attributes */
else if (EQ (keyword, Qattributes))
{
if (! NILP (value))
{
Lisp_Object attr_left = value;
struct gcpro ngcpro1;
NGCPRO1 (attr_left);
CHECK_CONS (value);
ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
for (i=0; !NILP (attr_left); i++) {
CHECK_STRING (XCAR (attr_left));
ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
strcpy(ldap_attributes[i],
(char *)(XSTRING_DATA( XCAR (attr_left))));
attr_left = XCDR (attr_left);
}
ldap_attributes[i] = NULL;
NUNGCPRO;
}
}
/* Attributes Only */
else if (EQ (keyword, Qattrsonly))
{
CHECK_SYMBOL (value);
ldap_attrsonly = NILP (value) ? 0 : 1;
}
/* Base */
else if (EQ (keyword, Qbase))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_base = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_base, (char *)XSTRING_DATA (value));
}
}
/* Scope */
else if (EQ (keyword, Qscope))
{
CHECK_SYMBOL (value);
if (EQ (value, Qbase))
ldap_scope = LDAP_SCOPE_BASE;
else if (EQ (value, Qonelevel))
ldap_scope = LDAP_SCOPE_ONELEVEL;
else if (EQ (value, Qsubtree))
ldap_scope = LDAP_SCOPE_SUBTREE;
else
signal_simple_error ("Invalid scope", value);
}
/* Authentication method */
else if (EQ (keyword, Qauth))
{
CHECK_SYMBOL (value);
if (EQ (value, Qsimple))
ldap_auth = LDAP_AUTH_SIMPLE;
#ifdef LDAP_AUTH_KRBV41
else if (EQ (value, Qkrbv41))
ldap_auth = LDAP_AUTH_KRBV41;
#endif
#ifdef LDAP_AUTH_KRBV42
else if (EQ (value, Qkrbv42))
ldap_auth = LDAP_AUTH_KRBV42;
#endif
else
signal_simple_error ("Invalid authentication method", value);
}
/* Bind DN */
else if (EQ (keyword, Qbinddn))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
}
}
/* Password */
else if (EQ (keyword, Qpasswd))
{
if (!NILP (value))
{
CHECK_STRING (value);
ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
}
}
/* Deref */
else if (EQ (keyword, Qderef))
{
CHECK_SYMBOL (value);
if (EQ (value, Qnever))
ldap_deref = LDAP_DEREF_NEVER;
else if (EQ (value, Qsearch))
ldap_deref = LDAP_DEREF_SEARCHING;
else if (EQ (value, Qfind))
ldap_deref = LDAP_DEREF_FINDING;
else if (EQ (value, Qalways))
ldap_deref = LDAP_DEREF_ALWAYS;
else
signal_simple_error ("Invalid deref value", value);
}
/* Timelimit */
else if (EQ (keyword, Qtimelimit))
{
if (!NILP (value))
{
CHECK_INT (value);
ldap_timelimit = XINT (value);
}
}
/* Sizelimit */
else if (EQ (keyword, Qsizelimit))
{
if (!NILP (value))
{
CHECK_INT (value);
ldap_sizelimit = XINT (value);
}
}
}
static json_t *
lisp_to_json_toplevel_1 (Lisp_Object lisp)
{
json_t *json;
ptrdiff_t count;
if (VECTORP (lisp))
{
ptrdiff_t size = ASIZE (lisp);
json = json_check (json_array ());
count = SPECPDL_INDEX ();
record_unwind_protect_ptr (json_release_object, json);
for (ptrdiff_t i = 0; i < size; ++i)
{
int status
= json_array_append_new (json, lisp_to_json (AREF (lisp, i)));
if (status == -1)
json_out_of_memory ();
}
eassert (json_array_size (json) == size);
}
else if (HASH_TABLE_P (lisp))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (lisp);
json = json_check (json_object ());
count = SPECPDL_INDEX ();
record_unwind_protect_ptr (json_release_object, json);
for (ptrdiff_t i = 0; i < HASH_TABLE_SIZE (h); ++i)
if (!NILP (HASH_HASH (h, i)))
{
Lisp_Object key = json_encode (HASH_KEY (h, i));
/* We can't specify the length, so the string must be
null-terminated. */
check_string_without_embedded_nulls (key);
const char *key_str = SSDATA (key);
/* Reject duplicate keys. These are possible if the hash
table test is not `equal'. */
if (json_object_get (json, key_str) != NULL)
wrong_type_argument (Qjson_value_p, lisp);
int status = json_object_set_new (json, key_str,
lisp_to_json (HASH_VALUE (h, i)));
if (status == -1)
{
/* A failure can be caused either by an invalid key or
by low memory. */
json_check_utf8 (key);
json_out_of_memory ();
}
}
}
else if (NILP (lisp))
return json_check (json_object ());
else if (CONSP (lisp))
{
Lisp_Object tail = lisp;
json = json_check (json_object ());
count = SPECPDL_INDEX ();
record_unwind_protect_ptr (json_release_object, json);
bool is_plist = !CONSP (XCAR (tail));
FOR_EACH_TAIL (tail)
{
const char *key_str;
Lisp_Object value;
Lisp_Object key_symbol;
if (is_plist)
{
key_symbol = XCAR (tail);
tail = XCDR (tail);
CHECK_CONS (tail);
value = XCAR (tail);
if (EQ (tail, li.tortoise)) circular_list (lisp);
}
else
{
Lisp_Object pair = XCAR (tail);
CHECK_CONS (pair);
key_symbol = XCAR (pair);
value = XCDR (pair);
}
CHECK_SYMBOL (key_symbol);
Lisp_Object key = SYMBOL_NAME (key_symbol);
/* We can't specify the length, so the string must be
null-terminated. */
check_string_without_embedded_nulls (key);
key_str = SSDATA (key);
/* In plists, ensure leading ":" in keys is stripped. It
will be reconstructed later in `json_to_lisp'.*/
if (is_plist && ':' == key_str[0] && key_str[1])
{
key_str = &key_str[1];
}
/* Only add element if key is not already present. */
if (json_object_get (json, key_str) == NULL)
{
int status
= json_object_set_new (json, key_str, lisp_to_json (value));
if (status == -1)
json_out_of_memory ();
}
}
CHECK_LIST_END (tail, lisp);
}
else
