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,
85 #include "console-msw.h"
92 #include "menubar-msw.h"
97 #define REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH 0
99 #define EMPTY_ITEM_ID ((UINT)LISP_TO_VOID (Qunbound))
100 #define EMPTY_ITEM_NAME "(empty)"
102 /* Current menu (bar or popup) descriptor. gcpro'ed */
103 static Lisp_Object current_menudesc;
105 /* Current menubar or popup hash table. gcpro'ed */
106 static Lisp_Object current_hash_table;
108 /* This is used to allocate unique ids to menu items.
109 Items ids are in MENU_ITEM_ID_MIN to MENU_ITEM_ID_MAX.
110 Allocation checks that the item is not already in
111 the TOP_LEVEL_MENU */
113 /* #### defines go to gui-msw.h, as the range is shared with toolbars
114 (If only toolbars will be implemented as common controls) */
115 #define MENU_ITEM_ID_MIN 0x8000
116 #define MENU_ITEM_ID_MAX 0xFFFF
117 #define MENU_ITEM_ID_BITS(x) (((x) & 0x7FFF) | 0x8000)
118 static HMENU top_level_menu;
120 /* Translate (in place) %_ to &, %% to %.
121 Return new length, and (through accel) the accelerator character.
122 (If there is no accelerator, it will be added on the first character.)
123 len = number of bytes (not including zero terminator).
124 maxlen = size of buffer.
125 We assume and maintain zero-termination. To be absolutely sure
126 of not hitting an error, maxlen should be >= 2*len + 3. */
129 msw_translate_menu_or_dialog_item (Bufbyte *item, Bytecount len,
130 Bytecount maxlen, Emchar *accel,
131 Lisp_Object error_name)
137 /* Escape '&' as '&&' */
140 while ((ptr = (Bufbyte *) memchr (ptr, '&', len - (ptr - item))) != NULL)
142 if (len + 2 > maxlen)
143 signal_simple_error ("Menu item produces too long displayable string",
145 memmove (ptr + 1, ptr, (len - (ptr - item)) + 1);
150 /* Replace XEmacs accelerator '%_' with Windows accelerator '&'
151 and `%%' with `%'. */
153 while ((ptr = memchr (ptr, '%', len - (ptr - item))) != NULL)
155 if (*(ptr + 1) == '_')
159 /* #### urk ! We need a reference translation table for
160 case changes that aren't buffer-specific. */
161 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 2));
162 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1);
165 else if (*(ptr + 1) == '%')
167 memmove (ptr + 1, ptr + 2, len - (ptr - item + 2) + 1);
175 if (len + 2 > maxlen)
176 signal_simple_error ("Menu item produces too long displayable string",
179 memmove (ptr + 1, ptr, len + 1);
180 /* #### urk ! We need a reference translation table for
181 case changes that aren't buffer-specific. */
182 *accel = DOWNCASE (current_buffer, charptr_emchar (ptr + 1));
192 * This returns Windows-style menu item string:
193 * "Left Flush\tRight Flush"
196 /* #### This is junk. Need correct handling of sizes. Use a Bufbyte_dynarr,
197 not a static buffer. */
199 displayable_menu_item (Lisp_Object gui_item, int bar_p, Emchar *accel)
203 /* We construct the name in a static buffer. That's fine, because
204 menu items longer than 128 chars are probably programming errors,
205 and better be caught than displayed! */
207 static char buf[MAX_MENUITEM_LENGTH+2];
209 /* Left flush part of the string */
210 ll = gui_item_display_flush_left (gui_item, buf, MAX_MENUITEM_LENGTH);
212 ll = msw_translate_menu_or_dialog_item ((Bufbyte *) buf, ll,
213 MAX_MENUITEM_LENGTH, accel,
214 XGUI_ITEM (gui_item)->name);
216 /* Right flush part, unless we're at the top-level where it's not allowed */
221 assert (MAX_MENUITEM_LENGTH > ll + 1);
222 lr = gui_item_display_flush_right (gui_item, buf + ll + 1,
223 MAX_MENUITEM_LENGTH - ll - 1);
232 * hmenu_to_lisp_object() returns an opaque ptr given menu handle.
235 hmenu_to_lisp_object (HMENU hmenu)
237 return make_opaque_ptr (hmenu);
241 * Allocation tries a hash based on item's path and name first. This
242 * almost guarantees that the same item will override its old value in
243 * the hash table rather than abandon it.
246 allocate_menu_item_id (Lisp_Object path, Lisp_Object name, Lisp_Object suffix)
248 UINT id = MENU_ITEM_ID_BITS (HASH3 (internal_hash (path, 0),
249 internal_hash (name, 0),
250 internal_hash (suffix, 0)));
252 id = MENU_ITEM_ID_BITS (id + 1);
253 } while (GetMenuState (top_level_menu, id, MF_BYCOMMAND) != 0xFFFFFFFF);
254 return make_int (id);
258 create_empty_popup_menu (void)
260 return CreatePopupMenu ();
264 empty_menu (HMENU menu, int add_empty_p)
266 while (DeleteMenu (menu, 0, MF_BYPOSITION));
268 AppendMenu (menu, MF_STRING | MF_GRAYED, EMPTY_ITEM_ID, EMPTY_ITEM_NAME);
272 * The idea of checksumming is that we must hash minimal object
273 * which is necessarily changes when the item changes. For separator
274 * this is a constant, for grey strings and submenus these are hashes
275 * of names, since submenus are unpopulated until opened so always
276 * equal otherwise. For items, this is a full hash value of a callback,
277 * because a callback may me a form which can be changed only somewhere
281 checksum_menu_item (Lisp_Object item)
285 /* Separator or unselectable text - hash as a string + 13 */
286 if (separator_string_p (XSTRING_DATA (item)))
289 return internal_hash (item, 0) + 13;
291 else if (CONSP (item))
293 /* Submenu - hash by its string name + 0 */
294 return internal_hash (XCAR(item), 0);
296 else if (VECTORP (item))
298 /* An ordinary item - hash its name and callback form. */
299 return HASH2 (internal_hash (XVECTOR_DATA(item)[0], 0),
300 internal_hash (XVECTOR_DATA(item)[1], 0));
303 /* An error - will be caught later */
308 populate_menu_add_item (HMENU menu, Lisp_Object path,
309 Lisp_Object hash_tab, Lisp_Object item,
310 Lisp_Object *accel_list,
311 int flush_right, int bar_p)
313 MENUITEMINFO item_info;
315 item_info.cbSize = sizeof (item_info);
316 item_info.fMask = MIIM_TYPE | MIIM_STATE | MIIM_ID;
317 item_info.fState = 0;
323 /* Separator or unselectable text */
324 if (separator_string_p (XSTRING_DATA (item)))
325 item_info.fType = MFT_SEPARATOR;
328 item_info.fType = MFT_STRING;
329 item_info.fState = MFS_DISABLED;
330 item_info.dwTypeData = XSTRING_DATA (item);
333 else if (CONSP (item))
337 Lisp_Object gui_item = allocate_gui_item ();
338 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
339 struct gcpro gcpro1, gcpro2, gcpro3;
342 GCPRO3 (gui_item, path, *accel_list);
344 menu_parse_submenu_keywords (item, gui_item);
346 if (!STRINGP (pgui_item->name))
347 signal_simple_error ("Menu name (first element) must be a string",
350 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
356 if (!gui_item_active_p (gui_item))
357 item_info.fState = MFS_GRAYED;
358 /* Temptation is to put 'else' right here. Although, the
359 displayed item won't have an arrow indicating that it is a
360 popup. So we go ahead a little bit more and create a popup */
361 submenu = create_empty_popup_menu ();
363 item_info.fMask |= MIIM_SUBMENU;
364 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel);
365 item_info.hSubMenu = submenu;
368 *accel_list = Fcons (make_char (accel), *accel_list);
370 if (!(item_info.fState & MFS_GRAYED))
372 /* Now add the full submenu path as a value to the hash table,
373 keyed by menu handle */
375 path = list1 (pgui_item->name);
380 arg[1] = list1 (pgui_item->name);
381 path = Fappend (2, arg);
384 Fputhash (hmenu_to_lisp_object (submenu), path, hash_tab);
388 else if (VECTORP (item))
390 /* An ordinary item */
391 Lisp_Object style, id;
392 Lisp_Object gui_item = gui_parse_item_keywords (item);
393 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
394 struct gcpro gcpro1, gcpro2;
397 GCPRO2 (gui_item, *accel_list);
399 if (!gui_item_included_p (gui_item, Vmenubar_configuration))
405 if (!STRINGP (pgui_item->name))
406 pgui_item->name = Feval (pgui_item->name);
408 if (!gui_item_active_p (gui_item))
409 item_info.fState = MFS_GRAYED;
411 style = (NILP (pgui_item->selected) || NILP (Feval (pgui_item->selected))
412 ? Qnil : pgui_item->style);
414 if (EQ (style, Qradio))
416 item_info.fType |= MFT_RADIOCHECK;
417 item_info.fState |= MFS_CHECKED;
419 else if (EQ (style, Qtoggle))
421 item_info.fState |= MFS_CHECKED;
424 id = allocate_menu_item_id (path, pgui_item->name,
426 Fputhash (id, pgui_item->callback, hash_tab);
428 item_info.wID = (UINT) XINT (id);
429 item_info.fType |= MFT_STRING;
430 item_info.dwTypeData = displayable_menu_item (gui_item, bar_p, &accel);
433 *accel_list = Fcons (make_char (accel), *accel_list);
439 signal_simple_error ("Malformed menu item descriptor", item);
443 item_info.fType |= MFT_RIGHTJUSTIFY;
445 InsertMenuItem (menu, UINT_MAX, TRUE, &item_info);
451 * This function is called from populate_menu and checksum_menu.
452 * When called to populate, MENU is a menu handle, PATH is a
453 * list of strings representing menu path from root to this submenu,
454 * DESCRIPTOR is a menu descriptor, HASH_TAB is a hash table associated
455 * with root menu, BAR_P indicates whether this called for a menubar or
456 * a popup, and POPULATE_P is non-zero. Return value must be ignored.
457 * When called to checksum, DESCRIPTOR has the same meaning, POPULATE_P
458 * is zero, PATH must be Qnil, and the rest of parameters is ignored.
459 * Return value is the menu checksum.
462 populate_or_checksum_helper (HMENU menu, Lisp_Object path, Lisp_Object desc,
463 Lisp_Object hash_tab, int bar_p, int populate_p)
465 Lisp_Object item_desc;
466 int deep_p, flush_right;
467 struct gcpro gcpro1, gcpro2, gcpro3;
468 unsigned long checksum;
469 Lisp_Object gui_item = allocate_gui_item ();
470 Lisp_Object accel_list = Qnil;
471 Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
473 GCPRO3 (gui_item, accel_list, desc);
475 /* We are sometimes called with the menubar unchanged, and with changed
476 right flush. We have to update the menubar in this case,
477 so account for the compliance setting in the hash value */
478 checksum = REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH;
480 /* Will initially contain only "(empty)" */
482 empty_menu (menu, 1);
484 /* PATH set to nil indicates top-level popup or menubar */
485 deep_p = !NILP (path);
487 /* Fetch keywords prepending the item list */
488 desc = menu_parse_submenu_keywords (desc, gui_item);
490 /* Check that menu name is specified when expected */
491 if (NILP (pgui_item->name) && deep_p)
492 signal_simple_error ("Menu must have a name", desc);
494 /* Apply filter if specified */
495 if (!NILP (pgui_item->filter))
496 desc = call1 (pgui_item->filter, desc);
498 /* Loop thru the desc's CDR and add items for each entry */
500 EXTERNAL_LIST_LOOP (item_desc, desc)
502 if (NILP (XCAR (item_desc)))
504 /* Do not flush right menubar items when MS style compliant */
505 if (bar_p && !REPLACE_ME_WITH_GLOBAL_VARIABLE_WHICH_CONTROLS_RIGHT_FLUSH)
508 checksum = HASH2 (checksum, LISP_HASH (Qnil));
511 populate_menu_add_item (menu, path, hash_tab,
512 XCAR (item_desc), &accel_list,
515 checksum = HASH2 (checksum,
516 checksum_menu_item (XCAR (item_desc)));
521 /* Remove the "(empty)" item, if there are other ones */
522 if (GetMenuItemCount (menu) > 1)
523 RemoveMenu (menu, EMPTY_ITEM_ID, MF_BYCOMMAND);
525 /* Add the header to the popup, if told so. The same as in X - an
526 insensitive item, and a separator (Seems to me, there were
527 two separators in X... In Windows this looks ugly, anyways.) */
528 if (!bar_p && !deep_p && popup_menu_titles && !NILP (pgui_item->name))
530 CHECK_STRING (pgui_item->name);
531 InsertMenu (menu, 0, MF_BYPOSITION | MF_STRING | MF_DISABLED,
532 0, XSTRING_DATA(pgui_item->name));
533 InsertMenu (menu, 1, MF_BYPOSITION | MF_SEPARATOR, 0, NULL);
534 SetMenuDefaultItem (menu, 0, MF_BYPOSITION);
539 Fputhash (Qt, accel_list, hash_tab);
546 populate_menu (HMENU menu, Lisp_Object path, Lisp_Object desc,
547 Lisp_Object hash_tab, int bar_p)
549 populate_or_checksum_helper (menu, path, desc, hash_tab, bar_p, 1);
553 checksum_menu (Lisp_Object desc)
555 return populate_or_checksum_helper (NULL, Qnil, desc, Qunbound, 0, 0);
559 update_frame_menubar_maybe (struct frame *f)
561 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
562 struct window *w = XWINDOW (FRAME_LAST_NONMINIBUF_WINDOW (f));
563 Lisp_Object desc = (!NILP (w->menubar_visible_p)
564 ? symbol_value_in_buffer (Qcurrent_menubar, w->buffer)
568 GCPRO1 (desc); /* it's safest to do this, just in case some filter
569 or something changes the value of current-menubar */
571 top_level_menu = menubar;
573 if (NILP (desc) && menubar != NULL)
575 /* Menubar has gone */
576 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
577 SetMenu (FRAME_MSWINDOWS_HANDLE (f), NULL);
578 DestroyMenu (menubar);
579 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
584 if (!NILP (desc) && menubar == NULL)
586 /* Menubar has appeared */
587 menubar = CreateMenu ();
593 /* We did not have the bar and are not going to */
598 /* Now we bail out if the menubar has not changed */
599 if (FRAME_MSWINDOWS_MENU_CHECKSUM (f) == checksum_menu (desc))
606 /* Come with empty hash table */
607 if (NILP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)))
608 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) =
609 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
611 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
613 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
614 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
615 populate_menu (menubar, Qnil, desc,
616 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
617 SetMenu (FRAME_MSWINDOWS_HANDLE (f), menubar);
618 DrawMenuBar (FRAME_MSWINDOWS_HANDLE (f));
620 FRAME_MSWINDOWS_MENU_CHECKSUM (f) = checksum_menu (desc);
626 prune_menubar (struct frame *f)
628 HMENU menubar = GetMenu (FRAME_MSWINDOWS_HANDLE (f));
629 Lisp_Object desc = current_frame_menubar (f);
635 /* #### If a filter function has set desc to Qnil, this abort()
636 triggers. To resolve, we must prevent filters explicitly from
637 mangling with the active menu. In apply_filter probably?
638 Is copy-tree on the whole menu too expensive? */
643 GCPRO1 (desc); /* just to be safe -- see above */
644 /* We do the trick by removing all items and re-populating top level */
645 empty_menu (menubar, 0);
647 assert (HASH_TABLEP (FRAME_MSWINDOWS_MENU_HASH_TABLE (f)));
648 Fclrhash (FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
650 Fputhash (hmenu_to_lisp_object (menubar), Qnil,
651 FRAME_MSWINDOWS_MENU_HASH_TABLE (f));
652 populate_menu (menubar, Qnil, desc,
653 FRAME_MSWINDOWS_MENU_HASH_TABLE (f), 1);
658 * This is called when cleanup is possible. It is better not to
659 * clean things up at all than do it too early!
662 menu_cleanup (struct frame *f)
664 /* This function can GC */
665 current_menudesc = Qnil;
666 current_hash_table = Qnil;
671 msw_char_is_accelerator (struct frame *f, Emchar ch)
673 Lisp_Object hash = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
675 assert (HASH_TABLEP (hash));
676 /* !!#### not Mule-ized */
677 return !NILP (memq_no_quit (make_char (tolower (ch)),
678 Fgethash (Qt, hash, Qnil)));
682 /*------------------------------------------------------------------------*/
683 /* Message handlers */
684 /*------------------------------------------------------------------------*/
686 unsafe_handle_wm_initmenupopup_1 (HMENU menu, struct frame *f)
688 /* This function can call lisp, beat dogs and stick chewing gum to
691 Lisp_Object path, desc;
694 /* Find which guy is going to explode */
695 path = Fgethash (hmenu_to_lisp_object (menu), current_hash_table, Qunbound);
696 assert (!UNBOUNDP (path));
698 /* Allow to continue in a debugger after assert - not so fatal */
700 error ("internal menu error");
703 /* Now find a desc chunk for it. If none, then probably menu open
704 hook has played too much games around stuff */
705 desc = Fmenu_find_real_submenu (current_menudesc, path);
707 signal_simple_error ("This menu does not exist any more", path);
710 /* DESC may be generated by filter, so we have to gcpro it */
712 populate_menu (menu, path, desc, current_hash_table, 0);
718 unsafe_handle_wm_initmenu_1 (struct frame *f)
720 /* This function can call lisp */
722 /* NOTE: This is called for the bar only, WM_INITMENU
723 for popups is filtered out */
725 /* #### - this menubar update mechanism is expensively anti-social and
726 the activate-menubar-hook is now mostly obsolete. */
728 /* We simply ignore return value. In any case, we construct the bar
730 run_hook (Qactivate_menubar_hook);
732 update_frame_menubar_maybe (f);
734 current_menudesc = current_frame_menubar (f);
735 current_hash_table = FRAME_MSWINDOWS_MENU_HASH_TABLE (f);
736 assert (HASH_TABLEP (current_hash_table));
742 * Return value is Qt if we have dispatched the command,
743 * or Qnil if id has not been mapped to a callback.
744 * Window procedure may try other targets to route the
745 * command if we return nil
748 mswindows_handle_wm_command (struct frame *f, WORD id)
750 /* Try to map the command id through the proper hash table */
751 Lisp_Object data, fn, arg, frame;
754 if (NILP (current_hash_table))
757 data = Fgethash (make_int (id), current_hash_table, Qunbound);
765 /* Need to gcpro because the hash table may get destroyed by
766 menu_cleanup(), and will not gcpro the data any more */
770 /* Ok, this is our one. Enqueue it. */
771 get_gui_callback (data, &fn, &arg);
772 XSETFRAME (frame, f);
773 /* this used to call mswindows_enqueue_misc_user_event but that
774 breaks customize because the misc_event gets eval'ed in some
775 cicumstances. Don't change it back unless you can fix the
776 customize problem also.*/
777 enqueue_misc_user_event (frame, fn, arg);
778 mswindows_enqueue_magic_event (NULL, XM_BUMPQUEUE);
785 /*------------------------------------------------------------------------*/
786 /* Message handling proxies */
787 /*------------------------------------------------------------------------*/
789 static HMENU wm_initmenu_menu;
790 static struct frame *wm_initmenu_frame;
793 unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d)
795 return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame);
799 unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d)
801 return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame);
805 mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm)
807 /* We cannot pass hmenu as a lisp object. Use static var */
808 wm_initmenu_menu = hmenu;
809 wm_initmenu_frame = frm;
810 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenupopup, Qnil);
814 mswindows_handle_wm_initmenu (HMENU hmenu, struct frame *f)
816 /* Handle only frame menubar, ignore if from popup or system menu */
817 if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu)
819 wm_initmenu_frame = f;
820 return mswindows_protect_modal_loop (unsafe_handle_wm_initmenu, Qnil);
826 /*------------------------------------------------------------------------*/
828 /*------------------------------------------------------------------------*/
831 mswindows_update_frame_menubars (struct frame *f)
833 update_frame_menubar_maybe (f);
837 mswindows_free_frame_menubars (struct frame *f)
839 FRAME_MSWINDOWS_MENU_HASH_TABLE (f) = Qnil;
843 mswindows_popup_menu (Lisp_Object menu_desc, Lisp_Object event)
845 struct frame *f = selected_frame ();
846 Lisp_Event *eev = NULL;
852 GCPRO1 (menu_desc); /* to be safe -- see above */
856 CHECK_LIVE_EVENT (event);
857 eev = XEVENT (event);
858 if (eev->event_type != button_press_event
859 && eev->event_type != button_release_event)
860 wrong_type_argument (Qmouse_event_p, event);
862 else if (!NILP (Vthis_command_keys))
864 /* if an event wasn't passed, use the last event of the event sequence
865 currently being executed, if that event is a mouse event */
866 eev = XEVENT (Vthis_command_keys); /* last event first */
867 if (eev->event_type != button_press_event
868 && eev->event_type != button_release_event)
872 /* Default is to put the menu at the point (10, 10) in frame */
875 pt.x = eev->event.button.x;
876 pt.y = eev->event.button.y;
877 ClientToScreen (FRAME_MSWINDOWS_HANDLE (f), &pt);
882 if (SYMBOLP (menu_desc))
883 menu_desc = Fsymbol_value (menu_desc);
884 CHECK_CONS (menu_desc);
885 CHECK_STRING (XCAR (menu_desc));
887 current_menudesc = menu_desc;
889 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
890 menu = create_empty_popup_menu ();
891 Fputhash (hmenu_to_lisp_object (menu), Qnil, current_hash_table);
892 top_level_menu = menu;
894 /* see comments in menubar-x.c */
896 zmacs_region_stays = 1;
898 ok = TrackPopupMenu (menu,
899 TPM_LEFTALIGN | TPM_LEFTBUTTON | TPM_RIGHTBUTTON,
901 FRAME_MSWINDOWS_HANDLE (f), NULL);
905 /* Signal a signal if caught by Track...() modal loop */
906 mswindows_unmodalize_signal_maybe ();
908 /* This is probably the only real reason for failure */
912 signal_simple_error ("Cannot track popup menu while in menu",
919 /*------------------------------------------------------------------------*/
921 /*------------------------------------------------------------------------*/
923 syms_of_menubar_mswindows (void)
928 console_type_create_menubar_mswindows (void)
930 CONSOLE_HAS_METHOD (mswindows, update_frame_menubars);
931 CONSOLE_HAS_METHOD (mswindows, free_frame_menubars);
932 CONSOLE_HAS_METHOD (mswindows, popup_menu);
936 vars_of_menubar_mswindows (void)
938 current_menudesc = Qnil;
939 current_hash_table = Qnil;
941 staticpro (¤t_menudesc);
942 staticpro (¤t_hash_table);