X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fmenubar-msw.c;h=2cd701d419ac14cf6296e59dc50c950989858269;hp=bc47b7fe056937b49955f9de8f16390142cee809;hb=414b512c0774e67ba8e160b605447d862d3be166;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/src/menubar-msw.c b/src/menubar-msw.c index bc47b7f..2cd701d 100644 --- a/src/menubar-msw.c +++ b/src/menubar-msw.c @@ -1,7 +1,8 @@ /* Implements an elisp-programmable menubar -- Win32 Copyright (C) 1993, 1994 Free Software Foundation, Inc. Copyright (C) 1995 Tinker Systems and INS Engineering Corp. - Copyright (C) 1997 Kirill M. Katsnelson + Copyright (C) 1997 Kirill M. Katsnelson . + Copyright (C) 2000 Ben Wing. This file is part of XEmacs. @@ -22,12 +23,12 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ -/* Autorship: +/* Author: Initially written by kkm 12/24/97, peeking into and copying stuff from menubar-x.c */ -/* Algotirhm for handling menus is as follows. When window's menubar +/* Algorithm for handling menus is as follows. When window's menubar * is created, current-menubar is not traversed in depth. Rather, only * top level items, both items and pulldowns, are added to the * menubar. Each pulldown is initially empty. When a pulldown is @@ -39,45 +40,44 @@ Boston, MA 02111-1307, USA. */ * descriptor list given menu handle. The key is an opaque ptr data * type, keeping menu handle, and the value is a list of strings * representing the path from the root of the menu to the item - * descriptor. Each frame has an associated hashtable. + * descriptor. Each frame has an associated hash table. * * Leaf items are assigned a unique id based on item's hash. When an * item is selected, Windows sends back the id. Unfortunately, only * low 16 bit of the ID are sent, and there's no way to get the 32-bit * value. Yes, Win32 is just a different set of bugs than X! Aside - * from this blame, another hasing mechanism is required to map menu + * from this blame, another hashing mechanism is required to map menu * ids to commands (which are actually Lisp_Object's). This mapping is - * performed in the same hashtable, as the lifetime of both maps is - * exactly the same. This is unabmigous, as menu handles are + * performed in the same hash table, as the lifetime of both maps is + * exactly the same. This is unambigous, as menu handles are * represented by lisp opaques, while command ids are by lisp * integers. The additional advantage for this is that command forms * are automatically GC-protected, which is important because these * may be transient forms generated by :filter functions. * - * The hashtable is not allowed to grow too much; it is pruned + * The hash table is not allowed to grow too much; it is pruned * whenever this is safe to do. This is done by re-creating the menu * bar, and clearing and refilling the hash table from scratch. * - * Popup menus are handled identially to pulldowns. A static hash + * Popup menus are handled identically to pulldowns. A static hash * table is used for popup menus, and lookup is made not in * current-menubar but in a lisp form supplied to the `popup' * function. * * Another Windows weirdness is that there's no way to tell that a * popup has been dismissed without making selection. We need to know - * that to cleanup the popup menu hashtable, but this is not honestly + * that to cleanup the popup menu hash table, but this is not honestly * doable using *documented* sequence of messages. Sticking to * particular knowledge is bad because this may break in Windows NT * 5.0, or Windows 98, or other future version. Instead, I allow the - * hashtables to hang around, and not clear them, unless WM_COMMAND is - * received. This is worthy some memory but more safe. Hacks welcome, + * hash tables to hang around, and not clear them, unless WM_COMMAND is + * received. This is worth some memory but more safe. Hacks welcome, * anyways! * */ #include #include "lisp.h" -#include #include "buffer.h" #include "commands.h" @@ -93,7 +93,7 @@ Boston, MA 02111-1307, USA. */ #include "window.h" /* #### */ -#define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH 0 +#define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound)) #define EMPTY_ITEM_NAME "(empty)" @@ -101,8 +101,8 @@ Boston, MA 02111-1307, USA. */ /* Current menu (bar or popup) descriptor. gcpro'ed */ static Lisp_Object current_menudesc; -/* Current menubar or popup hashtable. gcpro'ed */ -static Lisp_Object current_hashtable; +/* Current menubar or popup hash table. gcpro'ed */ +static Lisp_Object current_hash_table; /* This is used to allocate unique ids to menu items. Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX. @@ -116,31 +116,135 @@ static Lisp_Object current_hashtable; #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000) static HMENU top_level_menu; -#define MAX_MENUITEM_LENGTH 128 +/* + * Translate (in place) X accelerator syntax to win32 accelerator syntax. + * Return new length. + * len = number of bytes (not including zero terminator). + * maxlen = size of buffer. + * accel = (Emchar*) to receive the accelerator character + * or NULL to suppress accelerators in the menu or dialog item. + * + * %% is replaced with % + * if accel is NULL: + * %_ is removed. + * if accel is non-NULL: + * %_ is replaced with &. + * The accelerator character is passed back in *accel. + * (If there is no accelerator, it will be added on the first character.) + * + * We assume and maintain zero-termination. To be absolutely sure + * of not hitting an error, maxlen should be >= 2*len + 3. + */ +Bytecount +mswindows_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len, + Bytecount maxlen, Emchar *accel, + Lisp_Object error_name) +{ + Bufbyte *ptr; + + if (accel) + *accel = '\0'; + + /* Escape '&' as '&&' */ + ptr = item; + while ((ptr = (Bufbyte *) memchr (ptr, '&', len - (ptr - item))) != NULL) + { + if (len + 2 > maxlen) + syntax_error ("Menu item produces too long displayable string", + error_name); + memmove (ptr + 1, ptr, (len - (ptr - item)) + 1); + len++; + ptr += 2; + } + + /* Replace XEmacs accelerator '%_' with Windows accelerator '&' + and `%%' with `%'. */ + ptr = item; + while ((ptr = memchr (ptr, '%', len - (ptr - item))) != NULL) + { + if (*(ptr + 1) == '_') + { + if (accel) + { + *ptr = '&'; + if (!*accel) + /* #### urk ! We need a reference translation table for + case changes that aren't buffer-specific. */ + *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 2)); + memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); + len--; + } + else /* Skip accelerator */ + { + memmove (ptr, ptr + 2, len - (ptr - item + 2) + 1); + len-=2; + } + } + else if (*(ptr + 1) == '%') + { + memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1); + len--; + ptr++; + } + else /* % on its own - shouldn't happen */ + ptr++; + } + + if (accel && !*accel) + { + /* Force a default accelerator */ + if (len + 2 > maxlen) + syntax_error ("Menu item produces too long displayable string", + error_name); + ptr = item; + memmove (ptr + 1, ptr, len + 1); + /* #### urk ! We need a reference translation table for + case changes that aren't buffer-specific. */ + *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 1)); + *ptr = '&'; + + len++; + } + + return len; +} /* * This returns Windows-style menu item string: * "Left Flush\tRight Flush" */ + +/* #### This is junk. Need correct handling of sizes. Use a Bufbyte_dynarr, + not a static buffer. */ static char* -displayable_menu_item (struct gui_item* pgui_item) +displayable_menu_item (Lisp_Object gui_item, int bar_p, Emchar *accel) { - /* We construct the name in a static buffer. That's fine, beause + unsigned int ll; + + /* We construct the name in a static buffer. That's fine, because menu items longer than 128 chars are probably programming errors, and better be caught than displayed! */ - + static char buf[MAX_MENUITEM_LENGTH+2]; - unsigned int ll, lr; /* Left flush part of the string */ - ll = gui_item_display_flush_left (pgui_item, buf, MAX_MENUITEM_LENGTH); + ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH); + + ll = mswindows_translate_menu_or_dialog_item ((Bufbyte *) buf, ll, + MAX_MENUITEM_LENGTH, accel, + XGUI_ITEM (gui_item)->name); - /* Right flush part */ - assert (MAX_MENUITEM_LENGTH > ll + 1); - lr = gui_item_display_flush_right (pgui_item, buf + ll + 1, - MAX_MENUITEM_LENGTH - ll - 1); - if (lr) - buf [ll] = '\t'; + /* Right flush part, unless we're at the top-level where it's not allowed */ + if (!bar_p) + { + unsigned int lr; + + assert (MAX_MENUITEM_LENGTH > ll + 1); + lr = gui_item_display_flush_right (gui_item, buf + ll + 1, + MAX_MENUITEM_LENGTH - ll - 1); + if (lr) + buf [ll] = '\t'; + } return buf; } @@ -157,7 +261,7 @@ hmenu_to_lisp_object (HMENU hmenu) /* * Allocation tries a hash based on item's path and name first. This * almost guarantees that the same item will override its old value in - * the hashtable rather than abandon it. + * the hash table rather than abandon it. */ static Lisp_Object allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix) @@ -187,9 +291,9 @@ empty_menu (HMENU menu, int add_empty_p) /* * The idea of checksumming is that we must hash minimal object - * which is neccessarily changes when the item changes. For separator + * which is necessarily changes when the item changes. For separator * this is a constant, for grey strings and submenus these are hashes - * of names, since sumbenus are unpopulated until opened so always + * of names, since submenus are unpopulated until opened so always * equal otherwise. For items, this is a full hash value of a callback, * because a callback may me a form which can be changed only somewhere * in depth. @@ -216,16 +320,21 @@ checksum_menu_item (Lisp_Object item) return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0), internal_hash (XVECTOR_DATA(item)[1], 0)); } - + /* An error - will be caught later */ return 0; } static void populate_menu_add_item (HMENU menu, Lisp_Object path, - Lisp_Object hash_tab, Lisp_Object item, int flush_right) + Lisp_Object hash_tab, Lisp_Object item, + Lisp_Object *accel_list, + int flush_right, int bar_p) { MENUITEMINFO item_info; + UINT oldflags = MF_BYPOSITION; + UINT olduidnewitem = 0; + LPCTSTR oldlpnewitem = 0; item_info.cbSize = sizeof (item_info); item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID; @@ -237,121 +346,157 @@ populate_menu_add_item (HMENU menu, Lisp_Object path, { /* Separator or unselectable text */ if (separator_string_p (XSTRING_DATA (item))) - item_info.fType = MFT_SEPARATOR; + { + item_info.fType = MFT_SEPARATOR; + oldflags |= MF_SEPARATOR; + } else { item_info.fType = MFT_STRING; item_info.fState = MFS_DISABLED; item_info.dwTypeData = XSTRING_DATA (item); + oldflags |= MF_STRING | MF_DISABLED; + oldlpnewitem = item_info.dwTypeData; } } else if (CONSP (item)) { /* Submenu */ HMENU submenu; - struct gui_item gui_item; - struct gcpro gcpro1; + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); + struct gcpro gcpro1, gcpro2, gcpro3; + Emchar accel; - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO3 (gui_item, path, *accel_list); - menu_parse_submenu_keywords (item, &gui_item); + menu_parse_submenu_keywords (item, gui_item); - if (!STRINGP (gui_item.name)) - signal_simple_error ("Menu name (first element) must be a string", item); + if (!STRINGP (pgui_item->name)) + syntax_error ("Menu name (first element) must be a string", + item); - if (!gui_item_included_p (&gui_item, Vmenubar_configuration)) - return; + if (!gui_item_included_p (gui_item, Vmenubar_configuration)) + { + UNGCPRO; + goto done; + } - if (!gui_item_active_p (&gui_item)) - item_info.fState = MFS_GRAYED; + if (!gui_item_active_p (gui_item)) + { + item_info.fState = MFS_GRAYED; + oldflags |= MF_GRAYED; + } /* Temptation is to put 'else' right here. Although, the displayed item won't have an arrow indicating that it is a popup. So we go ahead a little bit more and create a popup */ - submenu = create_empty_popup_menu(); + submenu = create_empty_popup_menu (); item_info.fMask |= MIIM_SUBMENU; - item_info.dwTypeData = displayable_menu_item (&gui_item); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); item_info.hSubMenu = submenu; + olduidnewitem = (UINT) submenu; + oldlpnewitem = item_info.dwTypeData; + oldflags |= MF_POPUP; + + if (accel && bar_p) + *accel_list = Fcons (make_char (accel), *accel_list); if (!(item_info.fState & MFS_GRAYED)) { /* Now add the full submenu path as a value to the hash table, keyed by menu handle */ if (NILP(path)) - /* list1 cannot GC */ - path = list1 (gui_item.name); + path = list1 (pgui_item->name); else { Lisp_Object arg[2]; arg[0] = path; - arg[1] = list1 (gui_item.name); - /* Fappend gcpro'es its arg */ + arg[1] = list1 (pgui_item->name); path = Fappend (2, arg); } - /* Fputhash GCPRO'es PATH */ Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab); } - UNGCPRO; /* gui_item */ - } + UNGCPRO; + } else if (VECTORP (item)) { /* An ordinary item */ Lisp_Object style, id; - struct gui_item gui_item; - struct gcpro gcpro1; + Lisp_Object gui_item = gui_parse_item_keywords (item); + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); + struct gcpro gcpro1, gcpro2; + Emchar accel; - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO2 (gui_item, *accel_list); - gui_parse_item_keywords (item, &gui_item); + if (!gui_item_included_p (gui_item, Vmenubar_configuration)) + { + UNGCPRO; + goto done; + } - if (!gui_item_included_p (&gui_item, Vmenubar_configuration)) - return; + if (!STRINGP (pgui_item->name)) + pgui_item->name = Feval (pgui_item->name); - if (!gui_item_active_p (&gui_item)) - item_info.fState = MFS_GRAYED; + if (!gui_item_active_p (gui_item)) + { + item_info.fState = MFS_GRAYED; + oldflags = MF_GRAYED; + } - style = (NILP (gui_item.selected) || NILP (Feval (gui_item.selected)) - ? Qnil : gui_item.style); + style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected)) + ? Qnil : pgui_item->style); if (EQ (style, Qradio)) { item_info.fType |= MFT_RADIOCHECK; item_info.fState |= MFS_CHECKED; + oldflags |= MF_CHECKED; /* Can't support radio-button checkmarks + under 3.51 */ } else if (EQ (style, Qtoggle)) { item_info.fState |= MFS_CHECKED; + oldflags |= MF_CHECKED; } - id = allocate_menu_item_id (path, gui_item.name, - gui_item.suffix); - Fputhash (id, gui_item.callback, hash_tab); + id = allocate_menu_item_id (path, pgui_item->name, + pgui_item->suffix); + Fputhash (id, pgui_item->callback, hash_tab); - item_info.wID = (UINT) XINT(id); + item_info.wID = (UINT) XINT (id); item_info.fType |= MFT_STRING; - item_info.dwTypeData = displayable_menu_item (&gui_item); + item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel); + olduidnewitem = item_info.wID; + oldflags |= MF_STRING; + oldlpnewitem = item_info.dwTypeData; - UNGCPRO; /* gui_item */ + if (accel && bar_p) + *accel_list = Fcons (make_char (accel), *accel_list); + + UNGCPRO; } else - { - signal_simple_error ("Mailformed menu item descriptor", item); - } + syntax_error ("Malformed menu item descriptor", item); if (flush_right) - item_info.fType |= MFT_RIGHTJUSTIFY; + item_info.fType |= MFT_RIGHTJUSTIFY; /* can't support in 3.51 */ + + if (xInsertMenuItemA) + xInsertMenuItemA (menu, UINT_MAX, TRUE, &item_info); + else + InsertMenu (menu, UINT_MAX, oldflags, olduidnewitem, oldlpnewitem); - InsertMenuItem (menu, UINT_MAX, TRUE, &item_info); -} +done:; +} /* * This function is called from populate_menu and checksum_menu. * When called to populate, MENU is a menu handle, PATH is a * list of strings representing menu path from root to this submenu, - * DESCRIPTOR is a menu descriptor, HASH_TAB is a hashtable associated + * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated * with root menu, BAR_P indicates whether this called for a menubar or * a popup, and POPULATE_P is non-zero. Return value must be ignored. * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P @@ -364,17 +509,18 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, { Lisp_Object item_desc; int deep_p, flush_right; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3; unsigned long checksum; - struct gui_item gui_item; + Lisp_Object gui_item = allocate_gui_item (); + Lisp_Object accel_list = Qnil; + Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item); - gui_item_init (&gui_item); - GCPRO_GUI_ITEM (&gui_item); + GCPRO3 (gui_item, accel_list, desc); /* We are sometimes called with the menubar unchanged, and with changed - right flush. We have to update the menubar in ths case, + right flush. We have to update the menubar in this case, so account for the compliance setting in the hash value */ - checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH; + checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH; /* Will initially contain only "(empty)" */ if (populate_p) @@ -384,15 +530,15 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, deep_p = !NILP (path); /* Fetch keywords prepending the item list */ - desc = menu_parse_submenu_keywords (desc, &gui_item); + desc = menu_parse_submenu_keywords (desc, gui_item); /* Check that menu name is specified when expected */ - if (NILP (gui_item.name) && deep_p) - signal_simple_error ("Menu must have a name", desc); + if (NILP (pgui_item->name) && deep_p) + syntax_error ("Menu must have a name", desc); /* Apply filter if specified */ - if (!NILP (gui_item.filter)) - desc = call1 (gui_item.filter, desc); + if (!NILP (pgui_item->filter)) + desc = call1 (pgui_item->filter, desc); /* Loop thru the desc's CDR and add items for each entry */ flush_right = 0; @@ -400,20 +546,21 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, { if (NILP (XCAR (item_desc))) { - /* Do not flush right menubar items when MS style compiant */ - if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIHGT_FLUSH) + /* Do not flush right menubar items when MS style compliant */ + if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH) flush_right = 1; if (!populate_p) checksum = HASH2 (checksum, LISP_HASH (Qnil)); } else if (populate_p) populate_menu_add_item (menu, path, hash_tab, - XCAR (item_desc), flush_right); + XCAR (item_desc), &accel_list, + flush_right, bar_p); else checksum = HASH2 (checksum, checksum_menu_item (XCAR (item_desc))); } - + if (populate_p) { /* Remove the "(empty)" item, if there are other ones */ @@ -422,23 +569,28 @@ populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc, /* Add the header to the popup, if told so. The same as in X - an insensitive item, and a separator (Seems to me, there were - two separators in X... In Windows this looks ugly, anywats. */ - if (!bar_p && !deep_p && popup_menu_titles && !NILP(gui_item.name)) + two separators in X... In Windows this looks ugly, anyways.) */ + if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name)) { - CHECK_STRING (gui_item.name); + CHECK_STRING (pgui_item->name); InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED, - 0, XSTRING_DATA(gui_item.name)); + 0, displayable_menu_item (gui_item, bar_p, NULL)); InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL); - SetMenuDefaultItem (menu, 0, MF_BYPOSITION); + if (xSetMenuDefaultItem) /* not in NT 3.5x */ + xSetMenuDefaultItem (menu, 0, MF_BYPOSITION); } } - UNGCPRO; /* gui_item */ + + if (bar_p) + Fputhash (Qt, accel_list, hash_tab); + + UNGCPRO; return checksum; } static void populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc, - Lisp_Object hash_tab, int bar_p) + Lisp_Object hash_tab, int bar_p) { populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1); } @@ -450,23 +602,28 @@ checksum_menu (Lisp_Object desc) } static void -update_frame_menubar_maybe (struct frame* f) +update_frame_menubar_maybe (struct frame *f) { HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f)); Lisp_Object desc = (!NILP (w->menubar_visible_p) ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer) : Qnil); + struct gcpro gcpro1; + + GCPRO1 (desc); /* it's safest to do this, just in case some filter + or something changes the value of current-menubar */ top_level_menu = menubar; if (NILP (desc) && menubar != NULL) { /* Menubar has gone */ - FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil; + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL); DestroyMenu (menubar); DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); + UNGCPRO; return; } @@ -480,28 +637,35 @@ update_frame_menubar_maybe (struct frame* f) if (NILP (desc)) { /* We did not have the bar and are not going to */ + UNGCPRO; return; } /* Now we bail out if the menubar has not changed */ - if (FRAME_MSWINDOWS_MENU_CHECKSUM(f) == checksum_menu (desc)) - return; + if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc)) + { + UNGCPRO; + return; + } populate: /* Come with empty hash table */ - if (NILP (FRAME_MSWINDOWS_MENU_HASHTABLE(f))) - FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Fmake_hashtable (make_int (50), Qequal); + if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))) + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = + make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); else - Fclrhash (FRAME_MSWINDOWS_MENU_HASHTABLE(f)); + Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); Fputhash (hmenu_to_lisp_object (menubar), Qnil, - FRAME_MSWINDOWS_MENU_HASHTABLE(f)); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); populate_menu (menubar, Qnil, desc, - FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar); DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f)); - FRAME_MSWINDOWS_MENU_CHECKSUM(f) = checksum_menu (desc); + FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc); + + UNGCPRO; } static void @@ -509,57 +673,73 @@ prune_menubar (struct frame *f) { HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f)); Lisp_Object desc = current_frame_menubar (f); + struct gcpro gcpro1; + if (menubar == NULL) return; - /* #### If a filter function has set desc to Qnil, this abort() - triggers. To resolve, we must prevent filters explicitely from + /* #### If a filter function has set desc to Qnil, this ABORT() + triggers. To resolve, we must prevent filters explicitly from mangling with the active menu. In apply_filter probably? Is copy-tree on the whole menu too expensive? */ - if (NILP(desc)) - /* abort(); */ + if (NILP (desc)) + /* ABORT(); */ return; + GCPRO1 (desc); /* just to be safe -- see above */ /* We do the trick by removing all items and re-populating top level */ empty_menu (menubar, 0); - assert (HASHTABLEP (FRAME_MSWINDOWS_MENU_HASHTABLE(f))); - Fclrhash (FRAME_MSWINDOWS_MENU_HASHTABLE(f)); + assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f))); + Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); Fputhash (hmenu_to_lisp_object (menubar), Qnil, - FRAME_MSWINDOWS_MENU_HASHTABLE(f)); - populate_menu (menubar, Qnil, desc, - FRAME_MSWINDOWS_MENU_HASHTABLE(f), 1); + FRAME_MSWINDOWS_MENU_HASH_TABLE (f)); + populate_menu (menubar, Qnil, desc, + FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1); + UNGCPRO; } /* * This is called when cleanup is possible. It is better not to - * clean things up at all than do it too earaly! + * clean things up at all than do it too early! */ static void menu_cleanup (struct frame *f) { /* This function can GC */ current_menudesc = Qnil; - current_hashtable = Qnil; + current_hash_table = Qnil; prune_menubar (f); } - + +int +mswindows_char_is_accelerator (struct frame *f, Emchar ch) +{ + Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); + + if (NILP (hash)) + return 0; + /* !!#### not Mule-ized */ + return !NILP (memq_no_quit (make_char (tolower (ch)), + Fgethash (Qt, hash, Qnil))); +} + /*------------------------------------------------------------------------*/ /* Message handlers */ /*------------------------------------------------------------------------*/ static Lisp_Object -unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f) +unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f) { /* This function can call lisp, beat dogs and stick chewing gum to everything! */ Lisp_Object path, desc; struct gcpro gcpro1; - + /* Find which guy is going to explode */ - path = Fgethash (hmenu_to_lisp_object (menu), current_hashtable, Qunbound); + path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound); assert (!UNBOUNDP (path)); #ifdef DEBUG_XEMACS /* Allow to continue in a debugger after assert - not so fatal */ @@ -576,13 +756,13 @@ unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame* f) /* Now, stuff it */ /* DESC may be generated by filter, so we have to gcpro it */ GCPRO1 (desc); - populate_menu (menu, path, desc, current_hashtable, 0); + populate_menu (menu, path, desc, current_hash_table, 0); UNGCPRO; return Qt; } static Lisp_Object -unsafe_handle_wm_initmenu_1 (struct frame* f) +unsafe_handle_wm_initmenu_1 (struct frame *f) { /* This function can call lisp */ @@ -599,8 +779,8 @@ unsafe_handle_wm_initmenu_1 (struct frame* f) update_frame_menubar_maybe (f); current_menudesc = current_frame_menubar (f); - current_hashtable = FRAME_MSWINDOWS_MENU_HASHTABLE(f); - assert (HASHTABLEP (current_hashtable)); + current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f); + assert (HASH_TABLEP (current_hash_table)); return Qt; } @@ -612,20 +792,24 @@ unsafe_handle_wm_initmenu_1 (struct frame* f) * command if we return nil */ Lisp_Object -mswindows_handle_wm_command (struct frame* f, WORD id) +mswindows_handle_wm_command (struct frame *f, WORD id) { /* Try to map the command id through the proper hash table */ Lisp_Object data, fn, arg, frame; struct gcpro gcpro1; - data = Fgethash (make_int (id), current_hashtable, Qunbound); + if (NILP (current_hash_table)) + return Qnil; + + data = Fgethash (make_int (id), current_hash_table, Qunbound); + if (UNBOUNDP (data)) { menu_cleanup (f); return Qnil; } - /* Need to gcpro because the hashtable may get destroyed by + /* Need to gcpro because the hash table may get destroyed by menu_cleanup(), and will not gcpro the data any more */ GCPRO1 (data); menu_cleanup (f); @@ -635,10 +819,9 @@ mswindows_handle_wm_command (struct frame* f, WORD id) XSETFRAME (frame, f); /* this used to call mswindows_enqueue_misc_user_event but that breaks customize because the misc_event gets eval'ed in some - cicumstances. Don't change it back unless you can fix the + circumstances. Don't change it back unless you can fix the customize problem also.*/ - enqueue_misc_user_event (frame, fn, arg); - mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE); + mswindows_enqueue_misc_user_event (frame, fn, arg); UNGCPRO; /* data */ return Qt; @@ -650,7 +833,7 @@ mswindows_handle_wm_command (struct frame* f, WORD id) /*------------------------------------------------------------------------*/ static HMENU wm_initmenu_menu; -static struct frame* wm_initmenu_frame; +static struct frame *wm_initmenu_frame; static Lisp_Object unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d) @@ -665,7 +848,7 @@ unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d) } Lisp_Object -mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm) +mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) { /* We cannot pass hmenu as a lisp object. Use static var */ wm_initmenu_menu = hmenu; @@ -674,10 +857,10 @@ mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame* frm) } Lisp_Object -mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f) +mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f) { /* Handle only frame menubar, ignore if from popup or system menu */ - if (GetMenu (FRAME_MSWINDOWS_HANDLE(f)) == hmenu) + if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) { wm_initmenu_frame = f; return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil); @@ -691,25 +874,28 @@ mswindows_handle_wm_initmenu (HMENU hmenu, struct frame* f) /*------------------------------------------------------------------------*/ static void -mswindows_update_frame_menubars (struct frame* f) +mswindows_update_frame_menubars (struct frame *f) { update_frame_menubar_maybe (f); } static void -mswindows_free_frame_menubars (struct frame* f) +mswindows_free_frame_menubars (struct frame *f) { - FRAME_MSWINDOWS_MENU_HASHTABLE(f) = Qnil; + FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil; } static void mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) { struct frame *f = selected_frame (); - struct Lisp_Event *eev = NULL; + Lisp_Event *eev = NULL; HMENU menu; POINT pt; int ok; + struct gcpro gcpro1; + + GCPRO1 (menu_desc); /* to be safe -- see above */ if (!NILP (event)) { @@ -729,6 +915,8 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) eev = NULL; } + popup_up_p++; + /* Default is to put the menu at the point (10, 10) in frame */ if (eev) { @@ -744,16 +932,19 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) CHECK_CONS (menu_desc); CHECK_STRING (XCAR (menu_desc)); + menu_cleanup (f); + current_menudesc = menu_desc; - current_hashtable = Fmake_hashtable (make_int(10), Qequal); - menu = create_empty_popup_menu(); - Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hashtable); + current_hash_table = + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); + menu = create_empty_popup_menu (); + Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table); top_level_menu = menu; - + /* see comments in menubar-x.c */ if (zmacs_regions) zmacs_region_stays = 1; - + ok = TrackPopupMenu (menu, TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON, pt.x, pt.y, 0, @@ -761,15 +952,25 @@ mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event) DestroyMenu (menu); - /* Signal a signal if caught by Track...() modal loop */ + /* A WM_COMMAND is not issued until TrackPopupMenu returns. This + makes setting popup_up_p fairly pointless since we cannot keep + the menu up and dispatch events. Furthermore, we seem to have + little control over what happens to the menu when we click. */ + popup_up_p--; + + /* Signal a signal if caught by Track...() modal loop. */ + /* I think this is pointless, the code hasn't actually put us in a + modal loop at this time -- andyp. */ mswindows_unmodalize_signal_maybe (); /* This is probably the only real reason for failure */ - if (!ok) { - menu_cleanup (f); - signal_simple_error ("Cannot track popup menu while in menu", - menu_desc); - } + if (!ok) + { + menu_cleanup (f); + signal_simple_error ("Cannot track popup menu while in menu", + menu_desc); + } + UNGCPRO; } @@ -793,8 +994,8 @@ void vars_of_menubar_mswindows (void) { current_menudesc = Qnil; - current_hashtable = Qnil; + current_hash_table = Qnil; staticpro (¤t_menudesc); - staticpro (¤t_hashtable); + staticpro (¤t_hash_table); }