X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/68c45bf06516ed4650eb7f9f617742d84750600a..a1b4049dc24f9be1036b66a95c99c6257b8551f6:/src/w32menu.c diff --git a/src/w32menu.c b/src/w32menu.c index c93c589f07..44791448d9 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -20,14 +20,18 @@ Boston, MA 02111-1307, USA. */ #include #include + #include #include "lisp.h" #include "termhooks.h" +#include "keyboard.h" +#include "keymap.h" #include "frame.h" #include "window.h" -#include "keyboard.h" #include "blockinput.h" #include "buffer.h" +#include "charset.h" +#include "coding.h" /* This may include sys/types.h, and that somehow loses if this is not done before the other system files. */ @@ -41,23 +45,24 @@ Boston, MA 02111-1307, USA. */ #include "dispextern.h" +#undef HAVE_MULTILINGUAL_MENU +#undef HAVE_DIALOGS /* TODO: Implement native dialogs. */ + /******************************************************************/ /* Definitions copied from lwlib.h */ typedef void * XtPointer; typedef char Boolean; -#define True 1 -#define False 0 - -typedef enum _change_type +enum button_type { - NO_CHANGE = 0, - INVISIBLE_CHANGE = 1, - VISIBLE_CHANGE = 2, - STRUCTURAL_CHANGE = 3 -} change_type; + BUTTON_TYPE_NONE, + BUTTON_TYPE_TOGGLE, + BUTTON_TYPE_RADIO +}; +/* This structure is based on the one in ../lwlib/lwlib.h, modified + for Windows. */ typedef struct _widget_value { /* name of widget */ @@ -66,10 +71,16 @@ typedef struct _widget_value char* value; /* keyboard equivalent. no implications for XtTranslations */ char* key; + /* Help string or nil if none. + GC finds this string through the frame's menu_bar_vector + or through menu_items. */ + Lisp_Object help; /* true if enabled */ Boolean enabled; /* true if selected */ Boolean selected; + /* The type of a button. */ + enum button_type button_type; /* true if menu title */ Boolean title; #if 0 @@ -101,20 +112,26 @@ typedef struct _widget_value #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) +/* Local memory management */ +#define local_heap (GetProcessHeap ()) +#define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n))) +#define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p)))) -/******************************************************************/ +#define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value))) +#define free_widget_value(wv) (local_free ((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 */ +static HMENU current_popup_menu; + +FARPROC get_menu_item_info; +FARPROC set_menu_item_info; + Lisp_Object Vmenu_updating_frame; Lisp_Object Qdebug_on_next_call; @@ -133,14 +150,20 @@ extern Lisp_Object Qmenu_bar_update_hook; void set_frame_menubar (); -static Lisp_Object w32_menu_show (); +static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object)); +#ifdef HAVE_DIALOGS static Lisp_Object w32_dialog_show (); +#endif +static Lisp_Object w32_menu_show (); static void keymap_panes (); static void single_keymap_panes (); static void single_menu_item (); static void list_of_panes (); static void list_of_items (); +void w32_free_menu_strings (HWND); /* This holds a Lisp vector that holds the results of decoding the keymaps or alist-of-alists that specify a menu. @@ -168,12 +191,18 @@ static void list_of_items (); #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 +enum menu_item_idx +{ + MENU_ITEMS_ITEM_NAME = 0, + MENU_ITEMS_ITEM_ENABLE, + MENU_ITEMS_ITEM_VALUE, + MENU_ITEMS_ITEM_EQUIV_KEY, + MENU_ITEMS_ITEM_DEFINITION, + MENU_ITEMS_ITEM_TYPE, + MENU_ITEMS_ITEM_SELECTED, + MENU_ITEMS_ITEM_HELP, + MENU_ITEMS_ITEM_LENGTH +}; static Lisp_Object menu_items; @@ -194,6 +223,8 @@ static int menu_items_submenu_depth; Xt on behalf of one of the widget sets. */ static int popup_activated_flag; +static int next_menubar_widget_id; + /* 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. @@ -205,10 +236,11 @@ int pending_menu_activation; /* Return the frame whose ->output_data.w32->menubar_widget equals - MENU, or 0 if none. */ + ID, or 0 if none. */ static struct frame * -menubar_id_to_frame (HMENU menu) +menubar_id_to_frame (id) + HMENU id; { Lisp_Object tail, frame; FRAME_PTR f; @@ -219,9 +251,9 @@ menubar_id_to_frame (HMENU menu) if (!GC_FRAMEP (frame)) continue; f = XFRAME (frame); - if (f->output_data.nothing == 1) + if (!FRAME_WINDOW_P (f)) continue; - if (f->output_data.w32->menubar_widget == menu) + if (f->output_data.w32->menubar_widget == id) return f; } return 0; @@ -290,7 +322,7 @@ push_submenu_start () if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); - XVECTOR (menu_items)->contents[menu_items_used++] = Qnil; + ASET (menu_items, menu_items_used++, Qnil); menu_items_submenu_depth++; } @@ -302,7 +334,7 @@ push_submenu_end () if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); - XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda; + ASET (menu_items, menu_items_used++, Qlambda); menu_items_submenu_depth--; } @@ -314,10 +346,10 @@ push_left_right_boundary () if (menu_items_used + 1 > menu_items_allocated) grow_menu_items (); - XVECTOR (menu_items)->contents[menu_items_used++] = Qquote; + ASET (menu_items, menu_items_used++, Qquote); } -/* Start a new menu pane in menu_items.. +/* Start a new menu pane in menu_items. NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */ static void @@ -329,31 +361,34 @@ push_menu_pane (name, prefix_vec) 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; + ASET (menu_items, menu_items_used++, Qt); + ASET (menu_items, menu_items_used++, name); + ASET (menu_items, menu_items_used++, prefix_vec); } -/* 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). */ +/* 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). TYPE is the type of this menu + item, one of nil, `toggle' or `radio'. */ static void -push_menu_item (name, enable, key, def, equiv) - Lisp_Object name, enable, key, def, equiv; +push_menu_item (name, enable, key, def, equiv, type, selected, help) + Lisp_Object name, enable, key, def, equiv, type, selected, help; { 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; + ASET (menu_items, menu_items_used++, name); + ASET (menu_items, menu_items_used++, enable); + ASET (menu_items, menu_items_used++, key); + ASET (menu_items, menu_items_used++, equiv); + ASET (menu_items, menu_items_used++, def); + ASET (menu_items, menu_items_used++, type); + ASET (menu_items, menu_items_used++, selected); + ASET (menu_items, menu_items_used++, help); } /* Look through KEYMAPS, a vector of keymaps that is NMAPS long, @@ -375,7 +410,8 @@ keymap_panes (keymaps, nmaps, notreal) 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); + single_keymap_panes (keymaps[mapno], + Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10); finish_menu_items (); } @@ -400,21 +436,12 @@ single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth) 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 = XCDR (tail)) { GCPRO2 (keymap, pending_maps); @@ -423,18 +450,18 @@ single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth) item = XCAR (tail); if (CONSP (item)) single_menu_item (XCAR (item), XCDR (item), - &pending_maps, notreal, maxdepth, ¬buttons); + &pending_maps, notreal, maxdepth); else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ - int len = XVECTOR (item)->size; + int len = ASIZE (item); int c; for (c = 0; c < len; c++) { Lisp_Object character; XSETFASTINT (character, c); - single_menu_item (character, XVECTOR (item)->contents[c], - &pending_maps, notreal, maxdepth, ¬buttons); + single_menu_item (character, AREF (item, c), + &pending_maps, notreal, maxdepth); } } UNGCPRO; @@ -462,20 +489,15 @@ single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth) 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. */ + If we encounter submenus deeper than MAXDEPTH levels, ignore them. */ static void -single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, - notbuttons_ptr) +single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth) Lisp_Object key, item; Lisp_Object *pending_maps_ptr; int maxdepth, notreal; - int *notbuttons_ptr; { - Lisp_Object def, map, item_string, enabled; + Lisp_Object map, item_string, enabled; struct gcpro gcpro1, gcpro2; int res; @@ -486,7 +508,7 @@ single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, if (!res) return; /* Not a menu item. */ - map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP]; + map = AREF (item_properties, ITEM_PROPERTY_MAP); if (notreal) { @@ -497,10 +519,10 @@ single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, return; } - enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]; - item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; + enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE); + item_string = AREF (item_properties, ITEM_PROPERTY_NAME); - if (!NILP (map) && XSTRING (item_string)->data[0] == '@') + if (!NILP (map) && SREF (item_string, 0) == '@') { if (!NILP (enabled)) /* An enabled separate pane. Remember this to handle it later. */ @@ -509,80 +531,13 @@ single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, 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)) - { - Lisp_Object selected - = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; - - if (*notbuttons_ptr) - /* The first button. Line up previous items in this menu. */ - { - 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 (" "); - - 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]); + AREF (item_properties, ITEM_PROPERTY_DEF), + AREF (item_properties, ITEM_PROPERTY_KEYEQ), + AREF (item_properties, ITEM_PROPERTY_TYPE), + AREF (item_properties, ITEM_PROPERTY_SELECTED), + AREF (item_properties, ITEM_PROPERTY_HELP)); -#if 1 /* Display a submenu using the toolkit. */ if (! (NILP (map) || NILP (enabled))) { @@ -590,7 +545,6 @@ single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth, single_keymap_panes (map, Qnil, key, 0, maxdepth - 1); push_submenu_end (); } -#endif } /* Push all the panes and items of a menu described by the @@ -610,10 +564,10 @@ list_of_panes (menu) Lisp_Object elt, pane_name, pane_data; elt = Fcar (tail); pane_name = Fcar (elt); - CHECK_STRING (pane_name, 0); + CHECK_STRING (pane_name); push_menu_pane (pane_name, Qnil); pane_data = Fcdr (elt); - CHECK_CONS (pane_data, 0); + CHECK_CONS (pane_data); list_of_items (pane_data); } @@ -632,63 +586,60 @@ list_of_items (pane) { item = Fcar (tail); if (STRINGP (item)) - push_menu_item (item, Qnil, Qnil, Qt, Qnil); + push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil); else if (NILP (item)) push_left_right_boundary (); else { - CHECK_CONS (item, 0); + CHECK_CONS (item); item1 = Fcar (item); - CHECK_STRING (item1, 1); - push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil); + CHECK_STRING (item1); + push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil); } } } 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.") + doc: /* Pop up a deck-of-cards menu and return user's selection. +POSITION is a position specification. This is either a mouse button +event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET +are positions in pixels from the top left corner of WINDOW's frame +\(WINDOW may be a frame object instead of a window). This controls the +position of the center of the first line in the first pane of the +menu, not the top left of the menu as a whole. If POSITION is t, it +means to use the current mouse position. + +MENU is a specifier for a menu. For the simplest case, MENU is a keymap. +The menu items come from key bindings that have a menu string as well as +a definition; actually, the \"definition\" in such a key binding looks like +\(STRING . REAL-DEFINITION). To give the menu a title, put a string into +the keymap as a top-level element. + +If REAL-DEFINITION is nil, that puts a nonselectable string in the menu. +Otherwise, REAL-DEFINITION should be a valid key binding definition. + +You can also use a list of keymaps as MENU. Then each keymap makes a +separate pane. When MENU is a keymap or a list of keymaps, the return +value is a list of events. + +Alternatively, you can specify a menu of multiple panes with a list of +the form (TITLE PANE1 PANE2...), where each pane is a list of +form (TITLE ITEM1 ITEM2...). +Each ITEM is normally a cons cell (STRING . VALUE); but a string can +appear as an item--that makes a nonselectable line in the menu. +With this form of menu, the return value is VALUE from the chosen item. + +If POSITION is nil, don't display the menu at all, just precalculate the +cached information about equivalent key sequences. */) (position, menu) Lisp_Object position, menu; { - int number_of_panes, panes; Lisp_Object keymap, tem; - int xpos, ypos; + int xpos = 0, ypos = 0; Lisp_Object title; char *error_name; Lisp_Object selection; - int i, j; - FRAME_PTR f; + FRAME_PTR f = NULL; Lisp_Object x, y, window; int keymaps = 0; int for_click = 0; @@ -701,12 +652,13 @@ cached information about equivalent key sequences.") /* Decode the first argument: find the window and the coordinates. */ if (EQ (position, Qt) - || (CONSP (position) && EQ (XCAR (position), Qmenu_bar))) + || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtool_bar)))) { /* Use the mouse's current position. */ - FRAME_PTR new_f = selected_frame; + FRAME_PTR new_f = SELECTED_FRAME (); Lisp_Object bar_window; - int part; + enum scroll_bar_part part; unsigned long time; if (mouse_position_hook) @@ -741,8 +693,8 @@ cached information about equivalent key sequences.") } } - CHECK_NUMBER (x, 0); - CHECK_NUMBER (y, 0); + CHECK_NUMBER (x); + CHECK_NUMBER (y); /* Decode where to put the menu. */ @@ -754,18 +706,18 @@ cached information about equivalent key sequences.") } else if (WINDOWP (window)) { - CHECK_LIVE_WINDOW (window, 0); + CHECK_LIVE_WINDOW (window); f = XFRAME (WINDOW_FRAME (XWINDOW (window))); - xpos = (FONT_WIDTH (f->output_data.w32->font) + xpos = (FONT_WIDTH (FRAME_FONT (f)) * XFASTINT (XWINDOW (window)->left)); - ypos = (f->output_data.w32->line_height + ypos = (FRAME_LINE_HEIGHT (f) * 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); + CHECK_WINDOW (window); xpos += XINT (x); ypos += XINT (y); @@ -780,32 +732,28 @@ cached information about equivalent key sequences.") /* Decode the menu items from what was specified. */ - keymap = Fkeymapp (menu); - tem = Qnil; - if (CONSP (menu)) - tem = Fkeymapp (Fcar (menu)); - if (!NILP (keymap)) + keymap = get_keymap (menu, 0, 0); + if (CONSP (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); + prompt = Fkeymap_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; + ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt); keymaps = 1; } - else if (!NILP (tem)) + else if (CONSP (menu) && KEYMAPP (XCAR (menu))) { /* We were given a list of keymaps. */ int nmaps = XFASTINT (Flength (menu)); @@ -821,9 +769,9 @@ cached information about equivalent key sequences.") { Lisp_Object prompt; - maps[i++] = keymap = get_keymap (Fcar (tem)); + maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0); - prompt = map_prompt (keymap); + prompt = Fkeymap_prompt (keymap); if (NILP (title) && !NILP (prompt)) title = prompt; } @@ -833,7 +781,7 @@ cached information about equivalent key sequences.") /* 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; + ASET (menu_items, MENU_ITEMS_PANE_NAME, title); keymaps = 1; } @@ -841,7 +789,7 @@ cached information about equivalent key sequences.") { /* We were given an old-fashioned menu. */ title = Fcar (menu); - CHECK_STRING (title, 1); + CHECK_STRING (title); list_of_panes (Fcdr (menu)); @@ -856,6 +804,16 @@ cached information about equivalent key sequences.") } #ifdef HAVE_MENUS + /* If resources from a previous popup menu exist yet, does nothing + until the `menu_free_timer' has freed them (see w32fns.c). + */ + if (current_popup_menu) + { + discard_menu_items (); + UNGCPRO; + return Qnil; + } + /* Display them in a menu. */ BLOCK_INPUT; @@ -864,9 +822,9 @@ cached information about equivalent key sequences.") UNBLOCK_INPUT; discard_menu_items (); +#endif /* HAVE_MENUS */ UNGCPRO; -#endif /* HAVE_MENUS */ if (error_name) error (error_name); return selection; @@ -875,37 +833,39 @@ cached information about equivalent key sequences.") #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\ -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.)") + doc: /* Pop up a dialog box and return user's selection. +POSITION specifies which frame to use. +This is normally a mouse button event or a window or frame. +If POSITION is t, it means to use the frame the mouse is on. +The dialog box appears in the middle of the specified frame. + +CONTENTS specifies the alternatives to display in the dialog box. +It is a list of the form (TITLE ITEM1 ITEM2...). +Each ITEM is a cons cell (STRING . VALUE). +The return value is VALUE from the chosen item. + +An ITEM may also be just a string--that makes a nonselectable item. +An ITEM may also be nil--that means to put all preceding items +on the left of the dialog box and all following items on the right. +\(By default, approximately half appear on each side.) */) (position, contents) Lisp_Object position, contents; { - FRAME_PTR f; + FRAME_PTR f = NULL; Lisp_Object window; check_w32 (); /* Decode the first argument: find the window or frame to use. */ if (EQ (position, Qt) - || (CONSP (position) && EQ (XCAR (position), Qmenu_bar))) + || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar) + || EQ (XCAR (position), Qtool_bar)))) { #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; + FRAME_PTR new_f = SELECTED_FRAME (); Lisp_Object bar_window; - int part; + enum scroll_bar_part part; unsigned long time; Lisp_Object x, y; @@ -941,15 +901,15 @@ on the left of the dialog box and all following items on the right.\n\ f = XFRAME (window); else if (WINDOWP (window)) { - CHECK_LIVE_WINDOW (window, 0); + CHECK_LIVE_WINDOW (window); 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); + CHECK_WINDOW (window); -#if 1 +#ifndef HAVE_DIALOGS /* Display a menu with these alternatives in the middle of frame F. */ { @@ -962,7 +922,7 @@ on the left of the dialog box and all following items on the right.\n\ return Fx_popup_menu (newpos, Fcons (Fcar (contents), Fcons (contents, Qnil))); } -#else +#else /* HAVE_DIALOGS */ { Lisp_Object title; char *error_name; @@ -970,7 +930,7 @@ on the left of the dialog box and all following items on the right.\n\ /* Decode the dialog items from what was specified. */ title = Fcar (contents); - CHECK_STRING (title, 1); + CHECK_STRING (title); list_of_panes (Fcons (contents, Qnil)); @@ -984,12 +944,12 @@ on the left of the dialog box and all following items on the right.\n\ if (error_name) error (error_name); return selection; } -#endif +#endif /* HAVE_DIALOGS */ } /* 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. + MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue. To activate the menu bar, we signal to the input thread that it can return from the WM_INITMENU message, allowing the normal Windows @@ -999,6 +959,7 @@ on the left of the dialog box and all following items on the right.\n\ This way we can safely execute Lisp code. */ +void x_activate_menubar (f) FRAME_PTR f; { @@ -1027,31 +988,32 @@ menubar_selection_callback (FRAME_PTR f, void * client_data) if (!f) return; + entry = Qnil; 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)) + if (EQ (AREF (vector, i), Qnil)) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; i++; } - else if (EQ (XVECTOR (vector)->contents[i], Qlambda)) + else if (EQ (AREF (vector, i), Qlambda)) { prefix = subprefix_stack[--submenu_depth]; i++; } - else if (EQ (XVECTOR (vector)->contents[i], Qt)) + else if (EQ (AREF (vector, i), Qt)) { - prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX]; + prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX); i += MENU_ITEMS_PANE_LENGTH; } else { - entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE]; + entry = AREF (vector, 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) @@ -1061,34 +1023,46 @@ menubar_selection_callback (FRAME_PTR f, void * client_data) Lisp_Object frame; XSETFRAME (frame, f); - buf.kind = menu_bar_event; - buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil)); + buf.kind = MENU_BAR_EVENT; + buf.frame_or_window = frame; + buf.arg = frame; kbd_buffer_store_event (&buf); 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]); + buf.kind = MENU_BAR_EVENT; + buf.frame_or_window = frame; + buf.arg = subprefix_stack[j]; kbd_buffer_store_event (&buf); } if (!NILP (prefix)) { - buf.kind = menu_bar_event; - buf.frame_or_window = Fcons (frame, prefix); + buf.kind = MENU_BAR_EVENT; + buf.frame_or_window = frame; + buf.arg = prefix; kbd_buffer_store_event (&buf); } - buf.kind = menu_bar_event; - buf.frame_or_window = Fcons (frame, entry); + buf.kind = MENU_BAR_EVENT; + buf.frame_or_window = frame; + buf.arg = entry; kbd_buffer_store_event (&buf); + /* Free memory used by owner-drawn and help-echo strings. */ + w32_free_menu_strings (FRAME_W32_WINDOW (f)); + f->output_data.w32->menu_command_in_progress = 0; + f->output_data.w32->menubar_active = 0; return; } i += MENU_ITEMS_ITEM_LENGTH; } } + /* Free memory used by owner-drawn and help-echo strings. */ + w32_free_menu_strings (FRAME_W32_WINDOW (f)); + f->output_data.w32->menu_command_in_progress = 0; + f->output_data.w32->menubar_active = 0; } /* Allocate a widget_value, blocking input. */ @@ -1115,7 +1089,7 @@ free_menubar_widget_value_tree (wv) widget_value *wv; { if (! wv) return; - + wv->name = wv->value = wv->key = (char *) 0xDEADBEEF; if (wv->contents && (wv->contents != (widget_value*)1)) @@ -1133,23 +1107,18 @@ free_menubar_widget_value_tree (wv) UNBLOCK_INPUT; } -/* Return a tree of widget_value structures for a menu bar item +/* Set up data i menu_items 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 widget_value * -single_submenu (item_key, item_name, maps) +static int +parse_single_submenu (item_key, item_name, maps) Lisp_Object item_key, item_name, maps; { - 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 i; int top_level_items = 0; length = Flength (maps); @@ -1163,28 +1132,40 @@ single_submenu (item_key, item_name, maps) maps = Fcdr (maps); } - menu_items_n_panes = 0; - /* 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++) { if (SYMBOLP (mapvec[i]) - || (CONSP (mapvec[i]) - && NILP (Fkeymapp (mapvec[i])))) + || (CONSP (mapvec[i]) && !KEYMAPP (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); + push_menu_item (item_name, Qt, item_key, mapvec[i], + Qnil, Qnil, Qnil, Qnil); } else single_keymap_panes (mapvec[i], item_name, item_key, 0, 10); } + + return top_level_items; +} - /* Create a tree of widget_value objects - representing the panes and their items. */ + +/* Create a tree of widget_value objects + representing the panes and items + in menu_items starting at index START, up to index END. */ + +static widget_value * +digest_single_submenu (start, end, top_level_items) + int start, end; +{ + widget_value *wv, *prev_wv, *save_wv, *first_wv; + int i; + int submenu_depth = 0; + widget_value **submenu_stack; submenu_stack = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); @@ -1192,6 +1173,8 @@ single_submenu (item_key, item_name, maps) wv->name = "menu"; wv->value = 0; wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; first_wv = wv; save_wv = 0; prev_wv = 0; @@ -1200,38 +1183,47 @@ single_submenu (item_key, item_name, maps) 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) + i = start; + while (i < end) { - if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + if (EQ (AREF (menu_items, i), Qnil)) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; prev_wv = 0; i++; } - else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + else if (EQ (AREF (menu_items, i), Qlambda)) { prev_wv = save_wv; save_wv = submenu_stack[--submenu_depth]; i++; } - else if (EQ (XVECTOR (menu_items)->contents[i], Qt) + else if (EQ (AREF (menu_items, 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)) + else if (EQ (AREF (menu_items, i), Qquote)) i += 1; - else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + else if (EQ (AREF (menu_items, 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_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_SYSTEM (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } +#endif pane_string = (NILP (pane_name) - ? "" : (char *) XSTRING (pane_name)->data); + ? "" : (char *) SDATA (pane_name)); /* If there is just one top-level pane, put all its items directly under the top-level menu. */ if (menu_items_n_panes == 1) @@ -1254,6 +1246,8 @@ single_submenu (item_key, item_name, maps) wv->name++; wv->value = 0; wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; } save_wv = wv; prev_wv = 0; @@ -1262,12 +1256,30 @@ single_submenu (item_key, item_name, maps) 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]; + Lisp_Object item_name, enable, descrip, def, type, selected; + Lisp_Object help; + + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); + type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE); + selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_SYSTEM (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_SYSTEM (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } +#endif /* not HAVE_MULTILINGUAL_MENU */ wv = xmalloc_widget_value (); if (prev_wv) @@ -1275,14 +1287,30 @@ single_submenu (item_key, item_name, maps) else save_wv->contents = wv; - wv->name = (char *) XSTRING (item_name)->data; + wv->name = (char *) SDATA (item_name); if (!NILP (descrip)) - wv->key = (char *) XSTRING (descrip)->data; + wv->key = (char *) SDATA (descrip); 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); + + if (NILP (type)) + wv->button_type = BUTTON_TYPE_NONE; + else if (EQ (type, QCradio)) + wv->button_type = BUTTON_TYPE_RADIO; + else if (EQ (type, QCtoggle)) + wv->button_type = BUTTON_TYPE_TOGGLE; + else + abort (); + + wv->selected = !NILP (selected); + if (!STRINGP (help)) + help = Qnil; + + wv->help = help; + prev_wv = wv; i += MENU_ITEMS_ITEM_LENGTH; @@ -1312,9 +1340,11 @@ set_frame_menubar (f, first_time, deep_p) int deep_p; { HMENU menubar_widget = f->output_data.w32->menubar_widget; - Lisp_Object tail, items, frame; + Lisp_Object items; widget_value *wv, *first_wv, *prev_wv = 0; - int i; + int i, last_i; + int *submenu_start, *submenu_end; + int *submenu_top_level_items; /* We must not change the menubar when actually in use. */ if (f->output_data.w32->menubar_active) @@ -1327,19 +1357,13 @@ set_frame_menubar (f, first_time, deep_p) 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 specpdl_count = SPECPDL_INDEX (); int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = (Lisp_Object *) alloca (previous_menu_items_used @@ -1366,7 +1390,7 @@ set_frame_menubar (f, first_time, deep_p) set_buffer_internal_1 (XBUFFER (buffer)); /* Run the Lucid hook. */ - call1 (Vrun_hooks, Qactivate_menubar_hook); + safe_run_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)) @@ -1376,38 +1400,68 @@ set_frame_menubar (f, first_time, deep_p) 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)); + if (previous_menu_items_used) + bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items, + previous_menu_items_used * sizeof (Lisp_Object)); - /* Fill in the current menu bar contents. */ + /* Fill in menu_items with the current menu bar contents. + This can evaluate Lisp code. */ menu_items = f->menu_bar_vector; - menu_items_allocated = XVECTOR (menu_items)->size; + menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; + submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); + submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); + submenu_top_level_items + = (int *) alloca (XVECTOR (items)->size * sizeof (int *)); init_menu_items (); - for (i = 0; i < XVECTOR (items)->size; i += 4) + for (i = 0; i < ASIZE (items); i += 4) { Lisp_Object key, string, maps; - key = XVECTOR (items)->contents[i]; - string = XVECTOR (items)->contents[i + 1]; - maps = XVECTOR (items)->contents[i + 2]; + last_i = i; + + key = AREF (items, i); + string = AREF (items, i + 1); + maps = AREF (items, i + 2); if (NILP (string)) break; - wv = single_submenu (key, string, maps); + submenu_start[i] = menu_items_used; + + menu_items_n_panes = 0; + submenu_top_level_items[i] + = parse_single_submenu (key, string, maps); + + submenu_end[i] = menu_items_used; + } + + finish_menu_items (); + + /* Convert menu_items into widget_value trees + to display the menu. This cannot evaluate Lisp code. */ + + wv = xmalloc_widget_value (); + wv->name = "menubar"; + wv->value = 0; + wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; + first_wv = wv; + + for (i = 0; i < last_i; i += 4) + { + wv = digest_single_submenu (submenu_start[i], submenu_end[i], + submenu_top_level_items[i]); 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; + wv->button_type = BUTTON_TYPE_NONE; prev_wv = wv; } - finish_menu_items (); - set_buffer_internal_1 (prev); unbind_to (specpdl_count, Qnil); @@ -1416,7 +1470,7 @@ set_frame_menubar (f, first_time, deep_p) for (i = 0; i < previous_menu_items_used; i++) if (menu_items_used == i - || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i]))) + || (!EQ (previous_items[i], AREF (menu_items, i)))) break; if (i == menu_items_used && i == previous_menu_items_used && i != 0) { @@ -1427,15 +1481,18 @@ set_frame_menubar (f, first_time, deep_p) } /* Now GC cannot happen during the lifetime of the widget_value, - so it's safe to store data from a Lisp_String. */ + so it's safe to store data from a Lisp_String, as long as + local copies are made when the actual menu is created. + Windows takes care of this for normal string items, but + not for owner-drawn items or additional item-info. */ wv = first_wv->contents; - for (i = 0; i < XVECTOR (items)->size; i += 4) + for (i = 0; i < ASIZE (items); i += 4) { Lisp_Object string; - string = XVECTOR (items)->contents[i + 1]; + string = AREF (items, i + 1); if (NILP (string)) break; - wv->name = (char *) XSTRING (string)->data; + wv->name = (char *) SDATA (string); wv = wv->next; } @@ -1446,42 +1503,31 @@ set_frame_menubar (f, first_time, deep_p) 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. + just the top level menu bar strings. */ - 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. */ + wv = xmalloc_widget_value (); + wv->name = "menubar"; + wv->value = 0; + wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; + first_wv = wv; 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) + for (i = 0; i < ASIZE (items); i += 4) { Lisp_Object string; - string = XVECTOR (items)->contents[i + 1]; + string = AREF (items, i + 1); if (NILP (string)) break; wv = xmalloc_widget_value (); - wv->name = (char *) XSTRING (string)->data; + wv->name = (char *) SDATA (string); wv->value = 0; wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; /* This prevents lwlib from assuming this menu item is really supposed to be empty. */ /* The EMACS_INT cast avoids a warning. @@ -1495,16 +1541,10 @@ set_frame_menubar (f, first_time, deep_p) 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; + /* Forget what we thought we knew about what is in the + detailed contents of the menu bar menus. + Changing the top level always destroys the contents. */ + f->menu_bar_items_used = 0; } /* Create or update the menu bar widget. */ @@ -1572,7 +1612,7 @@ free_frame_menubar (f) f->output_data.w32->menubar_widget = NULL; DestroyMenu (old); } - + UNBLOCK_INPUT; } @@ -1612,9 +1652,7 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) 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; @@ -1630,6 +1668,8 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) wv->name = "menu"; wv->value = 0; wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; first_wv = wv; first_pane = 1; @@ -1637,7 +1677,7 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) i = 0; while (i < menu_items_used) { - if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + if (EQ (AREF (menu_items, i), Qnil)) { submenu_stack[submenu_depth++] = save_wv; save_wv = prev_wv; @@ -1645,29 +1685,36 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) first_pane = 1; i++; } - else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + else if (EQ (AREF (menu_items, 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) + else if (EQ (AREF (menu_items, 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)) + else if (EQ (AREF (menu_items, i), Qquote)) i += 1; - else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + else if (EQ (AREF (menu_items, 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_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); +#ifndef HAVE_MULTILINGUAL_MENU + if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name)) + { + pane_name = ENCODE_SYSTEM (pane_name); + ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name); + } +#endif pane_string = (NILP (pane_name) - ? "" : (char *) XSTRING (pane_name)->data); + ? "" : (char *) SDATA (pane_name)); /* If there is just one top-level pane, put all its items directly under the top-level menu. */ if (menu_items_n_panes == 1) @@ -1688,6 +1735,8 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) wv->name++; wv->value = 0; wv->enabled = 1; + wv->button_type = BUTTON_TYPE_NONE; + wv->help = Qnil; save_wv = wv; prev_wv = 0; } @@ -1702,26 +1751,58 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) 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]; + Lisp_Object item_name, enable, descrip, def, type, selected, help; + + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION); + type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE); + selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); + +#ifndef HAVE_MULTILINGUAL_MENU + if (STRINGP (item_name) && STRING_MULTIBYTE (item_name)) + { + item_name = ENCODE_SYSTEM (item_name); + ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name); + } + if (STRINGP (descrip) && STRING_MULTIBYTE (descrip)) + { + descrip = ENCODE_SYSTEM (descrip); + ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip); + } +#endif /* not HAVE_MULTILINGUAL_MENU */ wv = xmalloc_widget_value (); if (prev_wv) prev_wv->next = wv; else save_wv->contents = wv; - wv->name = (char *) XSTRING (item_name)->data; + wv->name = (char *) SDATA (item_name); if (!NILP (descrip)) - wv->key = (char *) XSTRING (descrip)->data; + wv->key = (char *) SDATA (descrip); wv->value = 0; /* Use the contents index as call_data, since we are - restricted to 16-bits.. */ + restricted to 16-bits. */ wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0; wv->enabled = !NILP (enable); + + if (NILP (type)) + wv->button_type = BUTTON_TYPE_NONE; + else if (EQ (type, QCtoggle)) + wv->button_type = BUTTON_TYPE_TOGGLE; + else if (EQ (type, QCradio)) + wv->button_type = BUTTON_TYPE_RADIO; + else + abort (); + + wv->selected = !NILP (selected); + if (!STRINGP (help)) + help = Qnil; + + wv->help = help; + prev_wv = wv; i += MENU_ITEMS_ITEM_LENGTH; @@ -1738,26 +1819,30 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) so that it looks better. Having two separators looks odd. */ wv_sep->name = "--"; wv_sep->next = first_wv->contents; + wv_sep->help = Qnil; - wv_title->name = (char *) XSTRING (title)->data; - /* Handle title specially, so it looks better. */ - wv_title->title = True; +#ifndef HAVE_MULTILINGUAL_MENU + if (STRING_MULTIBYTE (title)) + title = ENCODE_SYSTEM (title); +#endif + wv_title->name = (char *) SDATA (title); + wv_title->enabled = TRUE; + wv_title->title = TRUE; + wv_title->button_type = BUTTON_TYPE_NONE; + wv_title->help = Qnil; wv_title->next = wv_sep; first_wv->contents = wv_title; } /* Actually create the menu. */ - menu = CreatePopupMenu (); + current_popup_menu = menu = CreatePopupMenu (); fill_in_menu (menu, first_wv->contents); - + /* Adjust coordinates to be root-window-relative. */ pos.x = x; pos.y = y; ClientToScreen (FRAME_W32_WINDOW (f), &pos); - /* 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; @@ -1770,6 +1855,9 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) during the call. */ discard_mouse_events (); + /* Free the widget_value objects we used to specify the contents. */ + free_menubar_widget_value_tree (first_wv); + DestroyMenu (menu); /* Find the selected item, and its pane, to return @@ -1778,35 +1866,33 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) { Lisp_Object prefix, entry; - prefix = Qnil; + prefix = entry = Qnil; i = 0; while (i < menu_items_used) { - if (EQ (XVECTOR (menu_items)->contents[i], Qnil)) + if (EQ (AREF (menu_items, i), Qnil)) { subprefix_stack[submenu_depth++] = prefix; prefix = entry; i++; } - else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda)) + else if (EQ (AREF (menu_items, i), Qlambda)) { prefix = subprefix_stack[--submenu_depth]; i++; } - else if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + else if (EQ (AREF (menu_items, i), Qt)) { - prefix - = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + prefix = AREF (menu_items, 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)) + else if (EQ (AREF (menu_items, i), Qquote)) i += 1; else { - entry - = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; + entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); if (menu_item_selection == i) { if (keymaps != 0) @@ -1831,6 +1917,7 @@ w32_menu_show (f, x, y, for_click, keymaps, title, error) } +#ifdef HAVE_DIALOGS static char * button_names [] = { "button1", "button2", "button3", "button4", "button5", "button6", "button7", "button8", "button9", "button10" }; @@ -1846,7 +1933,7 @@ w32_dialog_show (f, keymaps, title, error) char dialog_name[6]; int menu_item_selection; - widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; + widget_value *wv, *first_wv = 0, *prev_wv = 0; /* Number of elements seen so far, before boundary. */ int left_count = 0; @@ -1866,16 +1953,17 @@ w32_dialog_show (f, keymaps, title, error) { 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_name = AREF (menu_items, MENU_ITEMS_PANE_NAME); + prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX); pane_string = (NILP (pane_name) - ? "" : (char *) XSTRING (pane_name)->data); + ? "" : (char *) SDATA (pane_name)); 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"; + prev_wv->help = Qnil; first_wv = prev_wv; /* Loop over all panes and items, filling in the tree. */ @@ -1884,11 +1972,12 @@ w32_dialog_show (f, keymaps, title, error) { /* 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]; + Lisp_Object item_name, enable, descrip, help; + + item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME); + enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE); + descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY); + help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP); if (NILP (item_name)) { @@ -1915,10 +2004,11 @@ w32_dialog_show (f, keymaps, title, error) 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->key = (char *) SDATA (descrip); + wv->value = (char *) SDATA (item_name); + wv->call_data = (void *) &AREF (menu_items, i); wv->enabled = !NILP (enable); + wv->help = Qnil; prev_wv = wv; if (! boundary_seen) @@ -1935,6 +2025,7 @@ w32_dialog_show (f, keymaps, title, error) wv = xmalloc_widget_value (); wv->name = dialog_name; + wv->help = Qnil; /* Dialog boxes use a really stupid name encoding which specifies how many buttons to use @@ -1952,13 +2043,11 @@ w32_dialog_show (f, keymaps, title, error) } /* Actually create the dialog. */ -#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); - lw_modify_all_widgets (dialog_id, first_wv->contents, 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); @@ -1967,7 +2056,6 @@ w32_dialog_show (f, keymaps, title, error) menu_item_selection = 0; /* Display the menu. */ -#if 0 lw_pop_up_all_widgets (dialog_id); popup_activated_flag = 1; @@ -1975,7 +2063,6 @@ w32_dialog_show (f, keymaps, title, error) popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id); lw_destroy_all_widgets (dialog_id); -#endif /* Find the selected item, and its pane, to return the proper value. */ @@ -1989,16 +2076,14 @@ w32_dialog_show (f, keymaps, title, error) { Lisp_Object entry; - if (EQ (XVECTOR (menu_items)->contents[i], Qt)) + if (EQ (AREF (menu_items, i), Qt)) { - prefix - = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX]; + prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); i += MENU_ITEMS_PANE_LENGTH; } else { - entry - = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE]; + entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); if (menu_item_selection == i) { if (keymaps != 0) @@ -2016,6 +2101,7 @@ w32_dialog_show (f, keymaps, title, error) return Qnil; } +#endif /* HAVE_DIALOGS */ /* Is this item a separator? */ @@ -2023,9 +2109,14 @@ static int name_is_separator (name) char *name; { - /* Check if name string consists of only dashes ('-') */ + char *start = name; + + /* Check if name string consists of only dashes ('-'). */ while (*name == '-') name++; - return (*name == '\0'); + /* Separators can also be of the form "--:TripleSuperMegaEtched" + or "--deep-shadow". We don't implement them yet, se we just treat + them like normal separators. */ + return (*name == '\0' || start + 2 == name); } @@ -2041,9 +2132,13 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) { UINT fuFlags; char *out_string; + int return_value; if (name_is_separator (wv->name)) - fuFlags = MF_SEPARATOR; + { + fuFlags = MF_SEPARATOR; + out_string = NULL; + } else { if (wv->enabled) @@ -2061,27 +2156,75 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) else out_string = wv->name; - if (wv->title || wv->call_data == 0) + if (item != NULL) + fuFlags = MF_POPUP; + else if (wv->title || wv->call_data == 0) { -#if 0 /* no GC while popup menu is active */ - out_string = LocalAlloc (0, strlen (wv->name) + 1); - strcpy (out_string, wv->name); + /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since + we can't deallocate the memory otherwise. */ + if (get_menu_item_info) + { + out_string = (char *) local_alloc (strlen (wv->name) + 1); + strcpy (out_string, wv->name); +#ifdef MENU_DEBUG + DebPrint ("Menu: allocing %ld for owner-draw", out_string); #endif - fuFlags = MF_OWNERDRAW | MF_DISABLED; + fuFlags = MF_OWNERDRAW | MF_DISABLED; + } + else + fuFlags = MF_DISABLED; } + + /* Draw radio buttons and tickboxes. */ + else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE || + wv->button_type == BUTTON_TYPE_RADIO)) + fuFlags |= MF_CHECKED; + else + fuFlags |= MF_UNCHECKED; } - if (item != NULL) - fuFlags = MF_POPUP; + return_value = + AppendMenu (menu, + fuFlags, + item != NULL ? (UINT) item : (UINT) wv->call_data, + out_string ); + + /* This must be done after the menu item is created. */ + if (!wv->title && wv->call_data != 0) + { + if (set_menu_item_info) + { + MENUITEMINFO info; + bzero (&info, sizeof (info)); + info.cbSize = sizeof (info); + info.fMask = MIIM_DATA; + + /* Set help string for menu item. Leave it as a Lisp_Object + until it is ready to be displayed, since GC can happen while + menus are active. */ + if (wv->help) + info.dwItemData = (DWORD) wv->help; + + if (wv->button_type == BUTTON_TYPE_RADIO) + { + /* CheckMenuRadioItem allows us to differentiate TOGGLE and + RADIO items, but is not available on NT 3.51 and earlier. */ + info.fMask |= MIIM_TYPE | MIIM_STATE; + info.fType = MFT_RADIOCHECK | MFT_STRING; + info.dwTypeData = out_string; + info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED; + } - return AppendMenu (menu, - fuFlags, - item != NULL ? (UINT) item : (UINT) wv->call_data, - (fuFlags == MF_SEPARATOR) ? NULL: out_string ); + set_menu_item_info (menu, + item != NULL ? (UINT) item : (UINT) wv->call_data, + FALSE, &info); + } + } + return return_value; } /* Construct native Windows menu(bar) based on widget_value tree. */ -static int +int fill_in_menu (HMENU menu, widget_value *wv) { int items_added = 0; @@ -2111,19 +2254,126 @@ fill_in_menu (HMENU menu, widget_value *wv) return 1; } +int +popup_activated () +{ + /* popup_activated_flag not actually used on W32 */ + return 0; +} + +/* Display help string for currently pointed to menu item. Not + supported on NT 3.51 and earlier, as GetMenuItemInfo is not + available. */ +void +w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags) +{ + if (get_menu_item_info) + { + struct frame *f = x_window_to_frame (&one_w32_display_info, owner); + Lisp_Object frame, help; + + // No help echo on owner-draw menu items. + if (flags & MF_OWNERDRAW || flags & MF_POPUP) + help = Qnil; + else + { + MENUITEMINFO info; + + bzero (&info, sizeof (info)); + info.cbSize = sizeof (info); + info.fMask = MIIM_DATA; + get_menu_item_info (menu, item, FALSE, &info); + + help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil; + } + + /* Store the help echo in the keyboard buffer as the X toolkit + version does, rather than directly showing it. This seems to + solve the GC problems that were present when we based the + Windows code on the non-toolkit version. */ + if (f) + { + XSETFRAME (frame, f); + kbd_buffer_store_help_event (frame, help); + } + else + /* X version has a loop through frames here, which doesn't + appear to do anything, unless it has some side effect. */ + show_help_echo (help, Qnil, Qnil, Qnil, 1); + } +} + +/* Free memory used by owner-drawn strings. */ +static void +w32_free_submenu_strings (menu) + HMENU menu; +{ + int i, num = GetMenuItemCount (menu); + for (i = 0; i < num; i++) + { + MENUITEMINFO info; + bzero (&info, sizeof (info)); + info.cbSize = sizeof (info); + info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU; + + get_menu_item_info (menu, i, TRUE, &info); + + /* Owner-drawn names are held in dwItemData. */ + if ((info.fType & MF_OWNERDRAW) && info.dwItemData) + { +#ifdef MENU_DEBUG + DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData); +#endif + local_free (info.dwItemData); + } + + /* Recurse down submenus. */ + if (info.hSubMenu) + w32_free_submenu_strings (info.hSubMenu); + } +} + +void +w32_free_menu_strings (hwnd) + HWND hwnd; +{ + HMENU menu = current_popup_menu; + + if (get_menu_item_info) + { + /* If there is no popup menu active, free the strings from the frame's + menubar. */ + if (!menu) + menu = GetMenu (hwnd); + + if (menu) + w32_free_submenu_strings (menu); + } + + current_popup_menu = NULL; +} + #endif /* HAVE_MENUS */ + syms_of_w32menu () { + /* See if Get/SetMenuItemInfo functions are available. */ + HMODULE user32 = GetModuleHandle ("user32.dll"); + get_menu_item_info = GetProcAddress (user32, "GetMenuItemInfoA"); + set_menu_item_info = GetProcAddress (user32, "SetMenuItemInfoA"); + staticpro (&menu_items); menu_items = Qnil; + current_popup_menu = NULL; + 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\ -The enable predicate for a menu command should check this variable."); + doc: /* Frame for which we are updating a menu. +The enable predicate for a menu command should check this variable. */); Vmenu_updating_frame = Qnil; defsubr (&Sx_popup_menu);