Mercurial > hg > xemacs-beta
diff src/menubar-x.c @ 428:3ecd8885ac67 r21-2-22
Import from CVS: tag r21-2-22
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:28:15 +0200 |
parents | |
children | 080151679be2 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/menubar-x.c Mon Aug 13 11:28:15 2007 +0200 @@ -0,0 +1,881 @@ +/* Implements an elisp-programmable menubar -- X interface. + Copyright (C) 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1995 Tinker Systems and INS Engineering Corp. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* created 16-dec-91 by jwz */ + +#include <config.h> +#include "lisp.h" + +#include "console-x.h" +#include "EmacsFrame.h" +#include "gui-x.h" + +#include "buffer.h" +#include "commands.h" /* zmacs_regions */ +#include "gui.h" +#include "events.h" +#include "frame.h" +#include "opaque.h" +#include "window.h" + +static int set_frame_menubar (struct frame *f, + int deep_p, + int first_time_p); + +#define FRAME_MENUBAR_DATA(frame) ((frame)->menubar_data) +#define XFRAME_MENUBAR_DATA(frame) XPOPUP_DATA ((frame)->menubar_data) + +#define MENUBAR_TYPE 0 +#define SUBMENU_TYPE 1 +#define POPUP_TYPE 2 + + +/* Converting Lisp menu tree descriptions to lwlib's `widget_value' form. + + menu_item_descriptor_to_widget_value() converts a lisp description of a + menubar into a tree of widget_value structures. It allocates widget_values + with malloc_widget_value() and allocates other storage only for the `key' + slot. All other slots are filled with pointers to Lisp_String data. We + allocate a widget_value description of the menu or menubar, and hand it to + lwlib, which then makes a copy of it, which it manages internally. We then + immediately free our widget_value tree; it will not be referenced again. + + Incremental menu construction callbacks operate just a bit differently. + They allocate widget_values and call replace_widget_value_tree() to tell + lwlib to destructively modify the incremental stub (subtree) of its + separate widget_value tree. + + This function is highly recursive (it follows the menu trees) and may call + eval. The reason we keep pointers to lisp string data instead of copying + it and freeing it later is to avoid the speed penalty that would entail + (since this needs to be fast, in the simple cases at least). (The reason + we malloc/free the keys slot is because there's not a lisp string around + for us to use in that case.) + + Since we keep pointers to lisp strings, and we call eval, we could lose if + GC relocates (or frees) those strings. It's not easy to gc protect the + strings because of the recursive nature of this function, and the fact that + it returns a data structure that gets freed later. So... we do the + sleaziest thing possible and inhibit GC for the duration. This is probably + not a big deal... + + We do not have to worry about the pointers to Lisp_String data after + this function successfully finishes. lwlib copies all such data with + strdup(). */ + +static widget_value * +menu_item_descriptor_to_widget_value_1 (Lisp_Object desc, + int menu_type, int deep_p, + int filter_p, + int depth) +{ + /* This function cannot GC. + It is only called from menu_item_descriptor_to_widget_value, which + prohibits GC. */ + /* !!#### This function has not been Mule-ized */ + int menubar_root_p = (menu_type == MENUBAR_TYPE && depth == 0); + widget_value *wv; + Lisp_Object wv_closure; + int count = specpdl_depth (); + int partition_seen = 0; + + wv = xmalloc_widget_value (); + + wv_closure = make_opaque_ptr (wv); + record_unwind_protect (widget_value_unwind, wv_closure); + + if (STRINGP (desc)) + { + char *string_chars = (char *) XSTRING_DATA (desc); + wv->type = (separator_string_p (string_chars) ? SEPARATOR_TYPE : + TEXT_TYPE); +#if 1 + /* #### - should internationalize with X resources instead. + Not so! --ben */ + string_chars = GETTEXT (string_chars); +#endif + if (wv->type == SEPARATOR_TYPE) + { + wv->value = menu_separator_style (string_chars); + } + else + { + wv->name = string_chars; + wv->enabled = 1; + /* dverna Dec. 98: command_builder_operate_menu_accelerator will + manipulate the accel as a Lisp_Object if the widget has a name. + Since simple labels have a name, but no accel, we *must* set it + to nil */ + wv->accel = LISP_TO_VOID (Qnil); + } + } + else if (VECTORP (desc)) + { + Lisp_Object gui_item = gui_parse_item_keywords (desc); + if (!button_item_to_widget_value (gui_item, wv, 1, + (menu_type == MENUBAR_TYPE + && depth <= 1))) + { + /* :included form was nil */ + wv = NULL; + goto menu_item_done; + } + } + else if (CONSP (desc)) + { + Lisp_Object incremental_data = desc; + widget_value *prev = 0; + + if (STRINGP (XCAR (desc))) + { + Lisp_Object key, val; + Lisp_Object include_p = Qnil, hook_fn = Qnil, config_tag = Qnil; + Lisp_Object active_p = Qt; + Lisp_Object accel; + int included_spec = 0; + int active_spec = 0; + wv->type = CASCADE_TYPE; + wv->enabled = 1; + wv->name = (char *) XSTRING_DATA (LISP_GETTEXT (XCAR (desc))); + + accel = gui_name_accelerator (LISP_GETTEXT (XCAR (desc))); + wv->accel = LISP_TO_VOID (accel); + + desc = Fcdr (desc); + + while (key = Fcar (desc), KEYWORDP (key)) + { + Lisp_Object cascade = desc; + desc = Fcdr (desc); + if (NILP (desc)) + signal_simple_error ("Keyword in menu lacks a value", + cascade); + val = Fcar (desc); + desc = Fcdr (desc); + 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_filter)) + hook_fn = val; + else if (EQ (key, Q_active)) + active_p = val, active_spec = 1; + else if (EQ (key, Q_accelerator)) + { + if ( SYMBOLP (val) + || CHARP (val)) + wv->accel = LISP_TO_VOID (val); + else + signal_simple_error ("bad keyboard accelerator", val); + } + else if (EQ (key, Q_label)) + { + /* implement in 21.2 */ + } + else + signal_simple_error ("Unknown menu cascade keyword", cascade); + } + + if ((!NILP (config_tag) + && NILP (Fmemq (config_tag, Vmenubar_configuration))) + || (included_spec && NILP (Feval (include_p)))) + { + wv = NULL; + goto menu_item_done; + } + + if (active_spec) + active_p = Feval (active_p); + + if (!NILP (hook_fn) && !NILP (active_p)) + { +#if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF + if (filter_p || depth == 0) + { +#endif + desc = call1_trapping_errors ("Error in menubar filter", + hook_fn, desc); + if (UNBOUNDP (desc)) + desc = Qnil; +#if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF + } + else + { + widget_value *incr_wv = xmalloc_widget_value (); + wv->contents = incr_wv; + incr_wv->type = INCREMENTAL_TYPE; + incr_wv->enabled = 1; + incr_wv->name = wv->name; + /* This is automatically GC protected through + the call to lw_map_widget_values(); no need + to worry. */ + incr_wv->call_data = LISP_TO_VOID (incremental_data); + goto menu_item_done; + } +#endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ + } + if (menu_type == POPUP_TYPE && popup_menu_titles && depth == 0) + { + /* Simply prepend three more widget values to the contents of + the menu: a label, and two separators (to get a double + line). */ + widget_value *title_wv = xmalloc_widget_value (); + widget_value *sep_wv = xmalloc_widget_value (); + title_wv->type = TEXT_TYPE; + title_wv->name = wv->name; + title_wv->enabled = 1; + title_wv->next = sep_wv; + sep_wv->type = SEPARATOR_TYPE; + sep_wv->value = menu_separator_style ("=="); + sep_wv->next = 0; + + wv->contents = title_wv; + prev = sep_wv; + } + wv->enabled = ! NILP (active_p); + if (deep_p && !wv->enabled && !NILP (desc)) + { + widget_value *dummy; + /* Add a fake entry so the menus show up */ + wv->contents = dummy = xmalloc_widget_value (); + dummy->name = "(inactive)"; + dummy->accel = LISP_TO_VOID (Qnil); + dummy->enabled = 0; + dummy->selected = 0; + dummy->value = NULL; + dummy->type = BUTTON_TYPE; + dummy->call_data = NULL; + dummy->next = NULL; + + goto menu_item_done; + } + + } + else if (menubar_root_p) + { + wv->name = (char *) "menubar"; + wv->type = CASCADE_TYPE; /* Well, nothing else seems to fit and + this is ignored anyway... */ + } + else + { + signal_simple_error ("Menu name (first element) must be a string", + desc); + } + + if (deep_p || menubar_root_p) + { + widget_value *next; + for (; !NILP (desc); desc = Fcdr (desc)) + { + Lisp_Object child = Fcar (desc); + if (menubar_root_p && NILP (child)) /* the partition */ + { + if (partition_seen) + error ( + "More than one partition (nil) in menubar description"); + partition_seen = 1; + next = xmalloc_widget_value (); + next->type = PUSHRIGHT_TYPE; + } + else + { + next = menu_item_descriptor_to_widget_value_1 + (child, menu_type, deep_p, filter_p, depth + 1); + } + if (! next) + continue; + else if (prev) + prev->next = next; + else + wv->contents = next; + prev = next; + } + } + if (deep_p && !wv->contents) + wv = NULL; + } + else if (NILP (desc)) + error ("nil may not appear in menu descriptions"); + else + signal_simple_error ("Unrecognized menu descriptor", desc); + +menu_item_done: + + if (wv) + { + /* Completed normally. Clear out the object that widget_value_unwind() + will be called with to tell it not to free the wv (as we are + returning it.) */ + set_opaque_ptr (wv_closure, 0); + } + + unbind_to (count, Qnil); + return wv; +} + +static widget_value * +menu_item_descriptor_to_widget_value (Lisp_Object desc, + int menu_type, /* if this is a menubar, + popup or sub menu */ + int deep_p, /* */ + int filter_p) /* if :filter forms + should run now */ +{ + widget_value *wv; + int count = specpdl_depth (); + record_unwind_protect (restore_gc_inhibit, + make_int (gc_currently_forbidden)); + gc_currently_forbidden = 1; + /* Can't GC! */ + wv = menu_item_descriptor_to_widget_value_1 (desc, menu_type, deep_p, + filter_p, 0); + unbind_to (count, Qnil); + return wv; +} + + +#if defined LWLIB_MENUBARS_LUCID || defined LWLIB_MENUBARS_MOTIF +int in_menu_callback; + +static Lisp_Object +restore_in_menu_callback (Lisp_Object val) +{ + in_menu_callback = XINT(val); + return Qnil; +} +#endif /* LWLIB_MENUBARS_LUCID || LWLIB_MENUBARS_MOTIF */ + +#if 0 +/* #### Sort of a hack needed to process Vactivate_menubar_hook + correctly wrt buffer-local values. A correct solution would + involve adding a callback mechanism to run_hook(). This function + is currently unused. */ +static int +my_run_hook (Lisp_Object hooksym, int allow_global_p) +{ + /* This function can GC */ + Lisp_Object tail; + Lisp_Object value = Fsymbol_value (hooksym); + int changes = 0; + + if (!NILP (value) && (!CONSP (value) || EQ (XCAR (value), Qlambda))) + return !EQ (call0 (value), Qt); + + EXTERNAL_LIST_LOOP (tail, value) + { + if (allow_global_p && EQ (XCAR (tail), Qt)) + changes |= my_run_hook (Fdefault_value (hooksym), 0); + if (!EQ (call0 (XCAR (tail)), Qt)) + changes = 1; + } + return changes; +} +#endif + + +/* The order in which callbacks are run is funny to say the least. + It's sometimes tricky to avoid running a callback twice, and to + avoid returning prematurely. So, this function returns true + if the menu's callbacks are no longer gc protected. So long + as we unprotect them before allowing other callbacks to run, + everything should be ok. + + The pre_activate_callback() *IS* intentionally called multiple times. + If client_data == NULL, then it's being called before the menu is posted. + If client_data != NULL, then client_data is a (widget_value *) and + client_data->data is a Lisp_Object pointing to a lisp submenu description + that must be converted into widget_values. *client_data is destructively + modified. + + #### Stig thinks that there may be a GC problem here due to the + fact that pre_activate_callback() is called multiple times, but I + think he's wrong. + + */ + +static void +pre_activate_callback (Widget widget, LWLIB_ID id, XtPointer client_data) +{ + /* This function can GC */ + struct device *d = get_device_from_display (XtDisplay (widget)); + struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); + Lisp_Object frame; + int count; + + /* set in lwlib to the time stamp associated with the most recent menu + operation */ + extern Time x_focus_timestamp_really_sucks_fix_me_better; + + if (!f) + f = x_any_window_to_frame (d, XtWindow (XtParent (widget))); + if (!f) + return; + + /* make sure f is the selected frame */ + XSETFRAME (frame, f); + Fselect_frame (frame); + + if (client_data) + { + /* this is an incremental menu construction callback */ + widget_value *hack_wv = (widget_value *) client_data; + Lisp_Object submenu_desc; + widget_value *wv; + + assert (hack_wv->type == INCREMENTAL_TYPE); + VOID_TO_LISP (submenu_desc, hack_wv->call_data); + + /* + * #### Fix the menu code so this isn't necessary. + * + * Protect against reentering the menu code otherwise we will + * crash later when the code gets confused at the state + * changes. + */ + count = specpdl_depth (); + record_unwind_protect (restore_in_menu_callback, + make_int (in_menu_callback)); + in_menu_callback = 1; + wv = menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, + 1, 0); + unbind_to (count, Qnil); + + if (!wv) + { + wv = xmalloc_widget_value (); + wv->type = CASCADE_TYPE; + wv->next = NULL; + wv->accel = LISP_TO_VOID (Qnil); + wv->contents = xmalloc_widget_value (); + wv->contents->type = TEXT_TYPE; + wv->contents->name = (char *) "No menu"; + wv->contents->next = NULL; + wv->contents->accel = LISP_TO_VOID (Qnil); + } + assert (wv && wv->type == CASCADE_TYPE && wv->contents); + replace_widget_value_tree (hack_wv, wv->contents); + free_popup_widget_value_tree (wv); + } + else if (!POPUP_DATAP (FRAME_MENUBAR_DATA (f))) + return; + else + { +#if 0 /* Unused, see comment below. */ + int any_changes; + + /* #### - this menubar update mechanism is expensively anti-social and + the activate-menubar-hook is now mostly obsolete. */ + any_changes = my_run_hook (Qactivate_menubar_hook, 1); + + /* #### - It is necessary to *ALWAYS* call set_frame_menubar() now that + incremental menus are implemented. If a subtree of a menu has been + updated incrementally (a destructive operation), then that subtree + must somehow be wiped. + + It is difficult to undo the destructive operation in lwlib because + a pointer back to lisp data needs to be hidden away somewhere. So + that an INCREMENTAL_TYPE widget_value can be recreated... Hmmmmm. */ + if (any_changes || + !XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date) + set_frame_menubar (f, 1, 0); +#else + run_hook (Qactivate_menubar_hook); + set_frame_menubar (f, 1, 0); +#endif + DEVICE_X_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = + DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (XDEVICE (FRAME_DEVICE (f))) = + x_focus_timestamp_really_sucks_fix_me_better; + } +} + +static widget_value * +compute_menubar_data (struct frame *f, Lisp_Object menubar, int deep_p) +{ + widget_value *data; + + if (NILP (menubar)) + data = 0; + else + { + Lisp_Object old_buffer; + int count = specpdl_depth (); + + old_buffer = Fcurrent_buffer (); + record_unwind_protect (Fset_buffer, old_buffer); + Fset_buffer ( XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer); + data = menu_item_descriptor_to_widget_value (menubar, MENUBAR_TYPE, + deep_p, 0); + Fset_buffer (old_buffer); + unbind_to (count, Qnil); + } + return data; +} + +static int +set_frame_menubar (struct frame *f, int deep_p, int first_time_p) +{ + widget_value *data; + Lisp_Object menubar; + int menubar_visible; + long id; + /* As for the toolbar, the minibuffer does not have its own menubar. */ + struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); + + if (! FRAME_X_P (f)) + return 0; + + /***** first compute the contents of the menubar *****/ + + if (! first_time_p) + { + /* evaluate `current-menubar' in the buffer of the selected window + of the frame in question. */ + menubar = symbol_value_in_buffer (Qcurrent_menubar, w->buffer); + } + else + { + /* That's a little tricky the first time since the frame isn't + fully initialized yet. */ + menubar = Fsymbol_value (Qcurrent_menubar); + } + + if (NILP (menubar)) + { + menubar = Vblank_menubar; + menubar_visible = 0; + } + else + menubar_visible = !NILP (w->menubar_visible_p); + + data = compute_menubar_data (f, menubar, deep_p); + if (!data || (!data->next && !data->contents)) + abort (); + + if (NILP (FRAME_MENUBAR_DATA (f))) + { + struct popup_data *mdata = + alloc_lcrecord_type (struct popup_data, &lrecord_popup_data); + + mdata->id = new_lwlib_id (); + mdata->last_menubar_buffer = Qnil; + mdata->menubar_contents_up_to_date = 0; + XSETPOPUP_DATA (FRAME_MENUBAR_DATA (f), mdata); + } + + /***** now store into the menubar widget, creating it if necessary *****/ + + id = XFRAME_MENUBAR_DATA (f)->id; + if (!FRAME_X_MENUBAR_WIDGET (f)) + { + Widget parent = FRAME_X_CONTAINER_WIDGET (f); + + assert (first_time_p); + + /* It's the first time we've mapped the menubar so compute its + contents completely once. This makes sure that the menubar + components are created with the right type. */ + if (!deep_p) + { + free_popup_widget_value_tree (data); + data = compute_menubar_data (f, menubar, 1); + } + + + FRAME_X_MENUBAR_WIDGET (f) = + lw_create_widget ("menubar", "menubar", id, data, parent, + 0, pre_activate_callback, + popup_selection_callback, 0); + + } + else + { + lw_modify_all_widgets (id, data, deep_p ? True : False); + } + free_popup_widget_value_tree (data); + + XFRAME_MENUBAR_DATA (f)->menubar_contents_up_to_date = deep_p; + XFRAME_MENUBAR_DATA (f)->last_menubar_buffer = + XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer; + return menubar_visible; +} + + +/* Called from x_create_widgets() to create the initial menubar of a frame + before it is mapped, so that the window is mapped with the menubar already + there instead of us tacking it on later and thrashing the window after it + is visible. */ +int +x_initialize_frame_menubar (struct frame *f) +{ + return set_frame_menubar (f, 1, 1); +} + + +static LWLIB_ID last_popup_menu_selection_callback_id; + +static void +popup_menu_selection_callback (Widget widget, LWLIB_ID id, + XtPointer client_data) +{ + last_popup_menu_selection_callback_id = id; + popup_selection_callback (widget, id, client_data); + /* lw_destroy_all_widgets() will be called from popup_down_callback() */ +} + +static void +popup_menu_down_callback (Widget widget, LWLIB_ID id, XtPointer client_data) +{ + if (popup_handled_p (id)) + return; + assert (popup_up_p != 0); + ungcpro_popup_callbacks (id); + popup_up_p--; + /* if this isn't called immediately after the selection callback, then + there wasn't a menu selection. */ + if (id != last_popup_menu_selection_callback_id) + popup_selection_callback (widget, id, (XtPointer) -1); + lw_destroy_all_widgets (id); +} + + +static void +make_dummy_xbutton_event (XEvent *dummy, + Widget daddy, + struct Lisp_Event *eev) + /* NULL for eev means query pointer */ +{ + XButtonPressedEvent *btn = (XButtonPressedEvent *) dummy; + + btn->type = ButtonPress; + btn->serial = 0; + btn->send_event = 0; + btn->display = XtDisplay (daddy); + btn->window = XtWindow (daddy); + if (eev) + { + Position shellx, shelly, framex, framey; + Arg al [2]; + btn->time = eev->timestamp; + btn->button = eev->event.button.button; + btn->root = RootWindowOfScreen (XtScreen (daddy)); + btn->subwindow = (Window) NULL; + btn->x = eev->event.button.x; + btn->y = eev->event.button.y; + shellx = shelly = 0; +#ifndef HAVE_WMCOMMAND + { + Widget shell = XtParent (daddy); + + XtSetArg (al [0], XtNx, &shellx); + XtSetArg (al [1], XtNy, &shelly); + XtGetValues (shell, al, 2); + } +#endif + XtSetArg (al [0], XtNx, &framex); + XtSetArg (al [1], XtNy, &framey); + XtGetValues (daddy, al, 2); + btn->x_root = shellx + framex + btn->x; + btn->y_root = shelly + framey + btn->y; + btn->state = ButtonPressMask; /* all buttons pressed */ + } + else + { + /* CurrentTime is just ZERO, so it's worthless for + determining relative click times. */ + struct device *d = get_device_from_display (XtDisplay (daddy)); + btn->time = DEVICE_X_MOUSE_TIMESTAMP (d); /* event-Xt maintains this */ + btn->button = 0; + XQueryPointer (btn->display, btn->window, &btn->root, + &btn->subwindow, &btn->x_root, &btn->y_root, + &btn->x, &btn->y, &btn->state); + } +} + + + +static void +x_update_frame_menubar_internal (struct frame *f) +{ + /* We assume the menubar contents has changed if the global flag is set, + or if the current buffer has changed, or if the menubar has never + been updated before. + */ + int menubar_contents_changed = + (f->menubar_changed + || NILP (FRAME_MENUBAR_DATA (f)) + || (!EQ (XFRAME_MENUBAR_DATA (f)->last_menubar_buffer, + XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f))->buffer))); + + Boolean menubar_was_visible = XtIsManaged (FRAME_X_MENUBAR_WIDGET (f)); + Boolean menubar_will_be_visible = menubar_was_visible; + Boolean menubar_visibility_changed; + + if (menubar_contents_changed) + menubar_will_be_visible = set_frame_menubar (f, 0, 0); + + menubar_visibility_changed = menubar_was_visible != menubar_will_be_visible; + + if (!menubar_visibility_changed) + return; + + /* Set menubar visibility */ + (menubar_will_be_visible ? XtManageChild : XtUnmanageChild) + (FRAME_X_MENUBAR_WIDGET (f)); + + MARK_FRAME_SIZE_SLIPPED (f); +} + +static void +x_update_frame_menubars (struct frame *f) +{ + assert (FRAME_X_P (f)); + + x_update_frame_menubar_internal (f); + + /* #### This isn't going to work right now that this function works on + a per-frame, not per-device basis. Guess what? I don't care. */ +} + +static void +x_free_frame_menubars (struct frame *f) +{ + Widget menubar_widget; + + assert (FRAME_X_P (f)); + + menubar_widget = FRAME_X_MENUBAR_WIDGET (f); + if (menubar_widget) + { + LWLIB_ID id = XFRAME_MENUBAR_DATA (f)->id; + lw_destroy_all_widgets (id); + XFRAME_MENUBAR_DATA (f)->id = 0; + } +} + +static void +x_popup_menu (Lisp_Object menu_desc, Lisp_Object event) +{ + int menu_id; + struct frame *f = selected_frame (); + widget_value *data; + Widget parent; + Widget menu; + struct Lisp_Event *eev = NULL; + XEvent xev; + Lisp_Object frame; + + XSETFRAME (frame, f); + CHECK_X_FRAME (frame); + parent = FRAME_X_SHELL_WIDGET (f); + + if (!NILP (event)) + { + CHECK_LIVE_EVENT (event); + eev= XEVENT (event); + if (eev->event_type != button_press_event + && eev->event_type != button_release_event) + wrong_type_argument (Qmouse_event_p, event); + } + else if (!NILP (Vthis_command_keys)) + { + /* if an event wasn't passed, use the last event of the event sequence + currently being executed, if that event is a mouse event */ + eev = XEVENT (Vthis_command_keys); /* last event first */ + if (eev->event_type != button_press_event + && eev->event_type != button_release_event) + eev = NULL; + } + make_dummy_xbutton_event (&xev, parent, eev); + + if (SYMBOLP (menu_desc)) + menu_desc = Fsymbol_value (menu_desc); + CHECK_CONS (menu_desc); + CHECK_STRING (XCAR (menu_desc)); + data = menu_item_descriptor_to_widget_value (menu_desc, POPUP_TYPE, 1, 1); + + if (! data) error ("no menu"); + + menu_id = new_lwlib_id (); + menu = lw_create_widget ("popup", "popup" /* data->name */, menu_id, data, + parent, 1, 0, + popup_menu_selection_callback, + popup_menu_down_callback); + free_popup_widget_value_tree (data); + + gcpro_popup_callbacks (menu_id); + + /* Setting zmacs-region-stays is necessary here because executing a command + from a menu is really a two-command process: the first command (bound to + the button-click) simply pops up the menu, and returns. This causes a + sequence of magic-events (destined for the popup-menu widget) to begin. + Eventually, a menu item is selected, and a menu-event blip is pushed onto + the end of the input stream, which is then executed by the event loop. + + So there are two command-events, with a bunch of magic-events between + them. We don't want the *first* command event to alter the state of the + region, so that the region can be available as an argument for the second + command. + */ + if (zmacs_regions) + zmacs_region_stays = 1; + + popup_up_p++; + lw_popup_menu (menu, &xev); + /* this speeds up display of pop-up menus */ + XFlush (XtDisplay (parent)); +} + + +void +syms_of_menubar_x (void) +{ +} + +void +console_type_create_menubar_x (void) +{ + CONSOLE_HAS_METHOD (x, update_frame_menubars); + CONSOLE_HAS_METHOD (x, free_frame_menubars); + CONSOLE_HAS_METHOD (x, popup_menu); +} + +void +reinit_vars_of_menubar_x (void) +{ + last_popup_menu_selection_callback_id = (LWLIB_ID) -1; +} + +void +vars_of_menubar_x (void) +{ + reinit_vars_of_menubar_x (); + +#if defined (LWLIB_MENUBARS_LUCID) + Fprovide (intern ("lucid-menubars")); +#elif defined (LWLIB_MENUBARS_MOTIF) + Fprovide (intern ("motif-menubars")); +#elif defined (LWLIB_MENUBARS_ATHENA) + Fprovide (intern ("athena-menubars")); +#endif +}