From: Geoff Voelker Date: Thu, 23 Apr 1998 23:43:02 +0000 (+0000) Subject: Replace code with a new version written from scratch X-Git-Tag: emacs-20.3~1335 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=485015ca07da2b6b5d4b8c206c294de0cf9278ca;p=emacs.git Replace code with a new version written from scratch based on xmenu.c; menu construction is now completely lazy. --- diff --git a/src/w32menu.c b/src/w32menu.c index fe474caa1a6..4263c631bdc 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -1,5 +1,5 @@ /* Menu support for GNU Emacs on the Microsoft W32 API. - Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. + Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,8 +18,6 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Written by Kevin Gallo. */ - #include #include @@ -44,22 +42,88 @@ Boston, MA 02111-1307, USA. */ #include "dispextern.h" -#define min(x, y) (((x) < (y)) ? (x) : (y)) -#define max(x, y) (((x) > (y)) ? (x) : (y)) +/******************************************************************/ +/* Definitions copied from lwlib.h */ -Lisp_Object Vmenu_updating_frame; +typedef void * XtPointer; +typedef char Boolean; + +#define True 1 +#define False 0 + +typedef enum _change_type +{ + NO_CHANGE = 0, + INVISIBLE_CHANGE = 1, + VISIBLE_CHANGE = 2, + STRUCTURAL_CHANGE = 3 +} change_type; -typedef struct menu_map +typedef struct _widget_value { - Lisp_Object menu_items; - int menu_items_allocated; - int menu_items_used; -} menu_map; + /* name of widget */ + char* name; + /* value (meaning depend on widget type) */ + char* value; + /* keyboard equivalent. no implications for XtTranslations */ + char* key; + /* true if enabled */ + Boolean enabled; + /* true if selected */ + Boolean selected; + /* true if menu title */ + Boolean title; +#if 0 + /* true if was edited (maintained by get_value) */ + Boolean edited; + /* true if has changed (maintained by lw library) */ + change_type change; + /* true if this widget itself has changed, + but not counting the other widgets found in the `next' field. */ + change_type this_one_change; +#endif + /* Contents of the sub-widgets, also selected slot for checkbox */ + struct _widget_value* contents; + /* data passed to callback */ + XtPointer call_data; + /* next one in the list */ + struct _widget_value* next; +#if 0 + /* slot for the toolkit dependent part. Always initialize to NULL. */ + void* toolkit_data; + /* tell us if we should free the toolkit data slot when freeing the + widget_value itself. */ + Boolean free_toolkit_data; + + /* we resource the widget_value structures; this points to the next + one on the free list if this one has been deallocated. + */ + struct _widget_value *free_list; +#endif +} widget_value; + +/* LocalAlloc/Free is a reasonably good allocator. */ +#define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value)) +#define free_widget_value(wv) LocalFree (wv) + +/******************************************************************/ + +#define min(x,y) (((x) < (y)) ? (x) : (y)) +#define max(x,y) (((x) > (y)) ? (x) : (y)) + +#ifndef TRUE +#define TRUE 1 +#define FALSE 0 +#endif /* no TRUE */ + +Lisp_Object Vmenu_updating_frame; Lisp_Object Qdebug_on_next_call; -extern Lisp_Object Qmenu_enable; extern Lisp_Object Qmenu_bar; +extern Lisp_Object Qmouse_click, Qevent_kind; + +extern Lisp_Object QCtoggle, QCradio; extern Lisp_Object Voverriding_local_map; extern Lisp_Object Voverriding_local_map_menu_flag; @@ -70,276 +134,227 @@ extern Lisp_Object Qmenu_bar_update_hook; void set_frame_menubar (); +static Lisp_Object w32_menu_show (); static Lisp_Object w32_dialog_show (); -static Lisp_Object w32menu_show (); -static HMENU keymap_panes (); -static HMENU single_keymap_panes (); -static HMENU list_of_panes (); -static HMENU list_of_items (); +static void keymap_panes (); +static void single_keymap_panes (); +static void single_menu_item (); +static void list_of_panes (); +static void list_of_items (); + +/* This holds a Lisp vector that holds the results of decoding + the keymaps or alist-of-alists that specify a menu. + + It describes the panes and items within the panes. + + Each pane is described by 3 elements in the vector: + t, the pane name, the pane's prefix key. + Then follow the pane's items, with 5 elements per item: + the item string, the enable flag, the item's value, + the definition, and the equivalent keyboard key's description string. + + In some cases, multiple levels of menus may be described. + A single vector slot containing nil indicates the start of a submenu. + A single vector slot containing lambda indicates the end of a submenu. + The submenu follows a menu item which is the way to reach the submenu. + + A single vector slot containing quote indicates that the + following items should appear on the right of a dialog box. + + Using a Lisp vector to hold this information while we decode it + takes care of protecting all the data from GC. */ + +#define MENU_ITEMS_PANE_NAME 1 +#define MENU_ITEMS_PANE_PREFIX 2 +#define MENU_ITEMS_PANE_LENGTH 3 + +#define MENU_ITEMS_ITEM_NAME 0 +#define MENU_ITEMS_ITEM_ENABLE 1 +#define MENU_ITEMS_ITEM_VALUE 2 +#define MENU_ITEMS_ITEM_EQUIV_KEY 3 +#define MENU_ITEMS_ITEM_DEFINITION 4 +#define MENU_ITEMS_ITEM_LENGTH 5 + +static Lisp_Object menu_items; + +/* Number of slots currently allocated in menu_items. */ +static int menu_items_allocated; + +/* This is the index in menu_items of the first empty slot. */ +static int menu_items_used; + +/* The number of panes currently recorded in menu_items, + excluding those within submenus. */ +static int menu_items_n_panes; + +/* Current depth within submenus. */ +static int menu_items_submenu_depth; + +/* Flag which when set indicates a dialog or menu has been posted by + Xt on behalf of one of the widget sets. */ +static int popup_activated_flag; + +/* This is set nonzero after the user activates the menu bar, and set + to zero again after the menu bars are redisplayed by prepare_menu_bar. + While it is nonzero, all calls to set_frame_menubar go deep. + + I don't understand why this is needed, but it does seem to be + needed on Motif, according to Marcus Daniels . */ -static HMENU create_menu_items (); +int pending_menu_activation; + + +/* Return the frame whose ->output_data.w32->menubar_widget equals + MENU, or 0 if none. */ + +static struct frame * +menubar_id_to_frame (HMENU menu) +{ + Lisp_Object tail, frame; + FRAME_PTR f; + for (tail = Vframe_list; GC_CONSP (tail); tail = XCONS (tail)->cdr) + { + frame = XCONS (tail)->car; + if (!GC_FRAMEP (frame)) + continue; + f = XFRAME (frame); + if (f->output_data.nothing == 1) + continue; + if (f->output_data.w32->menubar_widget == menu) + return f; + } + return 0; +} + /* Initialize the menu_items structure if we haven't already done so. Also mark it as currently empty. */ -#if 0 -static void -init_menu_items (lpmm) - menu_map * lpmm; +static void +init_menu_items () { - if (NILP (lpmm->menu_items)) + if (NILP (menu_items)) { - lpmm->menu_items_allocated = 60; - lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated), - Qnil); + menu_items_allocated = 60; + menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); } - - lpmm->menu_items_used = 0; + + menu_items_used = 0; + menu_items_n_panes = 0; + menu_items_submenu_depth = 0; } -/* Make the menu_items vector twice as large. */ +/* Call at the end of generating the data in menu_items. + This fills in the number of items in the last pane. */ -static void -grow_menu_items (lpmm) - menu_map * lpmm; +static void +finish_menu_items () { - Lisp_Object new; - int old_size = lpmm->menu_items_allocated; - - lpmm->menu_items_allocated *= 2; - new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil); - bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents, - old_size * sizeof (Lisp_Object)); - - lpmm->menu_items = new; } -#endif /* Call when finished using the data for the current menu in menu_items. */ -static void -discard_menu_items (lpmm) - menu_map * lpmm; -{ -#if 0 - lpmm->menu_items = Qnil; -#endif - lpmm->menu_items_allocated = lpmm->menu_items_used = 0; -} - -/* Is this item a separator? */ -static int -name_is_separator (name) - Lisp_Object name; +static void +discard_menu_items () { - int isseparator = (((char *)XSTRING (name)->data)[0] == 0); - - if (!isseparator) + /* Free the structure if it is especially large. + Otherwise, hold on to it, to save time. */ + if (menu_items_allocated > 200) { - /* Check if name string consists of only dashes ('-') */ - char *string = (char *)XSTRING (name)->data; - while (*string == '-') string++; - isseparator = (*string == 0); + menu_items = Qnil; + menu_items_allocated = 0; } - - return isseparator; } +/* Make the menu_items vector twice as large. */ -/* Indicate boundary between left and right. */ - -static void -add_left_right_boundary (hmenu) - HMENU hmenu; +static void +grow_menu_items () { - AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL); + Lisp_Object old; + int old_size = menu_items_allocated; + old = menu_items; + + menu_items_allocated *= 2; + menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil); + bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents, + old_size * sizeof (Lisp_Object)); } -/* Push one menu item into the current pane. - NAME is the string to display. ENABLE if non-nil means - this item can be selected. KEY is the key generated by - choosing this item. EQUIV is the textual description - of the keyboard equivalent for this item (or nil if none). */ - -static void -add_menu_item (lpmm, hmenu, name, enable, key, equiv) - menu_map * lpmm; - HMENU hmenu; - Lisp_Object name; - UINT enable; - Lisp_Object key; - Lisp_Object equiv; -{ - UINT fuFlags; - Lisp_Object out_string; - - if (NILP (name) || name_is_separator (name)) - fuFlags = MF_SEPARATOR; - else - { - if (enable) - fuFlags = MF_STRING; - else - fuFlags = MF_STRING | MF_GRAYED; +/* Begin a submenu. */ - if (!NILP (equiv)) - { - out_string = concat2 (name, make_string ("\t", 1)); - out_string = concat2 (out_string, equiv); - } - else - out_string = name; - } +static void +push_submenu_start () +{ + if (menu_items_used + 1 > menu_items_allocated) + grow_menu_items (); - AppendMenu (hmenu, - fuFlags, - lpmm->menu_items_used + 1, - (fuFlags == MF_SEPARATOR)?NULL: - (char *) XSTRING (out_string)->data); - - lpmm->menu_items_used++; -#if 0 - if (lpmm->menu_items_used >= lpmm->menu_items_allocated) - grow_menu_items (lpmm); - - XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++], - Lisp_Cons, - key); -#endif + XVECTOR (menu_items)->contents[menu_items_used++] = Qnil; + menu_items_submenu_depth++; } - -/* Figure out the current keyboard equivalent of a menu item ITEM1. - The item string for menu display should be ITEM_STRING. - Store the equivalent keyboard key sequence's - textual description into *DESCRIP_PTR. - Also cache them in the item itself. - Return the real definition to execute. */ - -static Lisp_Object -menu_item_equiv_key (item_string, item1, descrip_ptr) - Lisp_Object item_string; - Lisp_Object item1; - Lisp_Object *descrip_ptr; + +/* End a submenu. */ + +static void +push_submenu_end () { - /* This is the real definition--the function to run. */ - Lisp_Object def; - /* This is the sublist that records cached equiv key data - so we can save time. */ - Lisp_Object cachelist; - /* These are the saved equivalent keyboard key sequence - and its key-description. */ - Lisp_Object savedkey, descrip; - Lisp_Object def1; - int changed = 0; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - - /* If a help string follows the item string, skip it. */ - if (CONSP (XCONS (item1)->cdr) - && STRINGP (XCONS (XCONS (item1)->cdr)->car)) - item1 = XCONS (item1)->cdr; - - def = Fcdr (item1); - - /* Get out the saved equivalent-keyboard-key info. */ - cachelist = savedkey = descrip = Qnil; - if (CONSP (def) && CONSP (XCONS (def)->car) - && (NILP (XCONS (XCONS (def)->car)->car) - || VECTORP (XCONS (XCONS (def)->car)->car))) - { - cachelist = XCONS (def)->car; - def = XCONS (def)->cdr; - savedkey = XCONS (cachelist)->car; - descrip = XCONS (cachelist)->cdr; - } - - GCPRO4 (def, def1, savedkey, descrip); - - /* Is it still valid? */ - def1 = Qnil; - if (!NILP (savedkey)) - def1 = Fkey_binding (savedkey, Qnil); - /* If not, update it. */ - if (! EQ (def1, def) - /* If the command is an alias for another - (such as easymenu.el and lmenu.el set it up), - check if the original command matches the cached command. */ - && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) - && EQ (def1, XSYMBOL (def)->function)) - /* If something had no key binding before, don't recheck it-- - doing that takes too much time and makes menus too slow. */ - && !(!NILP (cachelist) && NILP (savedkey))) - { - changed = 1; - descrip = Qnil; - savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil); - /* If the command is an alias for another - (such as easymenu.el and lmenu.el set it up), - see if the original command name has equivalent keys. */ - if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) - savedkey = Fwhere_is_internal (XSYMBOL (def)->function, - Qnil, Qt, Qnil); - - if (VECTORP (savedkey) - && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar)) - savedkey = Qnil; - if (!NILP (savedkey)) - { - descrip = Fkey_description (savedkey); - descrip = concat2 (make_string (" (", 3), descrip); - descrip = concat2 (descrip, make_string (")", 1)); - } - } - - /* Cache the data we just got in a sublist of the menu binding. */ - if (NILP (cachelist)) - XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def); - else if (changed) - { - XCONS (cachelist)->car = savedkey; - XCONS (cachelist)->cdr = descrip; - } + if (menu_items_used + 1 > menu_items_allocated) + grow_menu_items (); - UNGCPRO; - *descrip_ptr = descrip; - return def; + XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda; + menu_items_submenu_depth--; } -/* This is used as the handler when calling internal_condition_case_1. */ +/* Indicate boundary between left and right. */ -static Lisp_Object -menu_item_enabled_p_1 (arg) - Lisp_Object arg; +static void +push_left_right_boundary () { - return Qnil; + if (menu_items_used + 1 > menu_items_allocated) + grow_menu_items (); + + XVECTOR (menu_items)->contents[menu_items_used++] = Qquote; } -/* Return non-nil if the command DEF is enabled when used as a menu item. - This is based on looking for a menu-enable property. - If NOTREAL is set, don't bother really computing this. */ +/* Start a new menu pane in menu_items.. + NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */ -static Lisp_Object -menu_item_enabled_p (def, notreal) - Lisp_Object def; +static void +push_menu_pane (name, prefix_vec) + Lisp_Object name, prefix_vec; { - Lisp_Object enabled, tem; + if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated) + grow_menu_items (); + + if (menu_items_submenu_depth == 0) + menu_items_n_panes++; + XVECTOR (menu_items)->contents[menu_items_used++] = Qt; + XVECTOR (menu_items)->contents[menu_items_used++] = name; + XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec; +} - enabled = Qt; - if (notreal) - return enabled; - if (XTYPE (def) == Lisp_Symbol) - { - /* No property, or nil, means enable. - Otherwise, enable if value is not nil. */ - tem = Fget (def, Qmenu_enable); - if (!NILP (tem)) - /* (condition-case nil (eval tem) - (error nil)) */ - enabled = internal_condition_case_1 (Feval, tem, Qerror, - menu_item_enabled_p_1); - } - return enabled; +/* Push one menu item into the current pane. + NAME is the string to display. ENABLE if non-nil means + this item can be selected. KEY is the key generated by + choosing this item, or nil if this item doesn't really have a definition. + DEF is the definition of this item. + EQUIV is the textual description of the keyboard equivalent for + this item (or nil if none). */ + +static void +push_menu_item (name, enable, key, def, equiv) + Lisp_Object name, enable, key, def, equiv; +{ + if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated) + grow_menu_items (); + + XVECTOR (menu_items)->contents[menu_items_used++] = name; + XVECTOR (menu_items)->contents[menu_items_used++] = enable; + XVECTOR (menu_items)->contents[menu_items_used++] = key; + XVECTOR (menu_items)->contents[menu_items_used++] = equiv; + XVECTOR (menu_items)->contents[menu_items_used++] = def; } /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, @@ -347,188 +362,69 @@ menu_item_enabled_p (def, notreal) If NOTREAL is nonzero, don't bother really computing whether an item is enabled. */ -static HMENU -keymap_panes (lpmm, keymaps, nmaps, notreal) - menu_map * lpmm; +static void +keymap_panes (keymaps, nmaps, notreal) Lisp_Object *keymaps; int nmaps; int notreal; { int mapno; -#if 0 - init_menu_items (lpmm); -#endif + init_menu_items (); - if (nmaps > 1) - { - HMENU hmenu; - - if (!notreal) - { - hmenu = CreatePopupMenu (); - - if (!hmenu) return (NULL); - } - else - { - hmenu = NULL; - } - - /* Loop over the given keymaps, making a pane for each map. - But don't make a pane that is empty--ignore that map instead. - P is the number of panes we have made so far. */ - for (mapno = 0; mapno < nmaps; mapno++) - { - HMENU new_hmenu; - - new_hmenu = single_keymap_panes (lpmm, keymaps[mapno], - Qnil, Qnil, notreal); - - if (!notreal && new_hmenu) - { - AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, ""); - } - } + /* Loop over the given keymaps, making a pane for each map. + But don't make a pane that is empty--ignore that map instead. + P is the number of panes we have made so far. */ + for (mapno = 0; mapno < nmaps; mapno++) + single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10); - return (hmenu); - } - else - { - return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal)); - } + finish_menu_items (); } /* This is a recursive subroutine of keymap_panes. It handles one keymap, KEYMAP. The other arguments are passed along or point to local variables of the previous function. - If NOTREAL is nonzero, - don't bother really computing whether an item is enabled. */ + If NOTREAL is nonzero, only check for equivalent key bindings, don't + evaluate expressions in menu items and don't make any menu. -HMENU -single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) - menu_map * lpmm; + If we encounter submenus deeper than MAXDEPTH levels, ignore them. */ + +static void +single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth) Lisp_Object keymap; Lisp_Object pane_name; Lisp_Object prefix; int notreal; + int maxdepth; { - Lisp_Object pending_maps; - Lisp_Object tail, item, item1, item_string, table; - HMENU hmenu; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - if (!notreal) - { - hmenu = CreatePopupMenu (); - if (hmenu == NULL) return NULL; - } - else - { - hmenu = NULL; - } - - pending_maps = Qnil; - - for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) + Lisp_Object pending_maps = Qnil; + Lisp_Object tail, item; + struct gcpro gcpro1, gcpro2; + int notbuttons = 0; + + if (maxdepth <= 0) + return; + + push_menu_pane (pane_name, prefix); + +#ifndef 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. */ + notbuttons = menu_items_used; +#endif + + for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr) { - /* Look at each key binding, and if it has a menu string, - make a menu item from it. */ - + GCPRO2 (keymap, pending_maps); + /* Look at each key binding, and if it is a menu item add it + to this menu. */ item = XCONS (tail)->car; - if (CONSP (item)) - { - item1 = XCONS (item)->cdr; - - if (XTYPE (item1) == Lisp_Cons) - { - item_string = XCONS (item1)->car; - if (XTYPE (item_string) == Lisp_String) - { - /* This is the real definition--the function to run. */ - - Lisp_Object def; - - /* These are the saved equivalent keyboard key sequence - and its key-description. */ - - Lisp_Object descrip; - Lisp_Object tem, enabled; - - /* GCPRO because ...enabled_p will call eval - and ..._equiv_key may autoload something. - Protecting KEYMAP preserves everything we use; - aside from that, must protect whatever might be - a string. Since there's no GCPRO5, we refetch - item_string instead of protecting it. */ - - descrip = def = Qnil; - GCPRO4 (keymap, pending_maps, def, prefix); - - def = menu_item_equiv_key (item_string, item1, &descrip); - { - struct gcpro gcpro1; - GCPRO1 (descrip); - enabled = menu_item_enabled_p (def, notreal); - UNGCPRO; - } - - UNGCPRO; - - item_string = XCONS (item1)->car; - - tem = Fkeymapp (def); - if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) - { - pending_maps = Fcons (Fcons (def, - Fcons (item_string, - XCONS (item)->car)), - pending_maps); - } - else - { - Lisp_Object submap; - - GCPRO5 (keymap, pending_maps, item, item_string, descrip); - - submap = get_keymap_1 (def, 0, 1); - - UNGCPRO; - - if (NILP (submap)) - { - if (!notreal) - { - add_menu_item (lpmm, - hmenu, - item_string, - !NILP (enabled), - Fcons (XCONS (item)->car, prefix), - descrip); - } - } - else - /* Display a submenu. */ - { - HMENU new_hmenu = single_keymap_panes (lpmm, - submap, - item_string, - XCONS (item)->car, - notreal); - - if (!notreal) - { - AppendMenu (hmenu, MF_POPUP, - (UINT)new_hmenu, - (char *) XSTRING (item_string)->data); - } - } - } - } - } - } + single_menu_item (XCONS (item)->car, XCONS (item)->cdr, + &pending_maps, notreal, maxdepth, ¬buttons); else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ @@ -538,87 +434,11 @@ single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) { Lisp_Object character; XSETFASTINT (character, c); - item1 = XVECTOR (item)->contents[c]; - if (CONSP (item1)) - { - item_string = XCONS (item1)->car; - if (STRINGP (item_string)) - { - Lisp_Object def; - - /* These are the saved equivalent keyboard key sequence - and its key-description. */ - Lisp_Object descrip; - Lisp_Object tem, enabled; - - /* GCPRO because ...enabled_p will call eval - and ..._equiv_key may autoload something. - Protecting KEYMAP preserves everything we use; - aside from that, must protect whatever might be - a string. Since there's no GCPRO5, we refetch - item_string instead of protecting it. */ - GCPRO3 (keymap, pending_maps, def); - descrip = def = Qnil; - - def = menu_item_equiv_key (item_string, item1, &descrip); - { - struct gcpro gcpro1; - GCPRO1 (descrip); - enabled = menu_item_enabled_p (def, notreal); - UNGCPRO; - } - - UNGCPRO; - - item_string = XCONS (item1)->car; - - tem = Fkeymapp (def); - if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) - pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), - pending_maps); - else - { - Lisp_Object submap; - - GCPRO5 (keymap, pending_maps, descrip, item_string, descrip); - - submap = get_keymap_1 (def, 0, 1); - - UNGCPRO; - - if (NILP (submap)) - { - if (!notreal) - { - add_menu_item (lpmm, - hmenu, - item_string, - !NILP (enabled), - character, - descrip); - } - } - else - /* Display a submenu. */ - { - HMENU new_hmenu = single_keymap_panes (lpmm, - submap, - Qnil, - character, - notreal); - - if (!notreal) - { - AppendMenu (hmenu,MF_POPUP, - (UINT)new_hmenu, - (char *)XSTRING (item_string)->data); - } - } - } - } - } + single_menu_item (character, XVECTOR (item)->contents[c], + &pending_maps, notreal, maxdepth, ¬buttons); } } + UNGCPRO; } /* Process now any submenus which want to be panes at this level. */ @@ -629,586 +449,238 @@ single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) eltcdr = XCONS (elt)->cdr; string = XCONS (eltcdr)->car; /* We no longer discard the @ from the beginning of the string here. - Instead, we do this in w32menu_show. */ + Instead, we do this in w32_menu_show. */ + single_keymap_panes (Fcar (elt), string, + XCONS (eltcdr)->cdr, notreal, maxdepth - 1); + pending_maps = Fcdr (pending_maps); + } +} + +/* This is a subroutine of single_keymap_panes that handles one + keymap entry. + KEY is a key in a keymap and ITEM is its binding. + PENDING_MAPS_PTR points to a list of keymaps waiting to be made into + separate panes. + If NOTREAL is nonzero, only check for equivalent key bindings, don't + evaluate expressions in menu items and don't make any menu. + If we encounter submenus deeper than MAXDEPTH levels, ignore them. + NOTBUTTONS_PTR is only used when simulating toggle boxes and radio + buttons. It points to variable notbuttons in single_keymap_panes, + which keeps track of if we have seen a button in this menu or not. */ + +static void +single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, + notbuttons_ptr) + Lisp_Object key, item; + Lisp_Object *pending_maps_ptr; + int maxdepth, notreal; + int *notbuttons_ptr; +{ + Lisp_Object def, map, item_string, enabled; + struct gcpro gcpro1, gcpro2; + int res; + + /* Parse the menu item and leave the result in item_properties. */ + GCPRO2 (key, item); + res = parse_menu_item (item, notreal, 0); + UNGCPRO; + if (!res) + return; /* Not a menu item. */ + + map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP]; + + if (notreal) + { + /* We don't want to make a menu, just traverse the keymaps to + precompute equivalent key bindings. */ + if (!NILP (map)) + single_keymap_panes (map, Qnil, key, 1, maxdepth - 1); + return; + } + + enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]; + item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; + + if (!NILP (map) && XSTRING (item_string)->data[0] == '@') + { + if (!NILP (enabled)) + /* An enabled separate pane. Remember this to handle it later. */ + *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)), + *pending_maps_ptr); + return; + } + +#ifndef HAVE_BOXES + /* Simulate radio buttons and toggle boxes by putting a prefix in + front of them. */ + { + Lisp_Object prefix = Qnil; + Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE]; + if (!NILP (type)) { - HMENU new_hmenu = single_keymap_panes (lpmm, - Fcar (elt), - string, - XCONS (eltcdr)->cdr, notreal); - - if (!notreal) + Lisp_Object selected + = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; + + if (*notbuttons_ptr) + /* The first button. Line up previous items in this menu. */ { - AppendMenu (hmenu, MF_POPUP, - (UINT)new_hmenu, - (char *) XSTRING (string)->data); + int index = *notbuttons_ptr; /* Index for first item this menu. */ + int submenu = 0; + Lisp_Object tem; + while (index < menu_items_used) + { + tem + = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME]; + if (NILP (tem)) + { + index++; + submenu++; /* Skip sub menu. */ + } + else if (EQ (tem, Qlambda)) + { + index++; + submenu--; /* End sub menu. */ + } + else if (EQ (tem, Qt)) + index += 3; /* Skip new pane marker. */ + else if (EQ (tem, Qquote)) + index++; /* Skip a left, right divider. */ + else + { + if (!submenu && XSTRING (tem)->data[0] != '\0' + && XSTRING (tem)->data[0] != '-') + XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME] + = concat2 (build_string (" "), tem); + index += MENU_ITEMS_ITEM_LENGTH; + } + } + *notbuttons_ptr = 0; } + + /* Calculate prefix, if any, for this item. */ + if (EQ (type, QCtoggle)) + prefix = build_string (NILP (selected) ? "[ ] " : "[X] "); + else if (EQ (type, QCradio)) + prefix = build_string (NILP (selected) ? "( ) " : "(*) "); } + /* Not a button. If we have earlier buttons, then we need a prefix. */ + else if (!*notbuttons_ptr && XSTRING (item_string)->data[0] != '\0' + && XSTRING (item_string)->data[0] != '-') + prefix = build_string (" "); - pending_maps = Fcdr (pending_maps); + if (!NILP (prefix)) + item_string = concat2 (prefix, item_string); + } +#endif /* not HAVE_BOXES */ + +#if 0 + if (!NILP(map)) + /* Indicate visually that this is a submenu. */ + item_string = concat2 (item_string, build_string (" >")); +#endif + + push_menu_item (item_string, enabled, key, + XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF], + XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]); + +#if 1 + /* Display a submenu using the toolkit. */ + if (! (NILP (map) || NILP (enabled))) + { + push_submenu_start (); + single_keymap_panes (map, Qnil, key, 0, maxdepth - 1); + push_submenu_end (); } - - return (hmenu); +#endif } /* 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. */ -static HMENU -list_of_panes (lpmm, menu) - menu_map * lpmm; +static void +list_of_panes (menu) Lisp_Object menu; { Lisp_Object tail; - HMENU hmenu; - - if (XFASTINT (Flength (menu)) > 1) - { - hmenu = CreatePopupMenu (); - if (hmenu == NULL) return NULL; - -/* init_menu_items (lpmm); */ - - for (tail = menu; !NILP (tail); tail = Fcdr (tail)) - { - Lisp_Object elt, pane_name, pane_data; - HMENU new_hmenu; - elt = Fcar (tail); - pane_name = Fcar (elt); - CHECK_STRING (pane_name, 0); - pane_data = Fcdr (elt); - CHECK_CONS (pane_data, 0); - - if (XSTRING (pane_name)->data[0] == 0) - { - list_of_items (hmenu, lpmm, pane_data); - } - else - { - new_hmenu = list_of_items (NULL, lpmm, pane_data); - if (new_hmenu == NULL) goto error; + init_menu_items (); - AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, - (char *) XSTRING (pane_name)->data); - } - } - } - else + for (tail = menu; !NILP (tail); tail = Fcdr (tail)) { Lisp_Object elt, pane_name, pane_data; - - elt = Fcar (menu); + elt = Fcar (tail); pane_name = Fcar (elt); CHECK_STRING (pane_name, 0); + push_menu_pane (pane_name, Qnil); pane_data = Fcdr (elt); CHECK_CONS (pane_data, 0); - hmenu = list_of_items (NULL, lpmm, pane_data); + list_of_items (pane_data); } - return (hmenu); - - error: - DestroyMenu (hmenu); - - return (NULL); + + finish_menu_items (); } /* Push the items in a single pane defined by the alist PANE. */ -static HMENU -list_of_items (hmenu, lpmm, pane) - HMENU hmenu; - menu_map * lpmm; +static void +list_of_items (pane) Lisp_Object pane; { Lisp_Object tail, item, item1; - if (hmenu == NULL) - { - hmenu = CreatePopupMenu (); - if (hmenu == NULL) return NULL; - } - for (tail = pane; !NILP (tail); tail = Fcdr (tail)) { item = Fcar (tail); if (STRINGP (item)) - add_menu_item (lpmm, hmenu, item, 0, Qnil, Qnil); + push_menu_item (item, Qnil, Qnil, Qt, Qnil); else if (NILP (item)) - add_left_right_boundary (); + push_left_right_boundary (); else { CHECK_CONS (item, 0); item1 = Fcar (item); CHECK_STRING (item1, 1); - add_menu_item (lpmm, hmenu, item1, 1, Fcdr (item), Qnil); + push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil); } } - - return (hmenu); } - -HMENU -create_menu_items (lpmm, menu, notreal) - menu_map * lpmm; - Lisp_Object menu; - int notreal; -{ - Lisp_Object title; - Lisp_Object keymap, tem; - HMENU hmenu; - - title = Qnil; - - /* Decode the menu items from what was specified. */ - - keymap = Fkeymapp (menu); - tem = Qnil; - if (XTYPE (menu) == Lisp_Cons) - tem = Fkeymapp (Fcar (menu)); - - if (!NILP (keymap)) - { - /* We were given a keymap. Extract menu info from the keymap. */ - Lisp_Object prompt; - keymap = get_keymap (menu); - - /* Extract the detailed info to make one pane. */ - hmenu = keymap_panes (lpmm, &keymap, 1, notreal); - -#if 0 - /* Search for a string appearing directly as an element of the keymap. - That string is the title of the menu. */ - prompt = map_prompt (keymap); - - /* Make that be the pane title of the first pane. */ - if (!NILP (prompt) && menu_items_n_panes >= 0) - XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; -#endif - } - else if (!NILP (tem)) - { - /* We were given a list of keymaps. */ - int nmaps = XFASTINT (Flength (menu)); - Lisp_Object *maps - = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); - int i; - - title = Qnil; - - /* The first keymap that has a prompt string - supplies the menu title. */ - for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) - { - Lisp_Object prompt; - - maps[i++] = keymap = get_keymap (Fcar (tem)); -#if 0 - prompt = map_prompt (keymap); - if (NILP (title) && !NILP (prompt)) - title = prompt; -#endif - } - - /* Extract the detailed info to make one pane. */ - hmenu = keymap_panes (lpmm, maps, nmaps, notreal); - -#if 0 - /* Make the title be the pane title of the first pane. */ - if (!NILP (title) && menu_items_n_panes >= 0) - XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; -#endif - } - else - { - /* We were given an old-fashioned menu. */ - title = Fcar (menu); - CHECK_STRING (title, 1); - - hmenu = list_of_panes (lpmm, Fcdr (menu)); - } - - return (hmenu); -} - -/* This is a recursive subroutine of keymap_panes. - It handles one keymap, KEYMAP. - The other arguments are passed along - or point to local variables of the previous function. - If NOTREAL is nonzero, - don't bother really computing whether an item is enabled. */ - -Lisp_Object -get_single_keymap_event (keymap, lpnum) - Lisp_Object keymap; - int * lpnum; -{ - Lisp_Object pending_maps; - Lisp_Object tail, item, item1, item_string, table; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; - - pending_maps = Qnil; - - for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr) - { - /* Look at each key binding, and if it has a menu string, - make a menu item from it. */ - - item = XCONS (tail)->car; - - if (XTYPE (item) == Lisp_Cons) - { - item1 = XCONS (item)->cdr; - - if (CONSP (item1)) - { - item_string = XCONS (item1)->car; - if (XTYPE (item_string) == Lisp_String) - { - /* This is the real definition--the function to run. */ - - Lisp_Object def; - - /* These are the saved equivalent keyboard key sequence - and its key-description. */ - - Lisp_Object descrip; - Lisp_Object tem, enabled; - - /* GCPRO because ...enabled_p will call eval - and ..._equiv_key may autoload something. - Protecting KEYMAP preserves everything we use; - aside from that, must protect whatever might be - a string. Since there's no GCPRO5, we refetch - item_string instead of protecting it. */ - - descrip = def = Qnil; - GCPRO3 (keymap, pending_maps, def); - - def = menu_item_equiv_key (item_string, item1, &descrip); - - UNGCPRO; - - item_string = XCONS (item1)->car; - - tem = Fkeymapp (def); - if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) - { - pending_maps = Fcons (Fcons (def, - Fcons (item_string, - XCONS (item)->car)), - pending_maps); - } - else - { - Lisp_Object submap; - - GCPRO5 (keymap, pending_maps, item, item_string, descrip); - - submap = get_keymap_1 (def, 0, 1); - - UNGCPRO; - - if (NILP (submap)) - { - if (--(*lpnum) == 0) - { - return (Fcons (XCONS (item)->car, Qnil)); - } - } - else - /* Display a submenu. */ - { - Lisp_Object event = get_single_keymap_event (submap, - lpnum); - - if (*lpnum <= 0) - { - if (!NILP (XCONS (item)->car)) - event = Fcons (XCONS (item)->car, event); - - return (event); - } - } - } - } - } - } - else if (VECTORP (item)) - { - /* Loop over the char values represented in the vector. */ - int len = XVECTOR (item)->size; - int c; - for (c = 0; c < len; c++) - { - Lisp_Object character; - XSETFASTINT (character, c); - item1 = XVECTOR (item)->contents[c]; - if (XTYPE (item1) == Lisp_Cons) - { - item_string = XCONS (item1)->car; - if (XTYPE (item_string) == Lisp_String) - { - Lisp_Object def; - - /* These are the saved equivalent keyboard key sequence - and its key-description. */ - Lisp_Object descrip; - Lisp_Object tem, enabled; - - /* GCPRO because ...enabled_p will call eval - and ..._equiv_key may autoload something. - Protecting KEYMAP preserves everything we use; - aside from that, must protect whatever might be - a string. Since there's no GCPRO5, we refetch - item_string instead of protecting it. */ - GCPRO3 (keymap, pending_maps, def); - descrip = def = Qnil; - - def = menu_item_equiv_key (item_string, item1, &descrip); - - UNGCPRO; - - item_string = XCONS (item1)->car; - - tem = Fkeymapp (def); - if (XSTRING (item_string)->data[0] == '@' && !NILP (tem)) - pending_maps = Fcons (Fcons (def, Fcons (item_string, character)), - pending_maps); - else - { - Lisp_Object submap; - - GCPRO5 (keymap, pending_maps, descrip, item_string, descrip); - - submap = get_keymap_1 (def, 0, 1); - - UNGCPRO; - - if (NILP (submap)) - { - if (--(*lpnum) == 0) - { - return (Fcons (character, Qnil)); - } - } - else - /* Display a submenu. */ - { - Lisp_Object event = get_single_keymap_event (submap, - lpnum); - - if (*lpnum <= 0) - { - if (!NILP (character)) - event = Fcons (character, event); - - return (event); - } - } - } - } - } - } - } - } - - /* Process now any submenus which want to be panes at this level. */ - while (!NILP (pending_maps)) - { - Lisp_Object elt, eltcdr, string; - elt = Fcar (pending_maps); - eltcdr = XCONS (elt)->cdr; - string = XCONS (eltcdr)->car; - /* We no longer discard the @ from the beginning of the string here. - Instead, we do this in w32menu_show. */ - { - Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum); - - if (*lpnum <= 0) - { - if (!NILP (XCONS (eltcdr)->cdr)) - event = Fcons (XCONS (eltcdr)->cdr, event); - - return (event); - } - } - - pending_maps = Fcdr (pending_maps); - } - - return (Qnil); -} - -/* Look through KEYMAPS, a vector of keymaps that is NMAPS long, - and generate menu panes for them in menu_items. - If NOTREAL is nonzero, - don't bother really computing whether an item is enabled. */ - -static Lisp_Object -get_keymap_event (keymaps, nmaps, lpnum) - Lisp_Object *keymaps; - int nmaps; - int * lpnum; -{ - int mapno; - Lisp_Object event = Qnil; - - /* Loop over the given keymaps, making a pane for each map. - But don't make a pane that is empty--ignore that map instead. - P is the number of panes we have made so far. */ - for (mapno = 0; mapno < nmaps; mapno++) - { - event = get_single_keymap_event (keymaps[mapno], lpnum); - - if (*lpnum <= 0) break; - } - - return (event); -} - -static Lisp_Object -get_list_of_items_event (pane, lpnum) - Lisp_Object pane; - int * lpnum; -{ - Lisp_Object tail, item, item1; - - for (tail = pane; !NILP (tail); tail = Fcdr (tail)) - { - item = Fcar (tail); - if (STRINGP (item)) - { - if (-- (*lpnum) == 0) - { - return (Qnil); - } - } - else if (!NILP (item)) - { - if (--(*lpnum) == 0) - { - CHECK_CONS (item, 0); - return (Fcdr (item)); - } - } - } - - return (Qnil); -} - -/* 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. */ - -static Lisp_Object -get_list_of_panes_event (menu, lpnum) - Lisp_Object menu; - int * lpnum; -{ - Lisp_Object tail; - - for (tail = menu; !NILP (tail); tail = Fcdr (tail)) - { - Lisp_Object elt, pane_name, pane_data; - Lisp_Object event; - - elt = Fcar (tail); - pane_data = Fcdr (elt); - CHECK_CONS (pane_data, 0); - - event = get_list_of_items_event (pane_data, lpnum); - - if (*lpnum <= 0) - { - return (event); - } - } - - return (Qnil); -} - -Lisp_Object -get_menu_event (menu, lpnum) - Lisp_Object menu; - int * lpnum; -{ - Lisp_Object keymap, tem; - Lisp_Object event; - - /* Decode the menu items from what was specified. */ - - keymap = Fkeymapp (menu); - tem = Qnil; - if (XTYPE (menu) == Lisp_Cons) - tem = Fkeymapp (Fcar (menu)); - - if (!NILP (keymap)) - { - keymap = get_keymap (menu); - - event = get_keymap_event (&keymap, 1, lpnum); - } - else if (!NILP (tem)) - { - /* We were given a list of keymaps. */ - int nmaps = XFASTINT (Flength (menu)); - Lisp_Object *maps - = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); - int i; - - /* The first keymap that has a prompt string - supplies the menu title. */ - for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem)) - { - Lisp_Object prompt; - - maps[i++] = keymap = get_keymap (Fcar (tem)); - } - - event = get_keymap_event (maps, nmaps, lpnum); - } - else - { - /* We were given an old-fashioned menu. */ - event = get_list_of_panes_event (Fcdr (menu), lpnum); - } - - return (event); -} - -DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, - "Pop up a deck-of-cards menu and return user's selection.\n\ -POSITION is a position specification. This is either a mouse button event\n\ -or a list ((XOFFSET YOFFSET) WINDOW)\n\ -where XOFFSET and YOFFSET are positions in pixels from the top left\n\ -corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ -This controls the position of the center of the first line\n\ -in the first pane of the menu, not the top left of the menu as a whole.\n\ -If POSITION is t, it means to use the current mouse position.\n\ -\n\ -MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ -The menu items come from key bindings that have a menu string as well as\n\ -a definition; actually, the \"definition\" in such a key binding looks like\n\ -\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ -the keymap as a top-level element.\n\n\ -You can also use a list of keymaps as MENU.\n\ - Then each keymap makes a separate pane.\n\ -When MENU is a keymap or a list of keymaps, the return value\n\ -is a list of events.\n\n\ -Alternatively, you can specify a menu of multiple panes\n\ - with a list of the form (TITLE PANE1 PANE2...),\n\ -where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ -Each ITEM is normally a cons cell (STRING . VALUE);\n\ -but a string can appear as an item--that makes a nonselectable line\n\ -in the menu.\n\ -With this form of menu, the return value is VALUE from the chosen item.\n\ -\n\ -If POSITION is nil, don't display the menu at all, just precalculate the\n\ -cached information about equivalent key sequences.") - (position, menu) - Lisp_Object position, menu; +DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0, + "Pop up a deck-of-cards menu and return user's selection.\n\ +POSITION is a position specification. This is either a mouse button event\n\ +or a list ((XOFFSET YOFFSET) WINDOW)\n\ +where XOFFSET and YOFFSET are positions in pixels from the top left\n\ +corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\ +This controls the position of the center of the first line\n\ +in the first pane of the menu, not the top left of the menu as a whole.\n\ +If POSITION is t, it means to use the current mouse position.\n\ +\n\ +MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\ +The menu items come from key bindings that have a menu string as well as\n\ +a definition; actually, the \"definition\" in such a key binding looks like\n\ +\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\ +the keymap as a top-level element.\n\n\ +If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\ +Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\ +\n\ +You can also use a list of keymaps as MENU.\n\ + Then each keymap makes a separate pane.\n\ +When MENU is a keymap or a list of keymaps, the return value\n\ +is a list of events.\n\n\ +\n\ +Alternatively, you can specify a menu of multiple panes\n\ + with a list of the form (TITLE PANE1 PANE2...),\n\ +where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\ +Each ITEM is normally a cons cell (STRING . VALUE);\n\ +but a string can appear as an item--that makes a nonselectable line\n\ +in the menu.\n\ +With this form of menu, the return value is VALUE from the chosen item.\n\ +\n\ +If POSITION is nil, don't display the menu at all, just precalculate the\n\ +cached information about equivalent key sequences.") + (position, menu) + Lisp_Object position, menu; { int number_of_panes, panes; Lisp_Object keymap, tem; @@ -1220,13 +692,14 @@ cached information about equivalent key sequences.") FRAME_PTR f; Lisp_Object x, y, window; int keymaps = 0; - int menubarp = 0; + int for_click = 0; struct gcpro gcpro1; - HMENU hmenu; - menu_map mm; - + +#ifdef HAVE_MENUS if (! NILP (position)) { + check_w32 (); + /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar))) @@ -1236,10 +709,10 @@ cached information about equivalent key sequences.") Lisp_Object bar_window; int part; unsigned long time; - + if (mouse_position_hook) - (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, - &time); + (*mouse_position_hook) (&new_f, 1, &bar_window, + &part, &x, &y, &time); if (new_f != 0) XSETFRAME (window, new_f); else @@ -1260,28 +733,23 @@ cached information about equivalent key sequences.") } else { - tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ - window = Fcar (tem); /* POSN_WINDOW (tem) */ + for_click = 1; + tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ + window = Fcar (tem); /* POSN_WINDOW (tem) */ tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */ x = Fcar (tem); y = Fcdr (tem); - - /* Determine whether this menu is handling a menu bar click. */ - tem = Fcar (Fcdr (Fcar (Fcdr (position)))); - if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar)) - menubarp = 1; } } - + CHECK_NUMBER (x, 0); CHECK_NUMBER (y, 0); /* Decode where to put the menu. */ - + if (FRAMEP (window)) { f = XFRAME (window); - xpos = 0; ypos = 0; } @@ -1289,53 +757,126 @@ cached information about equivalent key sequences.") { CHECK_LIVE_WINDOW (window, 0); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); - - xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left); - ypos = (f->output_data.w32->line_height * XWINDOW (window)->top); + + xpos = (FONT_WIDTH (f->output_data.w32->font) + * XFASTINT (XWINDOW (window)->left)); + ypos = (f->output_data.w32->line_height + * XFASTINT (XWINDOW (window)->top)); } else /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); - + xpos += XINT (x); ypos += XINT (y); XSETFRAME (Vmenu_updating_frame, f); } Vmenu_updating_frame = Qnil; +#endif /* HAVE_MENUS */ title = Qnil; GCPRO1 (title); - - discard_menu_items (&mm); - hmenu = create_menu_items (&mm, menu, NILP (position)); + + /* Decode the menu items from what was specified. */ + + keymap = Fkeymapp (menu); + tem = Qnil; + if (CONSP (menu)) + tem = Fkeymapp (Fcar (menu)); + if (!NILP (keymap)) + { + /* We were given a keymap. Extract menu info from the keymap. */ + Lisp_Object prompt; + keymap = get_keymap (menu); + + /* Extract the detailed info to make one pane. */ + keymap_panes (&menu, 1, NILP (position)); + + /* Search for a string appearing directly as an element of the keymap. + That string is the title of the menu. */ + prompt = map_prompt (keymap); + if (NILP (title) && !NILP (prompt)) + title = prompt; + + /* Make that be the pane title of the first pane. */ + if (!NILP (prompt) && menu_items_n_panes >= 0) + XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt; + + keymaps = 1; + } + else if (!NILP (tem)) + { + /* We were given a list of keymaps. */ + int nmaps = XFASTINT (Flength (menu)); + Lisp_Object *maps + = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object)); + int i; + + title = Qnil; + + /* The first keymap that has a prompt string + supplies the menu title. */ + for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem)) + { + Lisp_Object prompt; + + maps[i++] = keymap = get_keymap (Fcar (tem)); + + prompt = map_prompt (keymap); + if (NILP (title) && !NILP (prompt)) + title = prompt; + } + + /* Extract the detailed info to make one pane. */ + keymap_panes (maps, nmaps, NILP (position)); + + /* Make the title be the pane title of the first pane. */ + if (!NILP (title) && menu_items_n_panes >= 0) + XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title; + + keymaps = 1; + } + else + { + /* We were given an old-fashioned menu. */ + title = Fcar (menu); + CHECK_STRING (title, 1); + + list_of_panes (Fcdr (menu)); + + keymaps = 0; + } if (NILP (position)) { - discard_menu_items (&mm); + discard_menu_items (); UNGCPRO; return Qnil; } - + +#ifdef HAVE_MENUS /* Display them in a menu. */ BLOCK_INPUT; - - selection = w32menu_show (f, xpos, ypos, menu, hmenu, &error_name); - + + selection = w32_menu_show (f, xpos, ypos, for_click, + keymaps, title, &error_name); UNBLOCK_INPUT; - - discard_menu_items (&mm); - DestroyMenu (hmenu); - + + discard_menu_items (); + UNGCPRO; - +#endif /* HAVE_MENUS */ + if (error_name) error (error_name); return selection; } +#ifdef HAVE_MENUS + DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, - "Pop up a dialog box and return user's selection.\n\ + "Pop up a dialog box and return user's selection.\n\ POSITION specifies which frame to use.\n\ This is normally a mouse button event or a window or frame.\n\ If POSITION is t, it means to use the frame the mouse is on.\n\ @@ -1349,36 +890,54 @@ An ITEM may also be just a string--that makes a nonselectable item.\n\ An ITEM may also be nil--that means to put all preceding items\n\ on the left of the dialog box and all following items on the right.\n\ \(By default, approximately half appear on each side.)") - (position, contents) - Lisp_Object position, contents; + (position, contents) + Lisp_Object position, contents; { FRAME_PTR f; Lisp_Object window; - + + check_w32 (); + /* Decode the first argument: find the window or frame to use. */ - if (EQ (position, Qt)) + if (EQ (position, Qt) + || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar))) { - /* Decode the first argument: find the window and the coordinates. */ - if (EQ (position, Qt)) +#if 0 /* Using the frame the mouse is on may not be right. */ + /* Use the mouse's current position. */ + FRAME_PTR new_f = selected_frame; + Lisp_Object bar_window; + int part; + unsigned long time; + Lisp_Object x, y; + + (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); + + if (new_f != 0) + XSETFRAME (window, new_f); + else window = selected_window; +#endif + window = selected_window; } else if (CONSP (position)) { Lisp_Object tem; tem = Fcar (position); - if (XTYPE (tem) == Lisp_Cons) + if (CONSP (tem)) window = Fcar (Fcdr (position)); else { - tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ - window = Fcar (tem); /* POSN_WINDOW (tem) */ + tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ + window = Fcar (tem); /* POSN_WINDOW (tem) */ } } else if (WINDOWP (position) || FRAMEP (position)) window = position; - + else + window = Qnil; + /* Decode where to put the menu. */ - + if (FRAMEP (window)) f = XFRAME (window); else if (WINDOWP (window)) @@ -1390,7 +949,7 @@ on the left of the dialog box and all following items on the right.\n\ /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME, but I don't want to make one now. */ CHECK_WINDOW (window, 0); - + #if 1 /* Display a menu with these alternatives in the middle of frame F. */ @@ -1418,7 +977,7 @@ on the left of the dialog box and all following items on the right.\n\ /* Display them in a dialog box. */ BLOCK_INPUT; - selection = w32_dialog_show (f, 0, 0, title, &error_name); + selection = w32_dialog_show (f, 0, title, &error_name); UNBLOCK_INPUT; discard_menu_items (); @@ -1429,68 +988,6 @@ on the left of the dialog box and all following items on the right.\n\ #endif } -Lisp_Object -get_frame_menubar_event (f, num) - FRAME_PTR f; - int num; -{ - Lisp_Object tail, items; - int i; - struct gcpro gcpro1; - - BLOCK_INPUT; - - GCPRO1 (items); - - if (NILP (items = FRAME_MENU_BAR_ITEMS (f))) - items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); - - for (i = 0; i < XVECTOR (items)->size; i += 4) - { - Lisp_Object event, binding; - binding = XVECTOR (items)->contents[i + 2]; - - /* Check to see if this might be a menubar button. It might be - if it is not a keymap, it is a cons cell, its car is not a - keymap, and its cdr is nil. */ - if (NILP (Fkeymapp (binding)) - && CONSP (binding) - && NILP (Fkeymapp (XCONS (binding)->car)) - && NILP (XCONS (binding)->cdr)) - { - /* The fact that we have to check that this is a string here - is the reason we don't do all this rigamarole in - get_menu_event. */ - if (XTYPE (XVECTOR (items)->contents[i + 1]) == Lisp_String) - { - /* This was a menubar button. */ - if (--num <= 0) - { - UNGCPRO; - UNBLOCK_INPUT; - return (Fcons (XVECTOR (items)->contents[i], Qnil)); - } - } - } - else - { - event = get_menu_event (binding, &num); - - if (num <= 0) - { - UNGCPRO; - UNBLOCK_INPUT; - return (Fcons (XVECTOR (items)->contents[i], event)); - } - } - } - - UNGCPRO; - UNBLOCK_INPUT; - - return (Qnil); -} - /* Activate the menu bar of frame F. This is called from keyboard.c when it gets the menu_bar_activate_event out of the Emacs event queue. @@ -1515,440 +1012,856 @@ x_activate_menubar (f) complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0); } -void -set_frame_menubar (f, first_time, deep_p) - FRAME_PTR f; - int first_time; - int deep_p; +/* This callback is called from the menu bar pulldown menu + when the user makes a selection. + Figure out what the user chose + and put the appropriate events into the keyboard buffer. */ + +void +menubar_selection_callback (FRAME_PTR f, void * client_data) { - Lisp_Object tail, items; - HMENU hmenu; + Lisp_Object prefix, entry; + Lisp_Object vector; + Lisp_Object *subprefix_stack; + int submenu_depth = 0; int i; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - menu_map mm; - int count = specpdl_ptr - specpdl; - struct buffer *prev = current_buffer; - Lisp_Object buffer; - - XSETFRAME (Vmenu_updating_frame, f); - - /* We must not change the menubar when actually in use. */ - if (f->output_data.w32->menubar_active) + if (!f) return; + subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object)); + vector = f->menu_bar_vector; + prefix = Qnil; + i = 0; + while (i < f->menu_bar_items_used) + { + if (EQ (XVECTOR (vector)->contents[i], Qnil)) + { + subprefix_stack[submenu_depth++] = prefix; + prefix = entry; + i++; + } + else if (EQ (XVECTOR (vector)->contents[i], Qlambda)) + { + prefix = subprefix_stack[--submenu_depth]; + i++; + } + else if (EQ (XVECTOR (vector)->contents[i], Qt)) + { + prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX]; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE]; + /* The EMACS_INT cast avoids a warning. There's no problem + as long as pointers have enough bits to hold small integers. */ + if ((int) (EMACS_INT) client_data == i) + { + int j; + struct input_event buf; + Lisp_Object frame; -#if 0 /* I don't see why this should be needed */ - /* Ensure menubar is up to date when about to be used. */ - if (f->output_data.w32->pending_menu_activation && !deep_p) - deep_p = 1; -#endif + XSETFRAME (frame, f); + buf.kind = menu_bar_event; + buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil)); + kbd_buffer_store_event (&buf); - buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; - specbind (Qinhibit_quit, Qt); - /* Don't let the debugger step into this code - because it is not reentrant. */ - specbind (Qdebug_on_next_call, Qnil); + for (j = 0; j < submenu_depth; j++) + if (!NILP (subprefix_stack[j])) + { + buf.kind = menu_bar_event; + buf.frame_or_window = Fcons (frame, subprefix_stack[j]); + kbd_buffer_store_event (&buf); + } - record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); - if (NILP (Voverriding_local_map_menu_flag)) - { - specbind (Qoverriding_terminal_local_map, Qnil); - specbind (Qoverriding_local_map, Qnil); - } + if (!NILP (prefix)) + { + buf.kind = menu_bar_event; + buf.frame_or_window = Fcons (frame, prefix); + kbd_buffer_store_event (&buf); + } - set_buffer_internal_1 (XBUFFER (buffer)); + buf.kind = menu_bar_event; + buf.frame_or_window = Fcons (frame, entry); + kbd_buffer_store_event (&buf); - /* Run the Lucid hook. */ - call1 (Vrun_hooks, Qactivate_menubar_hook); - /* If it has changed current-menubar from previous value, - really recompute the menubar from the value. */ - if (! NILP (Vlucid_menu_bar_dirty_flag)) - call0 (Qrecompute_lucid_menubar); - safe_run_hooks (Qmenu_bar_update_hook); - - BLOCK_INPUT; - - GCPRO1 (items); - - items = FRAME_MENU_BAR_ITEMS (f); - if (NILP (items)) - items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); - - hmenu = f->output_data.w32->menubar_widget; - if (!hmenu) - { - hmenu = CreateMenu (); - if (!hmenu) goto error; - } - else - { - /* Delete current contents. */ - while (DeleteMenu (hmenu, 0, MF_BYPOSITION)) - ; + return; + } + i += MENU_ITEMS_ITEM_LENGTH; + } } - - discard_menu_items (&mm); - UNBLOCK_INPUT; - - for (i = 0; i < XVECTOR (items)->size; i += 4) - { - Lisp_Object string, binding; - int keymaps; - CHAR *error; - HMENU new_hmenu; - - string = XVECTOR (items)->contents[i + 1]; - if (NILP (string)) - break; - - binding = XVECTOR (items)->contents[i + 2]; - - if (NILP (Fkeymapp (binding)) - && CONSP (binding) - && NILP (Fkeymapp (XCONS (binding)->car)) - && NILP (XCONS (binding)->cdr)) - { - /* This is a menubar button. */ - Lisp_Object descrip, def; - Lisp_Object enabled, item; - item = Fcons (string, Fcar (binding)); - descrip = def = Qnil; - UNGCPRO; - GCPRO4 (items, item, def, string); +} - def = menu_item_equiv_key (string, item, &descrip); - enabled = menu_item_enabled_p (def, 0); +/* Allocate a widget_value, blocking input. */ - UNGCPRO; - GCPRO1 (items); +widget_value * +xmalloc_widget_value () +{ + widget_value *value; - add_menu_item (&mm, hmenu, string, enabled, def, Qnil); - } - else - { - /* Input must not be blocked here because we call general - Lisp code and internal_condition_case_1. */ - new_hmenu = create_menu_items (&mm, binding, 0); - - if (!new_hmenu) - continue; - - BLOCK_INPUT; - AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, - (char *) XSTRING (string)->data); - UNBLOCK_INPUT; - } - } - BLOCK_INPUT; - { - HMENU old = f->output_data.w32->menubar_widget; - SetMenu (FRAME_W32_WINDOW (f), hmenu); - f->output_data.w32->menubar_widget = hmenu; - /* Causes flicker when menu bar is updated - DrawMenuBar (FRAME_W32_WINDOW (f)); */ - - /* Force the window size to be recomputed so that the frame's text - area remains the same, if menubar has just been created. */ - if (old == NULL) - x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); - } - - error: - set_buffer_internal_1 (prev); - UNGCPRO; + value = malloc_widget_value (); UNBLOCK_INPUT; - unbind_to (count, Qnil); + + return value; } -void -free_frame_menubar (f) - FRAME_PTR f; +/* This recursively calls free_widget_value on the tree of widgets. + It must free all data that was malloc'ed for these widget_values. + In Emacs, many slots are pointers into the data of Lisp_Strings, and + must be left alone. */ + +void +free_menubar_widget_value_tree (wv) + widget_value *wv; { - BLOCK_INPUT; + if (! wv) return; - { - HMENU old = GetMenu (FRAME_W32_WINDOW (f)); - SetMenu (FRAME_W32_WINDOW (f), NULL); - f->output_data.w32->menubar_widget = NULL; - DestroyMenu (old); - } - + wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; + + if (wv->contents && (wv->contents != (widget_value*)1)) + { + free_menubar_widget_value_tree (wv->contents); + wv->contents = (widget_value *) 0xDEADBEEF; + } + if (wv->next) + { + free_menubar_widget_value_tree (wv->next); + wv->next = (widget_value *) 0xDEADBEEF; + } + BLOCK_INPUT; + free_widget_value (wv); UNBLOCK_INPUT; } -/* Called from Fw32_create_frame 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. */ -void -initialize_frame_menubar (f) - FRAME_PTR f; -{ - set_frame_menubar (f, 1, 1); -} -#if 0 -/* If the mouse has moved to another menu bar item, - return 1 and unread a button press event for that item. - Otherwise return 0. */ +/* Return a tree of widget_value structures for a menu bar item + whose event type is ITEM_KEY (with string ITEM_NAME) + and whose contents come from the list of keymaps MAPS. */ -static int -check_mouse_other_menu_bar (f) - FRAME_PTR f; +static widget_value * +single_submenu (item_key, item_name, maps) + Lisp_Object item_key, item_name, maps; { - FRAME_PTR new_f; - Lisp_Object bar_window; - int part; - Lisp_Object x, y; - unsigned long time; + widget_value *wv, *prev_wv, *save_wv, *first_wv; + int i; + int submenu_depth = 0; + Lisp_Object length; + int len; + Lisp_Object *mapvec; + widget_value **submenu_stack; + int mapno; + int previous_items = menu_items_used; + int top_level_items = 0; - (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time); + length = Flength (maps); + len = XINT (length); - if (f == new_f && other_menu_bar_item_p (f, x, y)) + /* Convert the list MAPS into a vector MAPVEC. */ + mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object)); + for (i = 0; i < len; i++) { - unread_menu_bar_button (f, x); - return 1; + mapvec[i] = Fcar (maps); + maps = Fcdr (maps); } - return 0; -} -#endif - + menu_items_n_panes = 0; -#if 0 -static HMENU -create_menu (keymaps, error) - int keymaps; - char **error; -{ - HMENU hmenu = NULL; /* the menu we are currently working on */ - HMENU first_hmenu = NULL; - - HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU)); - Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used * - sizeof (Lisp_Object)); - int submenu_depth = 0; - int i; - - if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) + /* Loop over the given keymaps, making a pane for each map. + But don't make a pane that is empty--ignore that map instead. */ + for (i = 0; i < len; i++) { - *error = "Empty menu"; - return NULL; + if (SYMBOLP (mapvec[i]) + || (CONSP (mapvec[i]) + && NILP (Fkeymapp (mapvec[i])))) + { + /* Here we have a command at top level in the menu bar + as opposed to a submenu. */ + top_level_items = 1; + push_menu_pane (Qnil, Qnil); + push_menu_item (item_name, Qt, item_key, mapvec[i], Qnil); + } + else + single_keymap_panes (mapvec[i], item_name, item_key, 0, 10); } - - i = 0; - - /* Loop over all panes and items, filling in the tree. */ - + + /* Create a tree of widget_value objects + representing the panes and their items. */ + + submenu_stack + = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); + wv = xmalloc_widget_value (); + wv->name = "menu"; + wv->value = 0; + wv->enabled = 1; + first_wv = wv; + save_wv = 0; + prev_wv = 0; + + /* Loop over all panes and items made during this call + and construct a tree of widget_value objects. + Ignore the panes and items made by previous calls to + single_submenu, even though those are also in menu_items. */ + i = previous_items; while (i < menu_items_used) { if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) { - submenu_stack[submenu_depth++] = hmenu; + submenu_stack[submenu_depth++] = save_wv; + save_wv = prev_wv; + prev_wv = 0; i++; } else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) { - hmenu = submenu_stack[--submenu_depth]; + prev_wv = save_wv; + save_wv = submenu_stack[--submenu_depth]; i++; } -#if 0 -else if (EQ (XVECTOR (menu_items)->contents[i], Qt) - && submenu_depth != 0) - i += MENU_ITEMS_PANE_LENGTH; -#endif + else if (EQ (XVECTOR (menu_items)->contents[i], Qt) + && submenu_depth != 0) + i += MENU_ITEMS_PANE_LENGTH; /* Ignore a nil in the item list. It's meaningful only for dialog boxes. */ -else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) - i += 1; -else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) - { - /* Create a new pane. */ - - Lisp_Object pane_name; - char *pane_string; - - pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; - pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); - - if (!hmenu || strcmp (pane_string, "")) - { - HMENU new_hmenu = CreatePopupMenu (); - - if (!new_hmenu) - { - *error = "Could not create menu pane"; - goto error; - } - - if (hmenu) - { - AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string); - } - - hmenu = new_hmenu; - - if (!first_hmenu) first_hmenu = hmenu; - } - i += MENU_ITEMS_PANE_LENGTH; - } -else - { - /* Create a new item within current pane. */ + else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) + i += 1; + else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + { + /* Create a new pane. */ + Lisp_Object pane_name, prefix; + char *pane_string; + pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; + prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + pane_string = (NILP (pane_name) + ? "" : (char *) XSTRING (pane_name)->data); + /* If there is just one top-level pane, put all its items directly + under the top-level menu. */ + if (menu_items_n_panes == 1) + pane_string = ""; + + /* If the pane has a meaningful name, + make the pane a top-level menu item + with its items as a submenu beneath it. */ + if (strcmp (pane_string, "")) + { + wv = xmalloc_widget_value (); + if (save_wv) + save_wv->next = wv; + else + first_wv->contents = wv; + wv->name = pane_string; + /* Ignore the @ that means "separate pane". + This is a kludge, but this isn't worth more time. */ + if (!NILP (prefix) && wv->name[0] == '@') + wv->name++; + wv->value = 0; + wv->enabled = 1; + } + save_wv = wv; + prev_wv = 0; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip, def; + item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; + enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; + descrip + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; + def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION]; + + wv = xmalloc_widget_value (); + if (prev_wv) + prev_wv->next = wv; + else + save_wv->contents = wv; + + wv->name = (char *) XSTRING (item_name)->data; + if (!NILP (descrip)) + wv->key = (char *) XSTRING (descrip)->data; + wv->value = 0; + /* The EMACS_INT cast avoids a warning. There's no problem + as long as pointers have enough bits to hold small integers. */ + wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0); + wv->enabled = !NILP (enable); + prev_wv = wv; + + i += MENU_ITEMS_ITEM_LENGTH; + } + } + + /* If we have just one "menu item" + that was originally a button, return it by itself. */ + if (top_level_items && first_wv->contents && first_wv->contents->next == 0) + { + wv = first_wv->contents; + free_widget_value (first_wv); + return wv; + } + + return first_wv; +} + +/* Set the contents of the menubar widgets of frame F. + The argument FIRST_TIME is currently ignored; + it is set the first time this is called, from initialize_frame_menubar. */ + +void +set_frame_menubar (f, first_time, deep_p) + FRAME_PTR f; + int first_time; + int deep_p; +{ + HMENU menubar_widget = f->output_data.w32->menubar_widget; + Lisp_Object tail, items, frame; + widget_value *wv, *first_wv, *prev_wv = 0; + int i; + + /* We must not change the menubar when actually in use. */ + if (f->output_data.w32->menubar_active) + return; + + XSETFRAME (Vmenu_updating_frame, f); + + if (! menubar_widget) + deep_p = 1; + else if (pending_menu_activation && !deep_p) + deep_p = 1; + + wv = xmalloc_widget_value (); + wv->name = "menubar"; + wv->value = 0; + wv->enabled = 1; + first_wv = wv; + + if (deep_p) + { + /* Make a widget-value tree representing the entire menu trees. */ + + struct buffer *prev = current_buffer; + Lisp_Object buffer; + int specpdl_count = specpdl_ptr - specpdl; + int previous_menu_items_used = f->menu_bar_items_used; + Lisp_Object *previous_items + = (Lisp_Object *) alloca (previous_menu_items_used + * sizeof (Lisp_Object)); + + /* If we are making a new widget, its contents are empty, + do always reinitialize them. */ + if (! menubar_widget) + previous_menu_items_used = 0; + + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; + specbind (Qinhibit_quit, Qt); + /* Don't let the debugger step into this code + because it is not reentrant. */ + specbind (Qdebug_on_next_call, Qnil); + + record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); + if (NILP (Voverriding_local_map_menu_flag)) + { + specbind (Qoverriding_terminal_local_map, Qnil); + specbind (Qoverriding_local_map, Qnil); + } + + set_buffer_internal_1 (XBUFFER (buffer)); + + /* Run the Lucid hook. */ + call1 (Vrun_hooks, Qactivate_menubar_hook); + /* If it has changed current-menubar from previous value, + really recompute the menubar from the value. */ + if (! NILP (Vlucid_menu_bar_dirty_flag)) + call0 (Qrecompute_lucid_menubar); + safe_run_hooks (Qmenu_bar_update_hook); + FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + + items = FRAME_MENU_BAR_ITEMS (f); + + inhibit_garbage_collection (); + + /* Save the frame's previous menu bar contents data. */ + bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items, + previous_menu_items_used * sizeof (Lisp_Object)); + + /* Fill in the current menu bar contents. */ + menu_items = f->menu_bar_vector; + menu_items_allocated = XVECTOR (menu_items)->size; + init_menu_items (); + for (i = 0; i < XVECTOR (items)->size; i += 4) + { + Lisp_Object key, string, maps; + + key = XVECTOR (items)->contents[i]; + string = XVECTOR (items)->contents[i + 1]; + maps = XVECTOR (items)->contents[i + 2]; + if (NILP (string)) + break; + + wv = single_submenu (key, string, maps); + if (prev_wv) + prev_wv->next = wv; + else + first_wv->contents = wv; + /* Don't set wv->name here; GC during the loop might relocate it. */ + wv->enabled = 1; + prev_wv = wv; + } + + finish_menu_items (); + + set_buffer_internal_1 (prev); + unbind_to (specpdl_count, Qnil); + + /* If there has been no change in the Lisp-level contents + of the menu bar, skip redisplaying it. Just exit. */ + + for (i = 0; i < previous_menu_items_used; i++) + if (menu_items_used == i + || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i]))) + break; + if (i == menu_items_used && i == previous_menu_items_used && i != 0) + { + free_menubar_widget_value_tree (first_wv); + menu_items = Qnil; + + return; + } + + /* Now GC cannot happen during the lifetime of the widget_value, + so it's safe to store data from a Lisp_String. */ + wv = first_wv->contents; + for (i = 0; i < XVECTOR (items)->size; i += 4) + { + Lisp_Object string; + string = XVECTOR (items)->contents[i + 1]; + if (NILP (string)) + break; + wv->name = (char *) XSTRING (string)->data; + wv = wv->next; + } + + f->menu_bar_vector = menu_items; + f->menu_bar_items_used = menu_items_used; + menu_items = Qnil; + } + else + { + /* Make a widget-value tree containing + just the top level menu bar strings. + + It turns out to be worth comparing the new contents with the + previous contents to avoid unnecessary rebuilding even of just + the top-level menu bar, which turns out to be fairly slow. We + co-opt f->menu_bar_vector for this purpose, since its contents + are effectively discarded at this point anyway. + + Note that the lisp-level hooks have already been run by + update_menu_bar - it's kinda a shame the code is duplicated + above as well for deep_p, but there we are. */ + + items = FRAME_MENU_BAR_ITEMS (f); + + /* If there has been no change in the Lisp-level contents of just + the menu bar itself, skip redisplaying it. Just exit. */ + for (i = 0; i < f->menu_bar_items_used; i += 4) + if (i == XVECTOR (items)->size + || (XVECTOR (f->menu_bar_vector)->contents[i] + != XVECTOR (items)->contents[i])) + break; + if (i == XVECTOR (items)->size && i == f->menu_bar_items_used && i != 0) + return; + + for (i = 0; i < XVECTOR (items)->size; i += 4) + { + Lisp_Object string; + + string = XVECTOR (items)->contents[i + 1]; + if (NILP (string)) + break; + + wv = xmalloc_widget_value (); + wv->name = (char *) XSTRING (string)->data; + wv->value = 0; + wv->enabled = 1; + /* This prevents lwlib from assuming this + menu item is really supposed to be empty. */ + /* The EMACS_INT cast avoids a warning. + This value just has to be different from small integers. */ + wv->call_data = (void *) (EMACS_INT) (-1); + + if (prev_wv) + prev_wv->next = wv; + else + first_wv->contents = wv; + prev_wv = wv; + } + + /* Remember the contents of FRAME_MENU_BAR_ITEMS (f) in + f->menu_bar_vector, so we can check whether the top-level + menubar contents have changed next time. */ + if (XVECTOR (f->menu_bar_vector)->size < XVECTOR (items)->size) + f->menu_bar_vector + = Fmake_vector (make_number (XVECTOR (items)->size), Qnil); + bcopy (XVECTOR (items)->contents, + XVECTOR (f->menu_bar_vector)->contents, + XVECTOR (items)->size * sizeof (Lisp_Object)); + f->menu_bar_items_used = XVECTOR (items)->size; + } + + /* Create or update the menu bar widget. */ - Lisp_Object item_name, enable, descrip; - UINT fuFlags; + BLOCK_INPUT; - item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; - enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; - // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; + if (menubar_widget) + { + /* Empty current menubar, rather than creating a fresh one. */ + while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION)) + ; + } + else + { + menubar_widget = CreateMenu (); + } + fill_in_menu (menubar_widget, first_wv->contents); - if (name_is_separator (item_name)) - fuFlags = MF_SEPARATOR; - else if (NILP (enable) || !XUINT (enable)) - fuFlags = MF_STRING | MF_GRAYED; - else - fuFlags = MF_STRING; + free_menubar_widget_value_tree (first_wv); - AppendMenu (hmenu, - fuFlags, - i, - (char *) XSTRING (item_name)->data); + { + HMENU old_widget = f->output_data.w32->menubar_widget; - // if (!NILP (descrip)) - // hmenu->key = (char *) XSTRING (descrip)->data; + f->output_data.w32->menubar_widget = menubar_widget; + SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget); + /* Causes flicker when menu bar is updated + DrawMenuBar (FRAME_W32_WINDOW (f)); */ - i += MENU_ITEMS_ITEM_LENGTH; + /* Force the window size to be recomputed so that the frame's text + area remains the same, if menubar has just been created. */ + if (old_widget == NULL) + x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f)); } + + UNBLOCK_INPUT; } - return (first_hmenu); - - error: - if (first_hmenu) DestroyMenu (first_hmenu); - return (NULL); +/* Called from Fx_create_frame 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. */ + +void +initialize_frame_menubar (f) + FRAME_PTR f; +{ + /* This function is called before the first chance to redisplay + the frame. It has to be, so the frame will have the right size. */ + FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + set_frame_menubar (f, 1, 1); } -#endif +/* Get rid of the menu bar of frame F, and free its storage. + This is used when deleting a frame, and when turning off the menu bar. */ + +void +free_frame_menubar (f) + FRAME_PTR f; +{ + BLOCK_INPUT; + + { + HMENU old = GetMenu (FRAME_W32_WINDOW (f)); + SetMenu (FRAME_W32_WINDOW (f), NULL); + f->output_data.w32->menubar_widget = NULL; + DestroyMenu (old); + } + + UNBLOCK_INPUT; +} -/* w32menu_show actually displays a menu using the panes and items in - menu_items and returns the value selected from it. - There are two versions of w32menu_show, one for Xt and one for Xlib. - Both assume input is blocked by the caller. */ + +/* w32_menu_show actually displays a menu using the panes and items in + menu_items and returns the value selected from it; we assume input + is blocked by the caller. */ /* F is the frame the menu is for. X and Y are the frame-relative specified position, relative to the inside upper left corner of the frame F. - MENUBARP is 1 if the click that asked for this menu came from the menu bar. + FOR_CLICK is nonzero if this menu was invoked for a mouse click. KEYMAPS is 1 if this menu was specified with keymaps; - in that case, we return a list containing the chosen item's value - and perhaps also the pane's prefix. + in that case, we return a list containing the chosen item's value + and perhaps also the pane's prefix. TITLE is the specified menu title. ERROR is a place to store an error message string in case of failure. (We return nil on failure, but the value doesn't actually matter.) */ - -static Lisp_Object -w32menu_show (f, x, y, menu, hmenu, error) +static Lisp_Object +w32_menu_show (f, x, y, for_click, keymaps, title, error) FRAME_PTR f; int x; int y; - Lisp_Object menu; - HMENU hmenu; + int for_click; + int keymaps; + Lisp_Object title; char **error; { - int i , menu_selection; + int i; + int menu_item_selection; + HMENU menu; POINT pos; - + widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; + widget_value **submenu_stack + = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); + Lisp_Object *subprefix_stack + = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); + int submenu_depth = 0; + + int first_pane; + int next_release_must_exit = 0; + *error = NULL; - - if (!hmenu) + + if (menu_items_used <= MENU_ITEMS_PANE_LENGTH) { *error = "Empty menu"; return Qnil; } - + + /* Create a tree of widget_value objects + representing the panes and their items. */ + wv = xmalloc_widget_value (); + wv->name = "menu"; + wv->value = 0; + wv->enabled = 1; + first_wv = wv; + first_pane = 1; + + /* Loop over all panes and items, filling in the tree. */ + i = 0; + while (i < menu_items_used) + { + if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + { + submenu_stack[submenu_depth++] = save_wv; + save_wv = prev_wv; + prev_wv = 0; + first_pane = 1; + i++; + } + else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + { + prev_wv = save_wv; + save_wv = submenu_stack[--submenu_depth]; + first_pane = 0; + i++; + } + else if (EQ (XVECTOR (menu_items)->contents[i], Qt) + && submenu_depth != 0) + i += MENU_ITEMS_PANE_LENGTH; + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) + i += 1; + else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + { + /* Create a new pane. */ + Lisp_Object pane_name, prefix; + char *pane_string; + pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME]; + prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + pane_string = (NILP (pane_name) + ? "" : (char *) XSTRING (pane_name)->data); + /* If there is just one top-level pane, put all its items directly + under the top-level menu. */ + if (menu_items_n_panes == 1) + pane_string = ""; + + /* If the pane has a meaningful name, + make the pane a top-level menu item + with its items as a submenu beneath it. */ + if (!keymaps && strcmp (pane_string, "")) + { + wv = xmalloc_widget_value (); + if (save_wv) + save_wv->next = wv; + else + first_wv->contents = wv; + wv->name = pane_string; + if (keymaps && !NILP (prefix)) + wv->name++; + wv->value = 0; + wv->enabled = 1; + save_wv = wv; + prev_wv = 0; + } + else if (first_pane) + { + save_wv = wv; + prev_wv = 0; + } + first_pane = 0; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip, def; + item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME]; + enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE]; + descrip + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY]; + def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION]; + + wv = xmalloc_widget_value (); + if (prev_wv) + prev_wv->next = wv; + else + save_wv->contents = wv; + wv->name = (char *) XSTRING (item_name)->data; + if (!NILP (descrip)) + wv->key = (char *) XSTRING (descrip)->data; + wv->value = 0; + /* Use the contents index as call_data, since we are + restricted to 16-bits.. */ + wv->call_data = (void *) (EMACS_INT) i; + wv->enabled = !NILP (enable); + prev_wv = wv; + + i += MENU_ITEMS_ITEM_LENGTH; + } + } + + /* Deal with the title, if it is non-nil. */ + if (!NILP (title)) + { + widget_value *wv_title = xmalloc_widget_value (); + widget_value *wv_sep = xmalloc_widget_value (); + + /* Maybe replace this separator with a bitmap or owner-draw item + so that it looks better. Having two separators looks odd. */ + wv_sep->name = "--"; + wv_sep->next = first_wv->contents; + + wv_title->name = (char *) XSTRING (title)->data; + /* Handle title specially, so it looks better. */ + wv_title->title = True; + wv_title->next = wv_sep; + first_wv->contents = wv_title; + } + + /* Actually create the menu. */ + menu = CreatePopupMenu (); + fill_in_menu (menu, first_wv->contents); + + /* Adjust coordinates to be root-window-relative. */ pos.x = x; pos.y = y; - - /* Offset the coordinates to root-relative. */ ClientToScreen (FRAME_W32_WINDOW (f), &pos); - -#if 0 - /* If the mouse moves out of the menu before we show the menu, - don't show it at all. */ - if (check_mouse_other_menu_bar (f)) - { - DestroyMenu (hmenu); - return Qnil; - } -#endif + + /* Free the widget_value objects we used to specify the contents. */ + free_menubar_widget_value_tree (first_wv); + + /* No selection has been chosen yet. */ + menu_item_selection = 0; /* Display the menu. */ - menu_selection = SendMessage (FRAME_W32_WINDOW (f), - WM_EMACS_TRACKPOPUPMENU, - (WPARAM)hmenu, (LPARAM)&pos); + menu_item_selection = SendMessage (FRAME_W32_WINDOW (f), + WM_EMACS_TRACKPOPUPMENU, + (WPARAM)menu, (LPARAM)&pos); /* Clean up extraneous mouse events which might have been generated during the call. */ discard_mouse_events (); - if (menu_selection == -1) - { - *error = "Invalid menu specification"; - return Qnil; - } - + DestroyMenu (menu); + /* Find the selected item, and its pane, to return the proper value. */ - -#if 1 - if (menu_selection > 0) - { - return get_menu_event (menu, &menu_selection); - } -#else - if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used) + if (menu_item_selection != 0) { - return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]); + Lisp_Object prefix, entry; + + prefix = Qnil; + i = 0; + while (i < menu_items_used) + { + if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + { + subprefix_stack[submenu_depth++] = prefix; + prefix = entry; + i++; + } + else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + { + prefix = subprefix_stack[--submenu_depth]; + i++; + } + else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + { + prefix + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + i += MENU_ITEMS_PANE_LENGTH; + } + /* Ignore a nil in the item list. + It's meaningful only for dialog boxes. */ + else if (EQ (XVECTOR (menu_items)->contents[i], Qquote)) + i += 1; + else + { + entry + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; + if (menu_item_selection == i) + { + if (keymaps != 0) + { + int j; + + entry = Fcons (entry, Qnil); + if (!NILP (prefix)) + entry = Fcons (prefix, entry); + for (j = submenu_depth - 1; j >= 0; j--) + if (!NILP (subprefix_stack[j])) + entry = Fcons (subprefix_stack[j], entry); + } + return entry; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } } -#endif return Qnil; } + -#if 0 -static char * button_names [] = -{ +static char * button_names [] = { "button1", "button2", "button3", "button4", "button5", - "button6", "button7", "button8", "button9", "button10" -}; + "button6", "button7", "button8", "button9", "button10" }; static Lisp_Object -w32_dialog_show (f, menubarp, keymaps, title, error) +w32_dialog_show (f, keymaps, title, error) FRAME_PTR f; - int menubarp; int keymaps; Lisp_Object title; char **error; { int i, nb_buttons=0; - HMENU hmenu; char dialog_name[6]; - + int menu_item_selection; + + widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; + /* Number of elements seen so far, before boundary. */ int left_count = 0; /* 1 means we've seen the boundary between left-hand elts and right-hand. */ int boundary_seen = 0; - + *error = NULL; - + if (menu_items_n_panes > 1) { *error = "Multiple panes in dialog box"; return Qnil; } - + /* Create a tree of widget_value objects representing the text label and buttons. */ { @@ -1958,14 +1871,14 @@ w32_dialog_show (f, menubarp, keymaps, title, error) prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data); - prev_wv = malloc_widget_value (); + prev_wv = xmalloc_widget_value (); prev_wv->value = pane_string; if (keymaps && !NILP (prefix)) prev_wv->name++; prev_wv->enabled = 1; prev_wv->name = "message"; first_wv = prev_wv; - + /* Loop over all panes and items, filling in the tree. */ i = MENU_ITEMS_PANE_LENGTH; while (i < menu_items_used) @@ -1992,14 +1905,14 @@ w32_dialog_show (f, menubarp, keymaps, title, error) i++; continue; } - if (nb_buttons >= 10) + if (nb_buttons >= 9) { free_menubar_widget_value_tree (first_wv); *error = "Too many dialog items"; return Qnil; } - - wv = malloc_widget_value (); + + wv = xmalloc_widget_value (); prev_wv->next = wv; wv->name = (char *) button_names[nb_buttons]; if (!NILP (descrip)) @@ -2008,22 +1921,22 @@ w32_dialog_show (f, menubarp, keymaps, title, error) wv->call_data = (void *) &XVECTOR (menu_items)->contents[i]; wv->enabled = !NILP (enable); prev_wv = wv; - + if (! boundary_seen) left_count++; - + nb_buttons++; i += MENU_ITEMS_ITEM_LENGTH; } - + /* If the boundary was not specified, by default put half on the left and half on the right. */ if (! boundary_seen) left_count = nb_buttons - nb_buttons / 2; - - wv = malloc_widget_value (); + + wv = xmalloc_widget_value (); wv->name = dialog_name; - + /* Dialog boxes use a really stupid name encoding which specifies how many buttons to use and how many buttons are on the right. @@ -2038,76 +1951,39 @@ w32_dialog_show (f, menubarp, keymaps, title, error) wv->contents = first_wv; first_wv = wv; } - + /* Actually create the dialog. */ - dialog_id = ++popup_id_tick; +#if 0 + dialog_id = widget_id_tick++; menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, f->output_data.w32->widget, 1, 0, dialog_selection_callback, 0); -#if 0 /* This causes crashes, and seems to be redundant -- rms. */ - lw_modify_all_widgets (dialog_id, first_wv, True); -#endif lw_modify_all_widgets (dialog_id, first_wv->contents, True); +#endif + /* Free the widget_value objects we used to specify the contents. */ free_menubar_widget_value_tree (first_wv); - + /* No selection has been chosen yet. */ menu_item_selection = 0; - + /* Display the menu. */ +#if 0 lw_pop_up_all_widgets (dialog_id); - + popup_activated_flag = 1; + /* Process events that apply to the menu. */ - while (1) - { - XEvent event; - - XtAppNextEvent (Xt_app_con, &event); - if (event.type == ButtonRelease) - { - XtDispatchEvent (&event); - break; - } - else if (event.type == Expose) - process_expose_from_menu (event); - XtDispatchEvent (&event); - if (XtWindowToWidget(XDISPLAY event.xany.window) != menu) - { - queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue)); + popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id); - if (queue_tmp != NULL) - { - queue_tmp->event = event; - queue_tmp->next = queue; - queue = queue_tmp; - } - } - } - pop_down: + lw_destroy_all_widgets (dialog_id); +#endif - /* State that no mouse buttons are now held. - That is not necessarily true, but the fiction leads to reasonable - results, and it is a pain to ask which are actually held now - or track this in the loop above. */ - w32_mouse_grabbed = 0; - - /* Unread any events that we got but did not handle. */ - while (queue != NULL) - { - queue_tmp = queue; - XPutBackEvent (XDISPLAY &queue_tmp->event); - queue = queue_tmp->next; - free ((char *)queue_tmp); - /* Cause these events to get read as soon as we UNBLOCK_INPUT. */ - interrupt_input_pending = 1; - } - /* Find the selected item, and its pane, to return the proper value. */ if (menu_item_selection != 0) { Lisp_Object prefix; - + prefix = Qnil; i = 0; while (i < menu_items_used) @@ -2124,7 +2000,7 @@ w32_dialog_show (f, menubarp, keymaps, title, error) { entry = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; - if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) + if (menu_item_selection == i) { if (keymaps != 0) { @@ -2138,21 +2014,121 @@ w32_dialog_show (f, menubarp, keymaps, title, error) } } } - + return Qnil; } + + +/* Is this item a separator? */ +static int +name_is_separator (name) + char *name; +{ + /* Check if name string consists of only dashes ('-') */ + while (*name == '-') name++; + return (*name == '\0'); +} + + +/* Indicate boundary between left and right. */ +static int +add_left_right_boundary (HMENU menu) +{ + return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL); +} + +static int +add_menu_item (HMENU menu, widget_value *wv, HMENU item) +{ + UINT fuFlags; + char *out_string; + + if (name_is_separator (wv->name)) + fuFlags = MF_SEPARATOR; + else + { + if (wv->enabled) + fuFlags = MF_STRING; + else + fuFlags = MF_STRING | MF_GRAYED; + + if (wv->key != NULL) + { + out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2); + strcpy (out_string, wv->name); + strcat (out_string, "\t"); + strcat (out_string, wv->key); + } + else + out_string = wv->name; + + if (wv->title) + { +#if 0 /* no GC while popup menu is active */ + out_string = LocalAlloc (0, strlen (wv->name) + 1); + strcpy (out_string, wv->name); #endif + fuFlags = MF_OWNERDRAW | MF_DISABLED; + } + } + + if (item != NULL) + fuFlags = MF_POPUP; + + return AppendMenu (menu, + fuFlags, + item != NULL ? (UINT) item : (UINT) wv->call_data, + (fuFlags == MF_SEPARATOR) ? NULL: out_string ); +} + +/* Construct native Windows menu(bar) based on widget_value tree. */ +static int +fill_in_menu (HMENU menu, widget_value *wv) +{ + int items_added = 0; + for ( ; wv != NULL; wv = wv->next) + { + if (wv->contents) + { + HMENU sub_menu = CreatePopupMenu (); + + if (sub_menu == NULL) + return 0; + + if (!fill_in_menu (sub_menu, wv->contents) || + !add_menu_item (menu, wv, sub_menu)) + { + DestroyMenu (sub_menu); + return 0; + } + } + else + { + if (!add_menu_item (menu, wv, NULL)) + return 0; + } + } + return 1; +} + +#endif /* HAVE_MENUS */ + syms_of_w32menu () { + staticpro (&menu_items); + menu_items = Qnil; + Qdebug_on_next_call = intern ("debug-on-next-call"); staticpro (&Qdebug_on_next_call); DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame, - "Frame for which we are updating a menu\n\ + "Frame for which we are updating a menu.\n\ The enable predicate for a menu command should check this variable."); Vmenu_updating_frame = Qnil; defsubr (&Sx_popup_menu); +#ifdef HAVE_MENUS defsubr (&Sx_popup_dialog); +#endif }