X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fgui.c;h=a83688ca4014f49e77d2e59995538332c6ad563f;hb=b5eeb6918c29470b36f8461c402eb0c65cb19bd2;hp=4824420ca3fee928a8a83f8a65a2c473d4225886;hpb=1e7fd761ecf5fd2208bde8e30fc6f7cbf789b7db;p=chise%2Fxemacs-chise.git.1 diff --git a/src/gui.c b/src/gui.c index 4824420..a83688c 100644 --- a/src/gui.c +++ b/src/gui.c @@ -34,6 +34,8 @@ Lisp_Object Q_filter, Q_config, Q_included, Q_key_sequence; Lisp_Object Q_accelerator, Q_label, Q_callback; Lisp_Object Qtoggle, Qradio; +static Lisp_Object parse_gui_item_tree_list (Lisp_Object list); + #ifdef HAVE_POPUPS /* count of menus/dboxes currently up */ @@ -74,7 +76,7 @@ get_gui_callback (Lisp_Object data, Lisp_Object *fn, Lisp_Object *arg) if (SYMBOLP (data) || (COMPILED_FUNCTIONP (data) && XCOMPILED_FUNCTION (data)->flags.interactivep) - || (EQ (XCAR (data), Qlambda) + || (CONSP (data) && (EQ (XCAR (data), Qlambda)) && !NILP (Fassq (Qinteractive, Fcdr (Fcdr (data)))))) { *fn = Qcall_interactively; @@ -152,7 +154,7 @@ gui_item_init (Lisp_Object gui_item) } Lisp_Object -allocate_gui_item () +allocate_gui_item (void) { struct Lisp_Gui_Item *lp = alloc_lcrecord_type (struct Lisp_Gui_Item, &lrecord_gui_item); @@ -381,6 +383,7 @@ unsigned int gui_item_display_flush_left (Lisp_Object gui_item, char* buf, Bytecount buf_len) { + /* This function can call lisp */ char *p = buf; Bytecount len; struct Lisp_Gui_Item* pgui_item = XGUI_ITEM (gui_item); @@ -468,22 +471,22 @@ gui_item_display_flush_right (Lisp_Object gui_item, #endif /* HAVE_WINDOW_SYSTEM */ static Lisp_Object -mark_gui_item (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_gui_item (Lisp_Object obj) { struct Lisp_Gui_Item *p = XGUI_ITEM (obj); - markobj (p->name); - markobj (p->callback); - markobj (p->config); - markobj (p->suffix); - markobj (p->active); - markobj (p->included); - markobj (p->config); - markobj (p->filter); - markobj (p->style); - markobj (p->selected); - markobj (p->keys); - markobj (p->accelerator); + mark_object (p->name); + mark_object (p->callback); + mark_object (p->config); + mark_object (p->suffix); + mark_object (p->active); + mark_object (p->included); + mark_object (p->config); + mark_object (p->filter); + mark_object (p->style); + mark_object (p->selected); + mark_object (p->keys); + mark_object (p->accelerator); return Qnil; } @@ -563,6 +566,56 @@ print_gui_item (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) write_c_string (buf, printcharfun); } +/* parse a glyph descriptor into a tree of gui items. + + The gui_item slot of an image instance can be a single item or an + arbitrarily nested hierarchy of item lists. */ + +static Lisp_Object parse_gui_item_tree_item (Lisp_Object entry) +{ + Lisp_Object ret = entry; + if (VECTORP (entry)) + { + ret = gui_parse_item_keywords_no_errors (entry); + } + else if (STRINGP (entry)) + { + CHECK_STRING (entry); + } + else + signal_simple_error ("item must be a vector or a string", entry); + + return ret; +} + +Lisp_Object parse_gui_item_tree_children (Lisp_Object list) +{ + Lisp_Object rest, ret = Qnil; + CHECK_CONS (list); + /* recursively add items to the tree view */ + LIST_LOOP (rest, list) + { + Lisp_Object sub; + if (CONSP (XCAR (rest))) + sub = parse_gui_item_tree_list (XCAR (rest)); + else + sub = parse_gui_item_tree_item (XCAR (rest)); + + ret = Fcons (sub, ret); + } + /* make the order the same as the items we have parsed */ + return Fnreverse (ret); +} + +static Lisp_Object parse_gui_item_tree_list (Lisp_Object list) +{ + Lisp_Object ret; + CHECK_CONS (list); + /* first one can never be a list */ + ret = parse_gui_item_tree_item (XCAR (list)); + return Fcons (ret, parse_gui_item_tree_children (XCDR (list))); +} + DEFINE_LRECORD_IMPLEMENTATION ("gui-item", gui_item, mark_gui_item, print_gui_item, 0, gui_item_equal,