Mercurial > hg > xemacs-beta
diff src/gui-x.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | 501cfd01ee6d |
children | 41dbb7a9d5f2 |
line wrap: on
line diff
--- a/src/gui-x.c Mon Aug 13 11:19:22 2007 +0200 +++ b/src/gui-x.c Mon Aug 13 11:20:41 2007 +0200 @@ -33,14 +33,13 @@ #include "gui-x.h" #include "buffer.h" #include "device.h" -#include "events.h" #include "frame.h" #include "gui.h" -#include "glyphs.h" -#include "redisplay.h" #include "opaque.h" +#ifdef HAVE_POPUPS Lisp_Object Qmenu_no_selection_hook; +#endif /* we need a unique id for each popup menu, dialog box, and scrollbar */ static unsigned int lwlib_id_tick; @@ -60,26 +59,36 @@ } +#ifdef HAVE_POPUPS + +struct mark_widget_value_closure +{ + void (*markobj) (Lisp_Object); +}; + static int mark_widget_value_mapper (widget_value *val, void *closure) { Lisp_Object markee; + + struct mark_widget_value_closure *cl = + (struct mark_widget_value_closure *) closure; if (val->call_data) { VOID_TO_LISP (markee, val->call_data); - mark_object (markee); + (cl->markobj) (markee); } if (val->accel) { VOID_TO_LISP (markee, val->accel); - mark_object (markee); + (cl->markobj) (markee); } return 0; } static Lisp_Object -mark_popup_data (Lisp_Object obj) +mark_popup_data (Lisp_Object obj, void (*markobj) (Lisp_Object)) { struct popup_data *data = (struct popup_data *) XPOPUP_DATA (obj); @@ -87,14 +96,19 @@ call-data */ if (data->id) - lw_map_widget_values (data->id, mark_widget_value_mapper, 0); + { + struct mark_widget_value_closure closure; + + closure.markobj = markobj; + lw_map_widget_values (data->id, mark_widget_value_mapper, &closure); + } return data->last_menubar_buffer; } DEFINE_LRECORD_IMPLEMENTATION ("popup-data", popup_data, mark_popup_data, internal_object_printer, - 0, 0, 0, 0, struct popup_data); + 0, 0, 0, struct popup_data); /* This is like FRAME_MENUBAR_DATA (f), but contains an alist of (id . popup-data) for GCPRO'ing the callbacks of the popup menus @@ -145,7 +159,7 @@ widget_value *wv = (widget_value *) get_opaque_ptr (closure); free_opaque_ptr (closure); if (wv) - free_widget_value_tree (wv); + free_widget_value (wv); return Qnil; } @@ -188,7 +202,6 @@ if (! wv) return; if (wv->key) xfree (wv->key); if (wv->value) xfree (wv->value); - if (wv->name) xfree (wv->name); wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; @@ -212,9 +225,9 @@ popup_selection_callback (Widget widget, LWLIB_ID ignored_id, XtPointer client_data) { - Lisp_Object data, image_instance, callback, callback_ex; - Lisp_Object frame, event; - int update_subwindows_p = 0; + Lisp_Object fn, arg; + Lisp_Object data; + Lisp_Object frame; struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_widget_or_parent_to_frame (d, widget); @@ -242,45 +255,11 @@ if (((EMACS_INT) client_data) == -1) { - event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = frame; - XEVENT (event)->event.eval.function = Qrun_hooks; - XEVENT (event)->event.eval.object = Qmenu_no_selection_hook; + fn = Qrun_hooks; + arg = Qmenu_no_selection_hook; } else - { - image_instance = XCAR (data); - callback = XCAR (XCDR (data)); - callback_ex = XCDR (XCDR (data)); - update_subwindows_p = 1; - - if (!NILP (callback_ex) && !UNBOUNDP (callback_ex)) - { - event = Fmake_event (Qnil, Qnil); - - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = frame; - XEVENT (event)->event.eval.function = Qeval; - XEVENT (event)->event.eval.object = - list4 (Qfuncall, callback_ex, image_instance, event); - } - else if (NILP (callback) || UNBOUNDP (callback)) - event = Qnil; - else - { - Lisp_Object fn, arg; - - event = Fmake_event (Qnil, Qnil); - - get_gui_callback (callback, &fn, &arg); - XEVENT (event)->event_type = misc_user_event; - XEVENT (event)->channel = frame; - XEVENT (event)->event.eval.function = fn; - XEVENT (event)->event.eval.object = arg; - } - } + get_gui_callback (data, &fn, &arg); /* This is the timestamp used for asserting focus so we need to get an up-to-date value event if no events has been dispatched to emacs @@ -290,12 +269,7 @@ #else DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); #endif - if (!NILP (event)) - enqueue_Xt_dispatch_event (event); - /* The result of this evaluation could cause other instances to change so - enqueue an update callback to check this. */ - if (update_subwindows_p && !NILP (event)) - enqueue_magic_eval_event (update_widget_instances, frame); + signal_special_Xt_user_event (frame, fn, arg); } #if 1 @@ -313,9 +287,9 @@ #endif char * -menu_separator_style (const char *s) +menu_separator_style (CONST char *s) { - const char *p; + CONST char *p; char first; if (!s || s[0] == '\0') @@ -341,133 +315,180 @@ return NULL; } -char * -strdup_and_add_accel (char *name) -{ - int i; - int found_accel = 0; +/* set menu accelerator key to first underlined character in menu name */ - for (i=0; name[i]; ++i) - if (name[i] == '%' && name[i+1] == '_') - { - found_accel = 1; - break; - } - - if (found_accel) - return xstrdup (name); - else - { - char *chars = (char *) alloca (strlen (name) + 3); - chars[0] = '%'; - chars[1] = '_'; - memcpy (chars+2, name, strlen (name) + 1); - return xstrdup (chars); +Lisp_Object +menu_name_to_accelerator (char *name) +{ + while (*name) { + if (*name=='%') { + ++name; + if (!(*name)) + return Qnil; + if (*name=='_' && *(name+1)) + { + int accelerator = (int) (unsigned char) (*(name+1)); + return make_char (tolower (accelerator)); + } } + ++name; + } + return Qnil; } /* This does the dirty work. gc_currently_forbidden is 1 when this is called. */ + int -button_item_to_widget_value (Lisp_Object gui_object_instance, - Lisp_Object gui_item, widget_value *wv, - int allow_text_field_p, int no_keys_p, - int menu_entry_p) +button_item_to_widget_value (Lisp_Object desc, widget_value *wv, + int allow_text_field_p, int no_keys_p) { /* !!#### This function has not been Mule-ized */ /* This function cannot GC because gc_currently_forbidden is set when it's called */ - Lisp_Gui_Item* pgui = 0; + Lisp_Object name = Qnil; + Lisp_Object callback = Qnil; + Lisp_Object suffix = Qnil; + Lisp_Object active_p = Qt; + Lisp_Object include_p = Qt; + Lisp_Object selected_p = Qnil; + Lisp_Object keys = Qnil; + Lisp_Object style = Qnil; + Lisp_Object config_tag = Qnil; + Lisp_Object accel = Qnil; + int length = XVECTOR_LENGTH (desc); + Lisp_Object *contents = XVECTOR_DATA (desc); + int plist_p; + int selected_spec = 0, included_spec = 0; + + if (length < 2) + signal_simple_error ("Button descriptors must be at least 2 long", desc); - /* degenerate case */ - if (STRINGP (gui_item)) + /* length 2: [ "name" callback ] + length 3: [ "name" callback active-p ] + length 4: [ "name" callback active-p suffix ] + or [ "name" callback keyword value ] + length 5+: [ "name" callback [ keyword value ]+ ] + */ + plist_p = (length >= 5 || (length > 2 && KEYWORDP (contents [2]))); + + if (!plist_p && length > 2) + /* the old way */ + { + name = contents [0]; + callback = contents [1]; + active_p = contents [2]; + if (length == 4) + suffix = contents [3]; + } + else { - wv->type = TEXT_TYPE; - wv->name = (char *) XSTRING_DATA (gui_item); - wv->name = strdup_and_add_accel (wv->name); - return 1; + /* the new way */ + int i; + if (length & 1) + signal_simple_error ( + "Button descriptor has an odd number of keywords and values", + desc); + + name = contents [0]; + callback = contents [1]; + for (i = 2; i < length;) + { + Lisp_Object key = contents [i++]; + Lisp_Object val = contents [i++]; + if (!KEYWORDP (key)) + signal_simple_error_2 ("Not a keyword", key, desc); + + if (EQ (key, Q_active)) active_p = val; + else if (EQ (key, Q_suffix)) suffix = val; + else if (EQ (key, Q_keys)) keys = val; + else if (EQ (key, Q_style)) style = val; + else if (EQ (key, Q_selected)) selected_p = val, selected_spec = 1; + else if (EQ (key, Q_included)) include_p = val, included_spec = 1; + else if (EQ (key, Q_config)) config_tag = val; + else if (EQ (key, Q_accelerator)) + { + if ( SYMBOLP (val) + || CHARP (val)) + accel = val; + else + signal_simple_error ("Bad keyboard accelerator", val); + } + else if (EQ (key, Q_filter)) + signal_simple_error(":filter keyword not permitted on leaf nodes", desc); + else + signal_simple_error_2 ("Unknown menu item keyword", key, desc); + } } - else if (!GUI_ITEMP (gui_item)) - signal_simple_error("need a string or a gui_item here", gui_item); - - pgui = XGUI_ITEM (gui_item); - - if (!NILP (pgui->filter)) - signal_simple_error(":filter keyword not permitted on leaf nodes", gui_item); #ifdef HAVE_MENUBARS - if (menu_entry_p && !gui_item_included_p (gui_item, Vmenubar_configuration)) + if ((!NILP (config_tag) && NILP (Fmemq (config_tag, Vmenubar_configuration))) + || (included_spec && NILP (Feval (include_p)))) { /* the include specification says to ignore this item. */ return 0; } #endif /* HAVE_MENUBARS */ - if (!STRINGP (pgui->name)) - pgui->name = Feval (pgui->name); + CHECK_STRING (name); + wv->name = (char *) XSTRING_DATA (name); - CHECK_STRING (pgui->name); - wv->name = (char *) XSTRING_DATA (pgui->name); - wv->name = xstrdup (wv->name); - wv->accel = LISP_TO_VOID (gui_item_accelerator (gui_item)); + if (NILP (accel)) + accel = menu_name_to_accelerator (wv->name); + wv->accel = LISP_TO_VOID (accel); - if (!NILP (pgui->suffix)) + if (!NILP (suffix)) { - const char *const_bogosity; + CONST char *const_bogosity; Lisp_Object suffix2; /* Shortcut to avoid evaluating suffix each time */ - if (STRINGP (pgui->suffix)) - suffix2 = pgui->suffix; + if (STRINGP (suffix)) + suffix2 = suffix; else { - suffix2 = Feval (pgui->suffix); + suffix2 = Feval (suffix); CHECK_STRING (suffix2); } - TO_EXTERNAL_FORMAT (LISP_STRING, suffix2, - C_STRING_ALLOCA, const_bogosity, - Qfile_name); + GET_C_STRING_FILENAME_DATA_ALLOCA (suffix2, const_bogosity); wv->value = (char *) const_bogosity; wv->value = xstrdup (wv->value); } - wv_set_evalable_slot (wv->enabled, pgui->active); - wv_set_evalable_slot (wv->selected, pgui->selected); + wv_set_evalable_slot (wv->enabled, active_p); + wv_set_evalable_slot (wv->selected, selected_p); - if (!NILP (pgui->callback) || !NILP (pgui->callback_ex)) - wv->call_data = LISP_TO_VOID (cons3 (gui_object_instance, - pgui->callback, - pgui->callback_ex)); + wv->call_data = LISP_TO_VOID (callback); if (no_keys_p #ifdef HAVE_MENUBARS - || (menu_entry_p && !menubar_show_keybindings) + || !menubar_show_keybindings #endif ) wv->key = 0; - else if (!NILP (pgui->keys)) /* Use this string to generate key bindings */ + else if (!NILP (keys)) /* Use this string to generate key bindings */ { - CHECK_STRING (pgui->keys); - pgui->keys = Fsubstitute_command_keys (pgui->keys); - if (XSTRING_LENGTH (pgui->keys) > 0) - wv->key = xstrdup ((char *) XSTRING_DATA (pgui->keys)); + CHECK_STRING (keys); + keys = Fsubstitute_command_keys (keys); + if (XSTRING_LENGTH (keys) > 0) + wv->key = xstrdup ((char *) XSTRING_DATA (keys)); else wv->key = 0; } - else if (SYMBOLP (pgui->callback)) /* Show the binding of this command. */ + else if (SYMBOLP (callback)) /* Show the binding of this command. */ { - char buf[1024]; /* #### */ + char buf [1024]; /* #### Warning, dependency here on current_buffer and point */ - where_is_to_char (pgui->callback, buf); + where_is_to_char (callback, buf); if (buf [0]) wv->key = xstrdup (buf); else wv->key = 0; } - CHECK_SYMBOL (pgui->style); - if (NILP (pgui->style)) + CHECK_SYMBOL (style); + if (NILP (style)) { /* If the callback is nil, treat this item like unselectable text. This way, dashes will show up as a separator. */ @@ -494,13 +515,13 @@ wv->type = BUTTON_TYPE; } } - else if (EQ (pgui->style, Qbutton)) + else if (EQ (style, Qbutton)) wv->type = BUTTON_TYPE; - else if (EQ (pgui->style, Qtoggle)) + else if (EQ (style, Qtoggle)) wv->type = TOGGLE_TYPE; - else if (EQ (pgui->style, Qradio)) + else if (EQ (style, Qradio)) wv->type = RADIO_TYPE; - else if (EQ (pgui->style, Qtext)) + else if (EQ (style, Qtext)) { wv->type = TEXT_TYPE; #if 0 @@ -509,132 +530,19 @@ #endif } else - signal_simple_error_2 ("Unknown style", pgui->style, gui_item); + signal_simple_error_2 ("Unknown style", style, desc); if (!allow_text_field_p && (wv->type == TEXT_TYPE)) - signal_simple_error ("Text field not allowed in this context", gui_item); + signal_simple_error ("Text field not allowed in this context", desc); - if (!NILP (pgui->selected) && EQ (pgui->style, Qtext)) + if (selected_spec && EQ (style, Qtext)) signal_simple_error ( - ":selected only makes sense with :style toggle, radio or button", - gui_item); + ":selected only makes sense with :style toggle, radio or button", + desc); return 1; } -/* parse tree's of gui items into widget_value hierarchies */ -static void gui_item_children_to_widget_values (Lisp_Object gui_object_instance, - Lisp_Object items, - widget_value* parent); - -static widget_value * -gui_items_to_widget_values_1 (Lisp_Object gui_object_instance, - Lisp_Object items, widget_value* parent, - widget_value* prev) -{ - 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)) - { - 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))) - signal_simple_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); - else - wv = gui_items_to_widget_values_1 (gui_object_instance, - XCAR (items), 0, prev); - /* the rest are the children */ - gui_item_children_to_widget_values (gui_object_instance, - XCDR (items), wv); - } - return wv; -} - -static void -gui_item_children_to_widget_values (Lisp_Object gui_object_instance, - Lisp_Object items, widget_value* parent) -{ - 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); - /* 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); - prev = wv; - } -} - -widget_value * -gui_items_to_widget_values (Lisp_Object gui_object_instance, Lisp_Object items) -{ - /* !!#### This function has not been Mule-ized */ - /* This function can GC */ - widget_value *control = 0, *tmp = 0; - int count = specpdl_depth (); - Lisp_Object wv_closure; - - if (NILP (items)) - signal_simple_error ("must have some items", items); - - /* Inhibit GC during this conversion. The reasons for this are - the same as in menu_item_descriptor_to_widget_value(); see - the large comment above that function. */ - record_unwind_protect (restore_gc_inhibit, - make_int (gc_currently_forbidden)); - gc_currently_forbidden = 1; - - /* Also make sure that we free the partially-created widget_value - tree on Lisp error. */ - control = xmalloc_widget_value(); - wv_closure = make_opaque_ptr (control); - record_unwind_protect (widget_value_unwind, wv_closure); - - gui_items_to_widget_values_1 (gui_object_instance, items, control, 0); - - /* mess about getting the data we really want */ - tmp = control; - control = control->contents; - tmp->next = 0; - tmp->contents = 0; - free_widget_value_tree (tmp); - - /* No more need to free the half-filled-in structures. */ - set_opaque_ptr (wv_closure, 0); - unbind_to (count, Qnil); - - return control; -} +#endif /* HAVE_POPUPS */ /* This is a kludge to make sure emacs can only link against a version of lwlib that was compiled in the right way. Emacs references symbols which @@ -685,11 +593,6 @@ #elif defined (HAVE_DIALOGS) MACROLET (lwlib_dialogs_athena); #endif -#ifdef LWLIB_WIDGETS_MOTIF - MACROLET (lwlib_widgets_motif); -#elif defined (HAVE_WIDGETS) - MACROLET (lwlib_widgets_athena); -#endif #undef MACROLET } @@ -697,27 +600,18 @@ void syms_of_gui_x (void) { - INIT_LRECORD_IMPLEMENTATION (popup_data); - +#ifdef HAVE_POPUPS defsymbol (&Qmenu_no_selection_hook, "menu-no-selection-hook"); -} - -void -reinit_vars_of_gui_x (void) -{ - lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ -#ifdef HAVE_POPUPS - popup_up_p = 0; #endif - - /* this makes only safe calls as in emacs.c */ - sanity_check_lwlib (); } void vars_of_gui_x (void) { - reinit_vars_of_gui_x (); + lwlib_id_tick = (1<<16); /* start big, to not conflict with Energize */ + +#ifdef HAVE_POPUPS + popup_up_p = 0; Vpopup_callbacks = Qnil; staticpro (&Vpopup_callbacks); @@ -731,4 +625,8 @@ */ ); #endif Fset (Qmenu_no_selection_hook, Qnil); +#endif /* HAVE_POPUPS */ + + /* this makes only safe calls as in emacs.c */ + sanity_check_lwlib (); }