1 /* Implements an elisp-programmable menubar -- Win32
2 Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
4 Copyright (C) 1997 Kirill M. Katsnelson <kkm@kis.ru>.
5 Copyright (C) 2000 Ben Wing.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Not in FSF. */
27 Initially written by kkm 12/24/97,
28 peeking into and copying stuff from menubar-x.c
31 /* Algorithm for handling menus is as follows. When window's menubar
32 * is created, current-menubar is not traversed in depth. Rather, only
33 * top level items, both items and pulldowns, are added to the
34 * menubar. Each pulldown is initially empty. When a pulldown is
35 * selected and about to open, corresponding element of
36 * current-menubar is found, and the newly open pulldown is
37 * populated. This is made again in the same non-recursive manner.
39 * This algorithm uses hash tables to find out element of the menu
40 * descriptor list given menu handle. The key is an opaque ptr data
41 * type, keeping menu handle, and the value is a list of strings
42 * representing the path from the root of the menu to the item
43 * descriptor. Each frame has an associated hash table.
45 * Leaf items are assigned a unique id based on item's hash. When an
46 * item is selected, Windows sends back the id. Unfortunately, only
47 * low 16 bit of the ID are sent, and there's no way to get the 32-bit
48 * value. Yes, Win32 is just a different set of bugs than X! Aside
49 * from this blame, another hashing mechanism is required to map menu
50 * ids to commands (which are actually Lisp_Object's). This mapping is
51 * performed in the same hash table, as the lifetime of both maps is
52 * exactly the same. This is unambigous, as menu handles are
53 * represented by lisp opaques, while command ids are by lisp
54 * integers. The additional advantage for this is that command forms
55 * are automatically GC-protected, which is important because these
56 * may be transient forms generated by :filter functions.
58 * The hash table is not allowed to grow too much; it is pruned
59 * whenever this is safe to do. This is done by re-creating the menu
60 * bar, and clearing and refilling the hash table from scratch.
62 * Popup menus are handled identically to pulldowns. A static hash
63 * table is used for popup menus, and lookup is made not in
64 * current-menubar but in a lisp form supplied to the `popup'
67 * Another Windows weirdness is that there's no way to tell that a
68 * popup has been dismissed without making selection. We need to know
69 * that to cleanup the popup menu hash table, but this is not honestly
70 * doable using *documented* sequence of messages. Sticking to
71 * particular knowledge is bad because this may break in Windows NT
72 * 5.0, or Windows 98, or other future version. Instead, I allow the
73 * hash tables to hang around, and not clear them, unless WM_COMMAND is
74 * received. This is worth some memory but more safe. Hacks welcome,
84 #include "console-msw.h"
91 #include "menubar-msw.h"
96 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0
98 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
99 #define EMPTY_ITEM_NAME "(empty)"
101 /* Current menu (bar or popup) descriptor. gcpro'ed */
102 static Lisp_Object current_menudesc;
104 /* Current menubar or popup hash table. gcpro'ed */
105 static Lisp_Object current_hash_table;
107 /* This is used to allocate unique ids to menu items.
108 Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
109 Allocation checks that the item is not already in
110 the TOP_LEVEL_MENU */
112 /* #### defines go to gui-msw.h, as the range is shared with toolbars
113 (If only toolbars will be implemented as common controls) */
114 #define MENU_ITEM_ID_MIN 0x8000
115 #define MENU_ITEM_ID_MAX 0xFFFF
116 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000)
117 static HMENU top_level_menu;
120 * Translate (in place) X accelerator syntax to win32 accelerator syntax.
122 * len = number of bytes (not including zero terminator).
123 * maxlen = size of buffer.
124 * accel = (Emchar*) to receive the accelerator character
125 * or NULL to suppress accelerators in the menu or dialog item.
127 * %% is replaced with %
130 * if accel is non-NULL:
131 * %_ is replaced with &.
132 * The accelerator character is passed back in *accel.
133 * (If there is no accelerator, it will be added on the first character.)
135 * We assume and maintain zero-termination. To be absolutely sure
136 * of not hitting an error, maxlen should be >= 2*len + 3.
139 mswindows_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
140 Bytecount maxlen, Emchar *accel,
141 Lisp_Object error_name)
148 /* Escape '&' as '&&' */
150 while ((ptr = (Bufbyte *) memchr (ptr, '&', len - (ptr - item))) != NULL)
152 if (len + 2 > maxlen)
153 syntax_error ("Menu item produces too long displayable string",
155 memmove (ptr + 1, ptr, (len - (ptr - item)) + 1);
160 /* Replace XEmacs accelerator '%_' with Windows accelerator '&'
161 and `%%' with `%'. */
163 while ((ptr = memchr (ptr, '%', len - (ptr - item))) != NULL)
165 if (*(ptr + 1) == '_')
171 /* #### urk ! We need a reference translation table for
172 case changes that aren't buffer-specific. */
173 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 2));
174 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1);
177 else /* Skip accelerator */
179 memmove (ptr, ptr + 2, len - (ptr - item + 2) + 1);
183 else if (*(ptr + 1) == '%')
185 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1);
189 else /* % on its own - shouldn't happen */
193 if (accel && !*accel)
195 /* Force a default accelerator */
196 if (len + 2 > maxlen)
197 syntax_error ("Menu item produces too long displayable string",
200 memmove (ptr + 1, ptr, len + 1);
201 /* #### urk ! We need a reference translation table for
202 case changes that aren't buffer-specific. */
203 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 1));
213 * This returns Windows-style menu item string:
214 * "Left Flush\tRight Flush"
217 /* #### This is junk. Need correct handling of sizes. Use a Bufbyte_dynarr,
218 not a static buffer. */
220 displayable_menu_item (Lisp_Object gui_item, int bar_p, Emchar *accel)
224 /* We construct the name in a static buffer. That's fine, because
225 menu items longer than 128 chars are probably programming errors,
226 and better be caught than displayed! */
228 static char buf[MAX_MENUITEM_LENGTH+2];
230 /* Left flush part of the string */
231 ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH);
233 ll = mswindows_translate_menu_or_dialog_item ((Bufbyte *) buf, ll,
234 MAX_MENUITEM_LENGTH, accel,
235 XGUI_ITEM (gui_item)->name);
237 /* Right flush part, unless we're at the top-level where it's not allowed */
242 assert (MAX_MENUITEM_LENGTH > ll + 1);
243 lr = gui_item_display_flush_right (gui_item, buf + ll + 1,
244 MAX_MENUITEM_LENGTH - ll - 1);
253 * hmenu_to_lisp_object() returns an opaque ptr given menu handle.
256 hmenu_to_lisp_object (HMENU hmenu)
258 return make_opaque_ptr (hmenu);
262 * Allocation tries a hash based on item's path and name first. This
263 * almost guarantees that the same item will override its old value in
264 * the hash table rather than abandon it.
267 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix)
269 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0),
270 internal_hash (name, 0),
271 internal_hash (suffix, 0)));
273 id = MENU_ITEM_ID_BITS (id + 1);
274 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF);
275 return make_int (id);
279 create_empty_popup_menu (void)
281 return CreatePopupMenu ();
285 empty_menu (HMENU menu, int add_empty_p)
287 while (DeleteMenu (menu, 0, MF_BYPOSITION));
289 AppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, EMPTY_ITEM_NAME);
293 * The idea of checksumming is that we must hash minimal object
294 * which is necessarily changes when the item changes. For separator
295 * this is a constant, for grey strings and submenus these are hashes
296 * of names, since submenus are unpopulated until opened so always
297 * equal otherwise. For items, this is a full hash value of a callback,
298 * because a callback may me a form which can be changed only somewhere
302 checksum_menu_item (Lisp_Object item)
306 /* Separator or unselectable text - hash as a string + 13 */
307 if (separator_string_p (XSTRING_DATA (item)))
310 return internal_hash (item, 0) + 13;
312 else if (CONSP (item))
314 /* Submenu - hash by its string name + 0 */
315 return internal_hash (XCAR(item), 0);
317 else if (VECTORP (item))
319 /* An ordinary item - hash its name and callback form. */
320 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0),
321 internal_hash (XVECTOR_DATA(item)[1], 0));
324 /* An error - will be caught later */
329 populate_menu_add_item (HMENU menu, Lisp_Object path,
330 Lisp_Object hash_tab, Lisp_Object item,
331 Lisp_Object *accel_list,
332 int flush_right, int bar_p)
334 MENUITEMINFO item_info;
335 UINT oldflags = MF_BYPOSITION;
336 UINT olduidnewitem = 0;
337 LPCTSTR oldlpnewitem = 0;
339 item_info.cbSize = sizeof (item_info);
340 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID;
341 item_info.fState = 0;
347 /* Separator or unselectable text */
348 if (separator_string_p (XSTRING_DATA (item)))
350 item_info.fType = MFT_SEPARATOR;
351 oldflags |= MF_SEPARATOR;
355 item_info.fType = MFT_STRING;
356 item_info.fState = MFS_DISABLED;
357 item_info.dwTypeData = XSTRING_DATA (item);
358 oldflags |= MF_STRING | MF_DISABLED;
359 oldlpnewitem = item_info.dwTypeData;
362 else if (CONSP (item))
366 Lisp_Object gui_item = allocate_gui_item ();
367 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
368 struct gcpro gcpro1, gcpro2, gcpro3;
371 GCPRO3 (gui_item, path, *accel_list);
373 menu_parse_submenu_keywords (item, gui_item);
375 if (!STRINGP (pgui_item->name))
376 syntax_error ("Menu name (first element) must be a string",
379 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
385 if (!gui_item_active_p (gui_item))
387 item_info.fState = MFS_GRAYED;
388 oldflags |= MF_GRAYED;
390 /* Temptation is to put 'else' right here. Although, the
391 displayed item won't have an arrow indicating that it is a
392 popup. So we go ahead a little bit more and create a popup */
393 submenu = create_empty_popup_menu ();
395 item_info.fMask |= MIIM_SUBMENU;
396 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel);
397 item_info.hSubMenu = submenu;
398 olduidnewitem = (UINT) submenu;
399 oldlpnewitem = item_info.dwTypeData;
400 oldflags |= MF_POPUP;
403 *accel_list = Fcons (make_char (accel), *accel_list);
405 if (!(item_info.fState & MFS_GRAYED))
407 /* Now add the full submenu path as a value to the hash table,
408 keyed by menu handle */
410 path = list1 (pgui_item->name);
415 arg[1] = list1 (pgui_item->name);
416 path = Fappend (2, arg);
419 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
423 else if (VECTORP (item))
425 /* An ordinary item */
426 Lisp_Object style, id;
427 Lisp_Object gui_item = gui_parse_item_keywords (item);
428 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
429 struct gcpro gcpro1, gcpro2;
432 GCPRO2 (gui_item, *accel_list);
434 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
440 if (!STRINGP (pgui_item->name))
441 pgui_item->name = Feval (pgui_item->name);
443 if (!gui_item_active_p (gui_item))
445 item_info.fState = MFS_GRAYED;
446 oldflags = MF_GRAYED;
449 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected))
450 ? Qnil : pgui_item->style);
452 if (EQ (style, Qradio))
454 item_info.fType |= MFT_RADIOCHECK;
455 item_info.fState |= MFS_CHECKED;
456 oldflags |= MF_CHECKED; /* Can't support radio-button checkmarks
459 else if (EQ (style, Qtoggle))
461 item_info.fState |= MFS_CHECKED;
462 oldflags |= MF_CHECKED;
465 id = allocate_menu_item_id (path, pgui_item->name,
467 Fputhash (id, pgui_item->callback, hash_tab);
469 item_info.wID = (UINT) XINT (id);
470 item_info.fType |= MFT_STRING;
471 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel);
472 olduidnewitem = item_info.wID;
473 oldflags |= MF_STRING;
474 oldlpnewitem = item_info.dwTypeData;
477 *accel_list = Fcons (make_char (accel), *accel_list);
482 syntax_error ("Malformed menu item descriptor", item);
485 item_info.fType |= MFT_RIGHTJUSTIFY; /* can't support in 3.51 */
487 if (xInsertMenuItemA)
488 xInsertMenuItemA (menu, UINT_MAX, TRUE, &item_info);
490 InsertMenu (menu, UINT_MAX, oldflags, olduidnewitem, oldlpnewitem);
496 * This function is called from populate_menu and checksum_menu.
497 * When called to populate, MENU is a menu handle, PATH is a
498 * list of strings representing menu path from root to this submenu,
499 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated
500 * with root menu, BAR_P indicates whether this called for a menubar or
501 * a popup, and POPULATE_P is non-zero. Return value must be ignored.
502 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
503 * is zero, PATH must be Qnil, and the rest of parameters is ignored.
504 * Return value is the menu checksum.
507 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
508 Lisp_Object hash_tab, int bar_p, int populate_p)
510 Lisp_Object item_desc;
511 int deep_p, flush_right;
512 struct gcpro gcpro1, gcpro2, gcpro3;
513 unsigned long checksum;
514 Lisp_Object gui_item = allocate_gui_item ();
515 Lisp_Object accel_list = Qnil;
516 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
518 GCPRO3 (gui_item, accel_list, desc);
520 /* We are sometimes called with the menubar unchanged, and with changed
521 right flush. We have to update the menubar in this case,
522 so account for the compliance setting in the hash value */
523 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH;
525 /* Will initially contain only "(empty)" */
527 empty_menu (menu, 1);
529 /* PATH set to nil indicates top-level popup or menubar */
530 deep_p = !NILP (path);
532 /* Fetch keywords prepending the item list */
533 desc = menu_parse_submenu_keywords (desc, gui_item);
535 /* Check that menu name is specified when expected */
536 if (NILP (pgui_item->name) && deep_p)
537 syntax_error ("Menu must have a name", desc);
539 /* Apply filter if specified */
540 if (!NILP (pgui_item->filter))
541 desc = call1 (pgui_item->filter, desc);
543 /* Loop thru the desc's CDR and add items for each entry */
545 EXTERNAL_LIST_LOOP (item_desc, desc)
547 if (NILP (XCAR (item_desc)))
549 /* Do not flush right menubar items when MS style compliant */
550 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH)
553 checksum = HASH2 (checksum, LISP_HASH (Qnil));
556 populate_menu_add_item (menu, path, hash_tab,
557 XCAR (item_desc), &accel_list,
560 checksum = HASH2 (checksum,
561 checksum_menu_item (XCAR (item_desc)));
566 /* Remove the "(empty)" item, if there are other ones */
567 if (GetMenuItemCount (menu) > 1)
568 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
570 /* Add the header to the popup, if told so. The same as in X - an
571 insensitive item, and a separator (Seems to me, there were
572 two separators in X... In Windows this looks ugly, anyways.) */
573 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name))
575 CHECK_STRING (pgui_item->name);
576 InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
577 0, displayable_menu_item (gui_item, bar_p, NULL));
578 InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
579 if (xSetMenuDefaultItem) /* not in NT 3.5x */
580 xSetMenuDefaultItem (menu, 0, MF_BYPOSITION);
585 Fputhash (Qt, accel_list, hash_tab);
592 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc,
593 Lisp_Object hash_tab, int bar_p)
595 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1);
599 checksum_menu (Lisp_Object desc)
601 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0);
605 update_frame_menubar_maybe (struct frame *f)
607 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
608 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
609 Lisp_Object desc = (!NILP (w->menubar_visible_p)
610 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer)
614 GCPRO1 (desc); /* it's safest to do this, just in case some filter
615 or something changes the value of current-menubar */
617 top_level_menu = menubar;
619 if (NILP (desc) && menubar != NULL)
621 /* Menubar has gone */
622 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
623 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
624 DestroyMenu (menubar);
625 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
630 if (!NILP (desc) && menubar == NULL)
632 /* Menubar has appeared */
633 menubar = CreateMenu ();
639 /* We did not have the bar and are not going to */
644 /* Now we bail out if the menubar has not changed */
645 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc))
652 /* Come with empty hash table */
653 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)))
654 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) =
655 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
657 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
659 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
660 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
661 populate_menu (menubar, Qnil, desc,
662 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
663 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
664 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
666 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc);
672 prune_menubar (struct frame *f)
674 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
675 Lisp_Object desc = current_frame_menubar (f);
681 /* #### If a filter function has set desc to Qnil, this ABORT()
682 triggers. To resolve, we must prevent filters explicitly from
683 mangling with the active menu. In apply_filter probably?
684 Is copy-tree on the whole menu too expensive? */
689 GCPRO1 (desc); /* just to be safe -- see above */
690 /* We do the trick by removing all items and re-populating top level */
691 empty_menu (menubar, 0);
693 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)));
694 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
696 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
697 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
698 populate_menu (menubar, Qnil, desc,
699 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
704 * This is called when cleanup is possible. It is better not to
705 * clean things up at all than do it too early!
708 menu_cleanup (struct frame *f)
710 /* This function can GC */
711 current_menudesc = Qnil;
712 current_hash_table = Qnil;
717 mswindows_char_is_accelerator (struct frame *f, Emchar ch)
719 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
723 /* !!#### not Mule-ized */
724 return !NILP (memq_no_quit (make_char (tolower (ch)),
725 Fgethash (Qt, hash, Qnil)));
729 /*------------------------------------------------------------------------*/
730 /* Message handlers */
731 /*------------------------------------------------------------------------*/
733 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f)
735 /* This function can call lisp, beat dogs and stick chewing gum to
738 Lisp_Object path, desc;
741 /* Find which guy is going to explode */
742 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound);
743 assert (!UNBOUNDP (path));
745 /* Allow to continue in a debugger after assert - not so fatal */
747 error ("internal menu error");
750 /* Now find a desc chunk for it. If none, then probably menu open
751 hook has played too much games around stuff */
752 desc = Fmenu_find_real_submenu (current_menudesc, path);
754 signal_simple_error ("This menu does not exist any more", path);
757 /* DESC may be generated by filter, so we have to gcpro it */
759 populate_menu (menu, path, desc, current_hash_table, 0);
765 unsafe_handle_wm_initmenu_1 (struct frame *f)
767 /* This function can call lisp */
769 /* NOTE: This is called for the bar only, WM_INITMENU
770 for popups is filtered out */
772 /* #### - this menubar update mechanism is expensively anti-social and
773 the activate-menubar-hook is now mostly obsolete. */
775 /* We simply ignore return value. In any case, we construct the bar
777 run_hook (Qactivate_menubar_hook);
779 update_frame_menubar_maybe (f);
781 current_menudesc = current_frame_menubar (f);
782 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
783 assert (HASH_TABLEP (current_hash_table));
789 * Return value is Qt if we have dispatched the command,
790 * or Qnil if id has not been mapped to a callback.
791 * Window procedure may try other targets to route the
792 * command if we return nil
795 mswindows_handle_wm_command (struct frame *f, WORD id)
797 /* Try to map the command id through the proper hash table */
798 Lisp_Object data, fn, arg, frame;
801 if (NILP (current_hash_table))
804 data = Fgethash (make_int (id), current_hash_table, Qunbound);
812 /* Need to gcpro because the hash table may get destroyed by
813 menu_cleanup(), and will not gcpro the data any more */
817 /* Ok, this is our one. Enqueue it. */
818 get_gui_callback (data, &fn, &arg);
819 XSETFRAME (frame, f);
820 /* this used to call mswindows_enqueue_misc_user_event but that
821 breaks customize because the misc_event gets eval'ed in some
822 circumstances. Don't change it back unless you can fix the
823 customize problem also.*/
824 mswindows_enqueue_misc_user_event (frame, fn, arg);
831 /*------------------------------------------------------------------------*/
832 /* Message handling proxies */
833 /*------------------------------------------------------------------------*/
835 static HMENU wm_initmenu_menu;
836 static struct frame *wm_initmenu_frame;
839 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d)
841 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame);
845 unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d)
847 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame);
851 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm)
853 /* We cannot pass hmenu as a lisp object. Use static var */
854 wm_initmenu_menu = hmenu;
855 wm_initmenu_frame = frm;
856 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil);
860 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f)
862 /* Handle only frame menubar, ignore if from popup or system menu */
863 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu)
865 wm_initmenu_frame = f;
866 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
872 /*------------------------------------------------------------------------*/
874 /*------------------------------------------------------------------------*/
877 mswindows_update_frame_menubars (struct frame *f)
879 update_frame_menubar_maybe (f);
883 mswindows_free_frame_menubars (struct frame *f)
885 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
889 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
891 struct frame *f = selected_frame ();
892 Lisp_Event *eev = NULL;
898 GCPRO1 (menu_desc); /* to be safe -- see above */
902 CHECK_LIVE_EVENT (event);
903 eev = XEVENT (event);
904 if (eev->event_type != button_press_event
905 && eev->event_type != button_release_event)
906 wrong_type_argument (Qmouse_event_p, event);
908 else if (!NILP (Vthis_command_keys))
910 /* if an event wasn't passed, use the last event of the event sequence
911 currently being executed, if that event is a mouse event */
912 eev = XEVENT (Vthis_command_keys); /* last event first */
913 if (eev->event_type != button_press_event
914 && eev->event_type != button_release_event)
920 /* Default is to put the menu at the point (10, 10) in frame */
923 pt.x = eev->event.button.x;
924 pt.y = eev->event.button.y;
925 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt);
930 if (SYMBOLP (menu_desc))
931 menu_desc = Fsymbol_value (menu_desc);
932 CHECK_CONS (menu_desc);
933 CHECK_STRING (XCAR (menu_desc));
937 current_menudesc = menu_desc;
939 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
940 menu = create_empty_popup_menu ();
941 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table);
942 top_level_menu = menu;
944 /* see comments in menubar-x.c */
946 zmacs_region_stays = 1;
948 ok = TrackPopupMenu (menu,
949 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
951 FRAME_MSWINDOWS_HANDLE (f), NULL);
955 /* A WM_COMMAND is not issued until TrackPopupMenu returns. This
956 makes setting popup_up_p fairly pointless since we cannot keep
957 the menu up and dispatch events. Furthermore, we seem to have
958 little control over what happens to the menu when we click. */
961 /* Signal a signal if caught by Track...() modal loop. */
962 /* I think this is pointless, the code hasn't actually put us in a
963 modal loop at this time -- andyp. */
964 mswindows_unmodalize_signal_maybe ();
966 /* This is probably the only real reason for failure */
970 signal_simple_error ("Cannot track popup menu while in menu",
977 /*------------------------------------------------------------------------*/
979 /*------------------------------------------------------------------------*/
981 syms_of_menubar_mswindows (void)
986 console_type_create_menubar_mswindows (void)
988 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars);
989 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars);
990 CONSOLE_HAS_METHOD (mswindows, popup_menu);
994 vars_of_menubar_mswindows (void)
996 current_menudesc = Qnil;
997 current_hash_table = Qnil;
999 staticpro (¤t_menudesc);
1000 staticpro (¤t_hash_table);