diff options
author | Geoff Voelker <voelker@cs.washington.edu> | 1995-11-07 07:52:28 +0000 |
---|---|---|
committer | Geoff Voelker <voelker@cs.washington.edu> | 1995-11-07 07:52:28 +0000 |
commit | e424b4505a6a25a4ac1facf5da56988a69ed3054 (patch) | |
tree | a473da6398dafcd8e6139aae7d5082dc3049680f /src/w32menu.c | |
parent | 599175a821b5043c79e3cd1ab7ef12803561d984 (diff) | |
download | emacs-e424b4505a6a25a4ac1facf5da56988a69ed3054.tar.gz |
Initial revision
Diffstat (limited to 'src/w32menu.c')
-rw-r--r-- | src/w32menu.c | 1917 |
1 files changed, 1917 insertions, 0 deletions
diff --git a/src/w32menu.c b/src/w32menu.c new file mode 100644 index 00000000000..e07255021e6 --- /dev/null +++ b/src/w32menu.c @@ -0,0 +1,1917 @@ +/* X Communication module for terminals which understand the X protocol. + Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + +/* Written by Kevin Gallo. */ + +#include <signal.h> +#include <config.h> + +#include <stdio.h> +#include "lisp.h" +#include "termhooks.h" +#include "frame.h" +#include "window.h" +#include "keyboard.h" +#include "blockinput.h" + +/* This may include sys/types.h, and that somehow loses + if this is not done before the other system files. */ +#include "w32term.h" + +/* Load sys/types.h if not already loaded. + In some systems loading it twice is suicidal. */ +#ifndef makedev +#include <sys/types.h> +#endif + +#include "dispextern.h" + +#define min(x, y) (((x) < (y)) ? (x) : (y)) +#define max(x, y) (((x) > (y)) ? (x) : (y)) + +typedef struct menu_map +{ + Lisp_Object menu_items; + int menu_items_allocated; + int menu_items_used; +} menu_map; + +extern Lisp_Object Qmenu_enable; +extern Lisp_Object Qmenu_bar; + +static Lisp_Object win32_dialog_show (); +static Lisp_Object win32menu_show (); + +static HMENU keymap_panes (); +static HMENU single_keymap_panes (); +static HMENU list_of_panes (); +static HMENU list_of_items (); + +static HMENU create_menu_items (); + +/* Initialize the menu_items structure if we haven't already done so. + Also mark it as currently empty. */ + +static void +init_menu_items (lpmm) + menu_map * lpmm; +{ + if (NILP (lpmm->menu_items)) + { + lpmm->menu_items_allocated = 60; + lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated), + Qnil); + } + + lpmm->menu_items_used = 0; +} + +/* Call when finished using the data for the current menu + in menu_items. */ + +static void +discard_menu_items (lpmm) + menu_map * lpmm; +{ + lpmm->menu_items = Qnil; + lpmm->menu_items_allocated = lpmm->menu_items_used = 0; +} + +/* Make the menu_items vector twice as large. */ + +static void +grow_menu_items (lpmm) + menu_map * lpmm; +{ + 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; +} + +/* Indicate boundary between left and right. */ + +static void +add_left_right_boundary (hmenu) + HMENU hmenu; +{ + AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL); +} + +/* 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) + menu_map * lpmm; + HMENU hmenu; + Lisp_Object name; + UINT enable; + Lisp_Object key; +{ + UINT fuFlags; + + if (NILP (name) + || ((char *) XSTRING (name)->data)[0] == 0 + || strcmp ((char *) XSTRING (name)->data, "--") == 0) + fuFlags = MF_SEPARATOR; + else if (enable) + fuFlags = MF_STRING; + else + fuFlags = MF_STRING | MF_GRAYED; + + AppendMenu (hmenu, + fuFlags, + lpmm->menu_items_used + 1, + (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->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 +} + +/* 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; +{ + /* 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; + } + + UNGCPRO; + *descrip_ptr = descrip; + return def; +} + +/* This is used as the handler when calling internal_condition_case_1. */ + +static Lisp_Object +menu_item_enabled_p_1 (arg) + Lisp_Object arg; +{ + return Qnil; +} + +/* 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. */ + +static Lisp_Object +menu_item_enabled_p (def, notreal) + Lisp_Object def; +{ + Lisp_Object enabled, tem; + + 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; +} + +/* 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 HMENU +keymap_panes (lpmm, keymaps, nmaps, notreal) + menu_map * lpmm; + Lisp_Object *keymaps; + int nmaps; + int notreal; +{ + int mapno; + + // init_menu_items (lpmm); + + if (nmaps > 1) + { + HMENU hmenu; + + if (!notreal) + { + hmenu = CreateMenu (); + + 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, ""); + } + } + + return (hmenu); + } + else + { + return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal)); + } +} + +/* 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. */ + +HMENU +single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal) + menu_map * lpmm; + Lisp_Object keymap; + Lisp_Object pane_name; + Lisp_Object prefix; + int notreal; +{ + Lisp_Object pending_maps; + Lisp_Object tail, item, item1, item_string, table; + HMENU hmenu; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + + if (!notreal) + { + hmenu = CreateMenu (); + if (hmenu == NULL) return NULL; + } + else + { + hmenu = NULL; + } + + 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 (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); + enabled = menu_item_enabled_p (def, notreal); + + 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; + + GCPRO4 (keymap, pending_maps, item, item_string); + + 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)); + } + } + 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); + } + } + } + } + } + } + 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 (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. */ + GCPRO4 (keymap, pending_maps, def, descrip); + descrip = def = Qnil; + + def = menu_item_equiv_key (item_string, item1, &descrip); + enabled = menu_item_enabled_p (def, notreal); + + 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; + + GCPRO4 (keymap, pending_maps, descrip, item_string); + + submap = get_keymap_1 (def, 0, 1); + + UNGCPRO; + + if (NILP (submap)) + { + if (!notreal) + { + add_menu_item (lpmm, + hmenu, + item_string, + !NILP (enabled), + character); + } + } + 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); + } + } + } + } + } + } + } + } + + /* 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 win32menu_show. */ + { + HMENU new_hmenu = single_keymap_panes (lpmm, + Fcar (elt), + string, + XCONS (eltcdr)->cdr, notreal); + + if (!notreal) + { + AppendMenu (hmenu, MF_POPUP, + (UINT)new_hmenu, + (char *) XSTRING (string)->data); + } + } + + pending_maps = Fcdr (pending_maps); + } + + return (hmenu); +} + +/* Push all the panes and items of a menu decsribed 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; + Lisp_Object menu; +{ + Lisp_Object tail; + HMENU hmenu; + + hmenu = CreateMenu (); + 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); + + new_hmenu = list_of_items (lpmm, pane_data); + if (new_hmenu == NULL) goto error; + + AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, + (char *) XSTRING (pane_name)->data); + } + + return (hmenu); + + error: + DestroyMenu (hmenu); + + return (NULL); +} + +/* Push the items in a single pane defined by the alist PANE. */ + +static HMENU +list_of_items (lpmm, pane) + menu_map * lpmm; + Lisp_Object pane; +{ + Lisp_Object tail, item, item1; + HMENU hmenu; + + hmenu = CreateMenu (); + 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, Qnil, Qnil); + else if (NILP (item)) + add_left_right_boundary (); + else + { + CHECK_CONS (item, 0); + item1 = Fcar (item); + CHECK_STRING (item1, 1); + add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item)); + } + } + + 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; + + 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; + + GCPRO4 (keymap, pending_maps, item, item_string); + + 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. */ + GCPRO4 (keymap, pending_maps, def, descrip); + 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; + + GCPRO4 (keymap, pending_maps, descrip, item_string); + + 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 win32menu_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 decsribed 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 (menu, 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; +{ + int number_of_panes, panes; + Lisp_Object keymap, tem; + int xpos, ypos; + Lisp_Object title; + char *error_name; + Lisp_Object selection; + int i, j; + FRAME_PTR f; + Lisp_Object x, y, window; + int keymaps = 0; + int menubarp = 0; + struct gcpro gcpro1; + HMENU hmenu; + menu_map mm; + + if (! NILP (position)) + { + /* Decode the first argument: find the window and the coordinates. */ + if (EQ (position, Qt)) + { + /* Use the mouse's current position. */ + FRAME_PTR new_f = 0; + Lisp_Object bar_window; + int part; + unsigned long time; + + if (mouse_position_hook) + (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); + if (new_f != 0) + XSETFRAME (window, new_f); + else + { + window = selected_window; + XSETFASTINT (x, 0); + XSETFASTINT (y, 0); + } + } + else + { + tem = Fcar (position); + if (CONSP (tem)) + { + window = Fcar (Fcdr (position)); + x = Fcar (tem); + y = Fcar (Fcdr (tem)); + } + else + { + 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; + } + else if (WINDOWP (window)) + { + CHECK_LIVE_WINDOW (window, 0); + f = XFRAME (WINDOW_FRAME (XWINDOW (window))); + + xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left); + ypos = (f->output_data.win32->line_height * 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); + } + + title = Qnil; + GCPRO1 (title); + + discard_menu_items (&mm); + hmenu = create_menu_items (&mm, menu, NILP (position)); + + if (NILP (position)) + { + discard_menu_items (&mm); + UNGCPRO; + return Qnil; + } + + /* Display them in a menu. */ + BLOCK_INPUT; + + selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name); + + UNBLOCK_INPUT; + + discard_menu_items (&mm); + DestroyMenu (hmenu); + + UNGCPRO; + + if (error_name) error (error_name); + return selection; +} + +DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0, + "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\ +The dialog box appears in the middle of the specified frame.\n\ +\n\ +CONTENTS specifies the alternatives to display in the dialog box.\n\ +It is a list of the form (TITLE ITEM1 ITEM2...).\n\ +Each ITEM is a cons cell (STRING . VALUE).\n\ +The return value is VALUE from the chosen item.\n\n\ +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; +{ + FRAME_PTR f; + Lisp_Object window; + + /* Decode the first argument: find the window or frame to use. */ + if (EQ (position, Qt)) + { + /* Decode the first argument: find the window and the coordinates. */ + if (EQ (position, Qt)) + window = selected_window; + } + else if (CONSP (position)) + { + Lisp_Object tem; + tem = Fcar (position); + if (XTYPE (tem) == Lisp_Cons) + window = Fcar (Fcdr (position)); + else + { + tem = Fcar (Fcdr (position)); /* EVENT_START (position) */ + window = Fcar (tem); /* POSN_WINDOW (tem) */ + } + } + else if (WINDOWP (position) || FRAMEP (position)) + window = position; + + /* Decode where to put the menu. */ + + if (FRAMEP (window)) + f = XFRAME (window); + else if (WINDOWP (window)) + { + CHECK_LIVE_WINDOW (window, 0); + f = XFRAME (WINDOW_FRAME (XWINDOW (window))); + } + else + /* ??? 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. */ + { + Lisp_Object x, y, frame, newpos; + XSETFRAME (frame, f); + XSETINT (x, x_pixel_width (f) / 2); + XSETINT (y, x_pixel_height (f) / 2); + newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil)); + + return Fx_popup_menu (newpos, + Fcons (Fcar (contents), Fcons (contents, Qnil))); + } +#else + { + Lisp_Object title; + char *error_name; + Lisp_Object selection; + + /* Decode the dialog items from what was specified. */ + title = Fcar (contents); + CHECK_STRING (title, 1); + + list_of_panes (Fcons (contents, Qnil)); + + /* Display them in a dialog box. */ + BLOCK_INPUT; + selection = win32_dialog_show (f, 0, 0, title, &error_name); + UNBLOCK_INPUT; + + discard_menu_items (); + + if (error_name) error (error_name); + return selection; + } +#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 += 3) + { + Lisp_Object event; + + event = get_menu_event (XVECTOR (items)->contents[i + 2], &num); + + if (num <= 0) + { + UNGCPRO; + UNBLOCK_INPUT; + return (Fcons (XVECTOR (items)->contents[i], event)); + } + } + + UNGCPRO; + UNBLOCK_INPUT; + + return (Qnil); +} + +void +set_frame_menubar (f, first_time) + FRAME_PTR f; + int first_time; +{ + Lisp_Object tail, items; + HMENU hmenu; + int i; + struct gcpro gcpro1; + menu_map mm; + + 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)); + + hmenu = CreateMenu (); + + if (!hmenu) goto error; + + discard_menu_items (&mm); + + for (i = 0; i < XVECTOR (items)->size; i += 3) + { + Lisp_Object string; + int keymaps; + CHAR *error; + HMENU new_hmenu; + + string = XVECTOR (items)->contents[i + 1]; + if (NILP (string)) + break; + + new_hmenu = create_menu_items (&mm, + XVECTOR (items)->contents[i + 2], + 0); + + if (!new_hmenu) + continue; + + AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, + (char *) XSTRING (string)->data); + } + + { + HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); + SetMenu (FRAME_WIN32_WINDOW (f), hmenu); + DestroyMenu (old); + } + + error: + UNGCPRO; + UNBLOCK_INPUT; +} + +void +free_frame_menubar (f) + FRAME_PTR f; +{ + BLOCK_INPUT; + + { + HMENU old = GetMenu (FRAME_WIN32_WINDOW (f)); + SetMenu (FRAME_WIN32_WINDOW (f), NULL); + DestroyMenu (old); + } + + UNBLOCK_INPUT; +} +/* Called from Fwin32_create_frame to create the inital 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); +} + +#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. */ + +static int +check_mouse_other_menu_bar (f) + FRAME_PTR f; +{ + FRAME_PTR new_f; + Lisp_Object bar_window; + int part; + Lisp_Object x, y; + unsigned long time; + + (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time); + + if (f == new_f && other_menu_bar_item_p (f, x, y)) + { + unread_menu_bar_button (f, x); + return 1; + } + + return 0; +} +#endif + + +#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) + { + *error = "Empty menu"; + return NULL; + } + + i = 0; + + /* Loop over all panes and items, filling in the tree. */ + + while (i < menu_items_used) + { + if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + { + submenu_stack[submenu_depth++] = hmenu; + i++; + } + else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + { + hmenu = 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 + /* 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 = CreateMenu (); + + 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. */ + + Lisp_Object item_name, enable, descrip; + UINT fuFlags; + + 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 (((char *) XSTRING (item_name)->data)[0] == 0 + || strcmp ((char *) XSTRING (item_name)->data, "--") == 0) + fuFlags = MF_SEPARATOR; + else if (NILP (enable) || !XUINT(enable)) + fuFlags = MF_STRING | MF_GRAYED; + else + fuFlags = MF_STRING; + + AppendMenu (hmenu, + fuFlags, + i, + (char *) XSTRING (item_name)->data); + + // if (!NILP (descrip)) + // hmenu->key = (char *) XSTRING (descrip)->data; + + i += MENU_ITEMS_ITEM_LENGTH; + } +} + + return (first_hmenu); + + error: + if (first_hmenu) DestroyMenu (first_hmenu); + return (NULL); +} + +#endif + +/* win32menu_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 win32menu_show, one for Xt and one for Xlib. + Both 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. + 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. + 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 +win32menu_show (f, x, y, menu, hmenu, error) + FRAME_PTR f; + int x; + int y; + Lisp_Object menu; + HMENU hmenu; + char **error; +{ + int i , menu_selection; + POINT pos; + + *error = NULL; + + if (!hmenu) + { + *error = "Empty menu"; + return Qnil; + } + + pos.x = x; + pos.y = y; + + /* Offset the coordinates to root-relative. */ + ClientToScreen (FRAME_WIN32_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 + + /* Display the menu. */ + menu_selection = TrackPopupMenu (hmenu, + 0x10, + pos.x, pos.y, + 0, + FRAME_WIN32_WINDOW (f), + NULL); + if (menu_selection == -1) + { + *error = "Invalid menu specification"; + return Qnil; + } + + /* 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) + { + return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]); + } +#endif + + return Qnil; +} + +#if 0 +static char * button_names [] = +{ + "button1", "button2", "button3", "button4", "button5", + "button6", "button7", "button8", "button9", "button10" +}; + +static Lisp_Object +win32_dialog_show (f, menubarp, 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]; + + /* 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. */ + { + Lisp_Object pane_name, prefix; + char *pane_string; + pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME]; + 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->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) + { + + /* Create a new item within current pane. */ + Lisp_Object item_name, enable, descrip; + 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 (NILP (item_name)) + { + free_menubar_widget_value_tree (first_wv); + *error = "Submenu in dialog items"; + return Qnil; + } + if (EQ (item_name, Qquote)) + { + /* This is the boundary between left-side elts + and right-side elts. Stop incrementing right_count. */ + boundary_seen = 1; + i++; + continue; + } + if (nb_buttons >= 10) + { + free_menubar_widget_value_tree (first_wv); + *error = "Too many dialog items"; + return Qnil; + } + + wv = malloc_widget_value (); + prev_wv->next = wv; + wv->name = (char *) button_names[nb_buttons]; + if (!NILP (descrip)) + wv->key = (char *) XSTRING (descrip)->data; + wv->value = (char *) XSTRING (item_name)->data; + 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->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. + The Q means something also. */ + dialog_name[0] = 'Q'; + dialog_name[1] = '0' + nb_buttons; + dialog_name[2] = 'B'; + dialog_name[3] = 'R'; + /* Number of buttons to put on the right. */ + dialog_name[4] = '0' + nb_buttons - left_count; + dialog_name[5] = 0; + wv->contents = first_wv; + first_wv = wv; + } + + /* Actually create the dialog. */ + dialog_id = ++popup_id_tick; + menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv, + f->output_data.win32->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); + /* 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. */ + lw_pop_up_all_widgets (dialog_id); + + /* 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)); + + if (queue_tmp != NULL) + { + queue_tmp->event = event; + queue_tmp->next = queue; + queue = queue_tmp; + } + } + } + pop_down: + + /* 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. */ + win32_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) + { + Lisp_Object entry; + + if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + { + prefix + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + i += MENU_ITEMS_PANE_LENGTH; + } + else + { + entry + = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; + if (menu_item_selection == &XVECTOR (menu_items)->contents[i]) + { + if (keymaps != 0) + { + entry = Fcons (entry, Qnil); + if (!NILP (prefix)) + entry = Fcons (prefix, entry); + } + return entry; + } + i += MENU_ITEMS_ITEM_LENGTH; + } + } + } + + return Qnil; +} +#endif + +syms_of_win32menu () +{ + defsubr (&Sx_popup_menu); + defsubr (&Sx_popup_dialog); +} |