1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
32 #include "termhooks.h"
34 #include "blockinput.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
46 #include <sys/types.h>
49 #include "dispextern.h"
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
53 /******************************************************************/
54 /* Definitions copied from lwlib.h */
56 typedef void * XtPointer
;
66 /* This structure is based on the one in ../lwlib/lwlib.h, modified
68 typedef struct _widget_value
73 /* value (meaning depend on widget type) */
75 /* keyboard equivalent. no implications for XtTranslations */
78 /* Help string or nil if none.
79 GC finds this string through the frame's menu_bar_vector
80 or through menu_items. */
84 /* true if selected */
86 /* The type of a button. */
87 enum button_type button_type
;
88 /* true if menu title */
91 /* true if was edited (maintained by get_value) */
93 /* true if has changed (maintained by lw library) */
95 /* true if this widget itself has changed,
96 but not counting the other widgets found in the `next' field. */
97 change_type this_one_change
;
99 /* Contents of the sub-widgets, also selected slot for checkbox */
100 struct _widget_value
* contents
;
101 /* data passed to callback */
103 /* next one in the list */
104 struct _widget_value
* next
;
106 /* slot for the toolkit dependent part. Always initialize to NULL. */
108 /* tell us if we should free the toolkit data slot when freeing the
109 widget_value itself. */
110 Boolean free_toolkit_data
;
112 /* we resource the widget_value structures; this points to the next
113 one on the free list if this one has been deallocated.
115 struct _widget_value
*free_list
;
119 /* Local memory management */
120 #define local_heap (GetProcessHeap ())
121 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
122 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
124 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
125 #define free_widget_value(wv) (local_free ((wv)))
127 /******************************************************************/
134 HMENU current_popup_menu
;
136 void syms_of_w32menu ();
137 void globals_of_w32menu ();
139 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
143 IN OUT LPMENUITEMINFOA
);
144 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
148 IN LPCMENUITEMINFOA
);
150 GetMenuItemInfoA_Proc get_menu_item_info
= NULL
;
151 SetMenuItemInfoA_Proc set_menu_item_info
= NULL
;
152 AppendMenuW_Proc unicode_append_menu
= NULL
;
154 Lisp_Object Qdebug_on_next_call
;
156 extern Lisp_Object Vmenu_updating_frame
;
158 extern Lisp_Object Qmenu_bar
;
160 extern Lisp_Object QCtoggle
, QCradio
;
162 extern Lisp_Object Voverriding_local_map
;
163 extern Lisp_Object Voverriding_local_map_menu_flag
;
165 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
167 extern Lisp_Object Qmenu_bar_update_hook
;
169 void set_frame_menubar ();
171 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
172 Lisp_Object
, Lisp_Object
, Lisp_Object
,
173 Lisp_Object
, Lisp_Object
));
175 static Lisp_Object
w32_dialog_show ();
177 static Lisp_Object
w32_menu_show ();
179 static void keymap_panes ();
180 static void single_keymap_panes ();
181 static void single_menu_item ();
182 static void list_of_panes ();
183 static void list_of_items ();
184 void w32_free_menu_strings (HWND
);
186 /* This holds a Lisp vector that holds the results of decoding
187 the keymaps or alist-of-alists that specify a menu.
189 It describes the panes and items within the panes.
191 Each pane is described by 3 elements in the vector:
192 t, the pane name, the pane's prefix key.
193 Then follow the pane's items, with 5 elements per item:
194 the item string, the enable flag, the item's value,
195 the definition, and the equivalent keyboard key's description string.
197 In some cases, multiple levels of menus may be described.
198 A single vector slot containing nil indicates the start of a submenu.
199 A single vector slot containing lambda indicates the end of a submenu.
200 The submenu follows a menu item which is the way to reach the submenu.
202 A single vector slot containing quote indicates that the
203 following items should appear on the right of a dialog box.
205 Using a Lisp vector to hold this information while we decode it
206 takes care of protecting all the data from GC. */
208 #define MENU_ITEMS_PANE_NAME 1
209 #define MENU_ITEMS_PANE_PREFIX 2
210 #define MENU_ITEMS_PANE_LENGTH 3
214 MENU_ITEMS_ITEM_NAME
= 0,
215 MENU_ITEMS_ITEM_ENABLE
,
216 MENU_ITEMS_ITEM_VALUE
,
217 MENU_ITEMS_ITEM_EQUIV_KEY
,
218 MENU_ITEMS_ITEM_DEFINITION
,
219 MENU_ITEMS_ITEM_TYPE
,
220 MENU_ITEMS_ITEM_SELECTED
,
221 MENU_ITEMS_ITEM_HELP
,
222 MENU_ITEMS_ITEM_LENGTH
225 static Lisp_Object menu_items
;
227 /* Number of slots currently allocated in menu_items. */
228 static int menu_items_allocated
;
230 /* This is the index in menu_items of the first empty slot. */
231 static int menu_items_used
;
233 /* The number of panes currently recorded in menu_items,
234 excluding those within submenus. */
235 static int menu_items_n_panes
;
237 /* Current depth within submenus. */
238 static int menu_items_submenu_depth
;
240 static int next_menubar_widget_id
;
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249 int pending_menu_activation
;
252 /* Return the frame whose ->output_data.w32->menubar_widget equals
255 static struct frame
*
256 menubar_id_to_frame (id
)
259 Lisp_Object tail
, frame
;
262 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
265 if (!GC_FRAMEP (frame
))
268 if (!FRAME_WINDOW_P (f
))
270 if (f
->output_data
.w32
->menubar_widget
== id
)
276 /* Initialize the menu_items structure if we haven't already done so.
277 Also mark it as currently empty. */
282 if (NILP (menu_items
))
284 menu_items_allocated
= 60;
285 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
289 menu_items_n_panes
= 0;
290 menu_items_submenu_depth
= 0;
293 /* Call at the end of generating the data in menu_items.
294 This fills in the number of items in the last pane. */
301 /* Call when finished using the data for the current menu
305 discard_menu_items ()
307 /* Free the structure if it is especially large.
308 Otherwise, hold on to it, to save time. */
309 if (menu_items_allocated
> 200)
312 menu_items_allocated
= 0;
316 /* Make the menu_items vector twice as large. */
321 menu_items_allocated
*= 2;
322 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
325 /* Begin a submenu. */
328 push_submenu_start ()
330 if (menu_items_used
+ 1 > menu_items_allocated
)
333 ASET (menu_items
, menu_items_used
++, Qnil
);
334 menu_items_submenu_depth
++;
342 if (menu_items_used
+ 1 > menu_items_allocated
)
345 ASET (menu_items
, menu_items_used
++, Qlambda
);
346 menu_items_submenu_depth
--;
349 /* Indicate boundary between left and right. */
352 push_left_right_boundary ()
354 if (menu_items_used
+ 1 > menu_items_allocated
)
357 ASET (menu_items
, menu_items_used
++, Qquote
);
360 /* Start a new menu pane in menu_items.
361 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
364 push_menu_pane (name
, prefix_vec
)
365 Lisp_Object name
, prefix_vec
;
367 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
370 if (menu_items_submenu_depth
== 0)
371 menu_items_n_panes
++;
372 ASET (menu_items
, menu_items_used
++, Qt
);
373 ASET (menu_items
, menu_items_used
++, name
);
374 ASET (menu_items
, menu_items_used
++, prefix_vec
);
377 /* Push one menu item into the current pane. NAME is the string to
378 display. ENABLE if non-nil means this item can be selected. KEY
379 is the key generated by choosing this item, or nil if this item
380 doesn't really have a definition. DEF is the definition of this
381 item. EQUIV is the textual description of the keyboard equivalent
382 for this item (or nil if none). TYPE is the type of this menu
383 item, one of nil, `toggle' or `radio'. */
386 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
387 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
389 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
392 ASET (menu_items
, menu_items_used
++, name
);
393 ASET (menu_items
, menu_items_used
++, enable
);
394 ASET (menu_items
, menu_items_used
++, key
);
395 ASET (menu_items
, menu_items_used
++, equiv
);
396 ASET (menu_items
, menu_items_used
++, def
);
397 ASET (menu_items
, menu_items_used
++, type
);
398 ASET (menu_items
, menu_items_used
++, selected
);
399 ASET (menu_items
, menu_items_used
++, help
);
402 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
403 and generate menu panes for them in menu_items.
404 If NOTREAL is nonzero,
405 don't bother really computing whether an item is enabled. */
408 keymap_panes (keymaps
, nmaps
, notreal
)
409 Lisp_Object
*keymaps
;
417 /* Loop over the given keymaps, making a pane for each map.
418 But don't make a pane that is empty--ignore that map instead.
419 P is the number of panes we have made so far. */
420 for (mapno
= 0; mapno
< nmaps
; mapno
++)
421 single_keymap_panes (keymaps
[mapno
],
422 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
424 finish_menu_items ();
427 /* This is a recursive subroutine of keymap_panes.
428 It handles one keymap, KEYMAP.
429 The other arguments are passed along
430 or point to local variables of the previous function.
431 If NOTREAL is nonzero, only check for equivalent key bindings, don't
432 evaluate expressions in menu items and don't make any menu.
434 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
437 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
439 Lisp_Object pane_name
;
444 Lisp_Object pending_maps
= Qnil
;
445 Lisp_Object tail
, item
;
446 struct gcpro gcpro1
, gcpro2
;
451 push_menu_pane (pane_name
, prefix
);
453 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
455 GCPRO2 (keymap
, pending_maps
);
456 /* Look at each key binding, and if it is a menu item add it
460 single_menu_item (XCAR (item
), XCDR (item
),
461 &pending_maps
, notreal
, maxdepth
);
462 else if (VECTORP (item
))
464 /* Loop over the char values represented in the vector. */
465 int len
= ASIZE (item
);
467 for (c
= 0; c
< len
; c
++)
469 Lisp_Object character
;
470 XSETFASTINT (character
, c
);
471 single_menu_item (character
, AREF (item
, c
),
472 &pending_maps
, notreal
, maxdepth
);
478 /* Process now any submenus which want to be panes at this level. */
479 while (!NILP (pending_maps
))
481 Lisp_Object elt
, eltcdr
, string
;
482 elt
= Fcar (pending_maps
);
484 string
= XCAR (eltcdr
);
485 /* We no longer discard the @ from the beginning of the string here.
486 Instead, we do this in w32_menu_show. */
487 single_keymap_panes (Fcar (elt
), string
,
488 XCDR (eltcdr
), notreal
, maxdepth
- 1);
489 pending_maps
= Fcdr (pending_maps
);
493 /* This is a subroutine of single_keymap_panes that handles one
495 KEY is a key in a keymap and ITEM is its binding.
496 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
498 If NOTREAL is nonzero, only check for equivalent key bindings, don't
499 evaluate expressions in menu items and don't make any menu.
500 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
503 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
504 Lisp_Object key
, item
;
505 Lisp_Object
*pending_maps_ptr
;
506 int maxdepth
, notreal
;
508 Lisp_Object map
, item_string
, enabled
;
509 struct gcpro gcpro1
, gcpro2
;
512 /* Parse the menu item and leave the result in item_properties. */
514 res
= parse_menu_item (item
, notreal
, 0);
517 return; /* Not a menu item. */
519 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
523 /* We don't want to make a menu, just traverse the keymaps to
524 precompute equivalent key bindings. */
526 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
530 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
531 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
533 if (!NILP (map
) && SREF (item_string
, 0) == '@')
536 /* An enabled separate pane. Remember this to handle it later. */
537 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
542 push_menu_item (item_string
, enabled
, key
,
543 AREF (item_properties
, ITEM_PROPERTY_DEF
),
544 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
545 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
546 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
547 AREF (item_properties
, ITEM_PROPERTY_HELP
));
549 /* Display a submenu using the toolkit. */
550 if (! (NILP (map
) || NILP (enabled
)))
552 push_submenu_start ();
553 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
558 /* Push all the panes and items of a menu described by the
559 alist-of-alists MENU.
560 This handles old-fashioned calls to x-popup-menu. */
570 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
572 Lisp_Object elt
, pane_name
, pane_data
;
574 pane_name
= Fcar (elt
);
575 CHECK_STRING (pane_name
);
576 push_menu_pane (pane_name
, Qnil
);
577 pane_data
= Fcdr (elt
);
578 CHECK_CONS (pane_data
);
579 list_of_items (pane_data
);
582 finish_menu_items ();
585 /* Push the items in a single pane defined by the alist PANE. */
591 Lisp_Object tail
, item
, item1
;
593 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
597 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
598 else if (NILP (item
))
599 push_left_right_boundary ();
604 CHECK_STRING (item1
);
605 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
610 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
611 doc
: /* Pop up a deck-of-cards menu and return user's selection.
612 POSITION is a position specification. This is either a mouse button
613 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
614 are positions in pixels from the top left corner of WINDOW's frame
615 \(WINDOW may be a frame object instead of a window). This controls the
616 position of the center of the first line in the first pane of the
617 menu, not the top left of the menu as a whole. If POSITION is t, it
618 means to use the current mouse position.
620 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
621 The menu items come from key bindings that have a menu string as well as
622 a definition; actually, the \"definition\" in such a key binding looks like
623 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
624 the keymap as a top-level element.
626 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
627 Otherwise, REAL-DEFINITION should be a valid key binding definition.
629 You can also use a list of keymaps as MENU. Then each keymap makes a
630 separate pane. When MENU is a keymap or a list of keymaps, the return
631 value is a list of events.
633 Alternatively, you can specify a menu of multiple panes with a list of
634 the form (TITLE PANE1 PANE2...), where each pane is a list of
635 form (TITLE ITEM1 ITEM2...).
636 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
637 appear as an item--that makes a nonselectable line in the menu.
638 With this form of menu, the return value is VALUE from the chosen item.
640 If POSITION is nil, don't display the menu at all, just precalculate the
641 cached information about equivalent key sequences. */)
643 Lisp_Object position
, menu
;
645 Lisp_Object keymap
, tem
;
646 int xpos
= 0, ypos
= 0;
649 Lisp_Object selection
;
651 Lisp_Object x
, y
, window
;
657 if (! NILP (position
))
661 /* Decode the first argument: find the window and the coordinates. */
662 if (EQ (position
, Qt
)
663 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
664 || EQ (XCAR (position
), Qtool_bar
))))
666 /* Use the mouse's current position. */
667 FRAME_PTR new_f
= SELECTED_FRAME ();
668 Lisp_Object bar_window
;
669 enum scroll_bar_part part
;
672 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
673 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
674 &part
, &x
, &y
, &time
);
676 XSETFRAME (window
, new_f
);
679 window
= selected_window
;
686 tem
= Fcar (position
);
689 window
= Fcar (Fcdr (position
));
691 y
= Fcar (Fcdr (tem
));
696 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
697 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
698 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
707 /* Decode where to put the menu. */
715 else if (WINDOWP (window
))
717 CHECK_LIVE_WINDOW (window
);
718 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
720 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
721 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
724 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
725 but I don't want to make one now. */
726 CHECK_WINDOW (window
);
731 XSETFRAME (Vmenu_updating_frame
, f
);
734 Vmenu_updating_frame
= Qnil
;
735 #endif /* HAVE_MENUS */
740 /* Decode the menu items from what was specified. */
742 keymap
= get_keymap (menu
, 0, 0);
745 /* We were given a keymap. Extract menu info from the keymap. */
748 /* Extract the detailed info to make one pane. */
749 keymap_panes (&menu
, 1, NILP (position
));
751 /* Search for a string appearing directly as an element of the keymap.
752 That string is the title of the menu. */
753 prompt
= Fkeymap_prompt (keymap
);
754 if (NILP (title
) && !NILP (prompt
))
757 /* Make that be the pane title of the first pane. */
758 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
759 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
763 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
765 /* We were given a list of keymaps. */
766 int nmaps
= XFASTINT (Flength (menu
));
768 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
773 /* The first keymap that has a prompt string
774 supplies the menu title. */
775 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
779 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
781 prompt
= Fkeymap_prompt (keymap
);
782 if (NILP (title
) && !NILP (prompt
))
786 /* Extract the detailed info to make one pane. */
787 keymap_panes (maps
, nmaps
, NILP (position
));
789 /* Make the title be the pane title of the first pane. */
790 if (!NILP (title
) && menu_items_n_panes
>= 0)
791 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
797 /* We were given an old-fashioned menu. */
799 CHECK_STRING (title
);
801 list_of_panes (Fcdr (menu
));
808 discard_menu_items ();
814 /* If resources from a previous popup menu still exist, does nothing
815 until the `menu_free_timer' has freed them (see w32fns.c). This
816 can occur if you press ESC or click outside a menu without selecting
819 if (current_popup_menu
)
821 discard_menu_items ();
826 /* Display them in a menu. */
829 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
830 keymaps
, title
, &error_name
);
833 discard_menu_items ();
835 #endif /* HAVE_MENUS */
839 if (error_name
) error (error_name
);
845 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
846 doc
: /* Pop up a dialog box and return user's selection.
847 POSITION specifies which frame to use.
848 This is normally a mouse button event or a window or frame.
849 If POSITION is t, it means to use the frame the mouse is on.
850 The dialog box appears in the middle of the specified frame.
852 CONTENTS specifies the alternatives to display in the dialog box.
853 It is a list of the form (TITLE ITEM1 ITEM2...).
854 Each ITEM is a cons cell (STRING . VALUE).
855 The return value is VALUE from the chosen item.
857 An ITEM may also be just a string--that makes a nonselectable item.
858 An ITEM may also be nil--that means to put all preceding items
859 on the left of the dialog box and all following items on the right.
860 \(By default, approximately half appear on each side.)
862 If HEADER is non-nil, the frame title for the box is "Information",
863 otherwise it is "Question". */)
864 (position
, contents
, header
)
865 Lisp_Object position
, contents
, header
;
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position
, Qt
)
874 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
875 || EQ (XCAR (position
), Qtool_bar
))))
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f
= SELECTED_FRAME ();
880 Lisp_Object bar_window
;
881 enum scroll_bar_part part
;
885 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
888 XSETFRAME (window
, new_f
);
890 window
= selected_window
;
892 window
= selected_window
;
894 else if (CONSP (position
))
897 tem
= Fcar (position
);
899 window
= Fcar (Fcdr (position
));
902 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
903 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
906 else if (WINDOWP (position
) || FRAMEP (position
))
911 /* Decode where to put the menu. */
915 else if (WINDOWP (window
))
917 CHECK_LIVE_WINDOW (window
);
918 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window
);
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
929 Lisp_Object x
, y
, frame
, newpos
;
930 XSETFRAME (frame
, f
);
931 XSETINT (x
, x_pixel_width (f
) / 2);
932 XSETINT (y
, x_pixel_height (f
) / 2);
933 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
935 return Fx_popup_menu (newpos
,
936 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
938 #else /* HAVE_DIALOGS */
942 Lisp_Object selection
;
944 /* Decode the dialog items from what was specified. */
945 title
= Fcar (contents
);
946 CHECK_STRING (title
);
948 list_of_panes (Fcons (contents
, Qnil
));
950 /* Display them in a dialog box. */
952 selection
= w32_dialog_show (f
, 0, title
, header
, &error_name
);
955 discard_menu_items ();
957 if (error_name
) error (error_name
);
960 #endif /* HAVE_DIALOGS */
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
971 But first we recompute the menu bar contents (the whole tree).
973 This way we can safely execute Lisp code. */
976 x_activate_menubar (f
)
979 set_frame_menubar (f
, 0, 1);
981 /* Lock out further menubar changes while active. */
982 f
->output_data
.w32
->menubar_active
= 1;
984 /* Signal input thread to return from WM_INITMENU. */
985 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
994 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
996 Lisp_Object prefix
, entry
;
998 Lisp_Object
*subprefix_stack
;
999 int submenu_depth
= 0;
1005 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1006 vector
= f
->menu_bar_vector
;
1009 while (i
< f
->menu_bar_items_used
)
1011 if (EQ (AREF (vector
, i
), Qnil
))
1013 subprefix_stack
[submenu_depth
++] = prefix
;
1017 else if (EQ (AREF (vector
, i
), Qlambda
))
1019 prefix
= subprefix_stack
[--submenu_depth
];
1022 else if (EQ (AREF (vector
, i
), Qt
))
1024 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1025 i
+= MENU_ITEMS_PANE_LENGTH
;
1029 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT
) client_data
== i
)
1035 struct input_event buf
;
1039 XSETFRAME (frame
, f
);
1040 buf
.kind
= MENU_BAR_EVENT
;
1041 buf
.frame_or_window
= frame
;
1043 kbd_buffer_store_event (&buf
);
1045 for (j
= 0; j
< submenu_depth
; j
++)
1046 if (!NILP (subprefix_stack
[j
]))
1048 buf
.kind
= MENU_BAR_EVENT
;
1049 buf
.frame_or_window
= frame
;
1050 buf
.arg
= subprefix_stack
[j
];
1051 kbd_buffer_store_event (&buf
);
1056 buf
.kind
= MENU_BAR_EVENT
;
1057 buf
.frame_or_window
= frame
;
1059 kbd_buffer_store_event (&buf
);
1062 buf
.kind
= MENU_BAR_EVENT
;
1063 buf
.frame_or_window
= frame
;
1065 /* Free memory used by owner-drawn and help-echo strings. */
1066 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1067 kbd_buffer_store_event (&buf
);
1069 f
->output_data
.w32
->menubar_active
= 0;
1072 i
+= MENU_ITEMS_ITEM_LENGTH
;
1075 /* Free memory used by owner-drawn and help-echo strings. */
1076 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1077 f
->output_data
.w32
->menubar_active
= 0;
1080 /* Allocate a widget_value, blocking input. */
1083 xmalloc_widget_value ()
1085 widget_value
*value
;
1088 value
= malloc_widget_value ();
1094 /* This recursively calls free_widget_value on the tree of widgets.
1095 It must free all data that was malloc'ed for these widget_values.
1096 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1097 must be left alone. */
1100 free_menubar_widget_value_tree (wv
)
1105 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1107 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1109 free_menubar_widget_value_tree (wv
->contents
);
1110 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1114 free_menubar_widget_value_tree (wv
->next
);
1115 wv
->next
= (widget_value
*) 0xDEADBEEF;
1118 free_widget_value (wv
);
1122 /* Set up data i menu_items for a menu bar item
1123 whose event type is ITEM_KEY (with string ITEM_NAME)
1124 and whose contents come from the list of keymaps MAPS. */
1127 parse_single_submenu (item_key
, item_name
, maps
)
1128 Lisp_Object item_key
, item_name
, maps
;
1132 Lisp_Object
*mapvec
;
1134 int top_level_items
= 0;
1136 length
= Flength (maps
);
1137 len
= XINT (length
);
1139 /* Convert the list MAPS into a vector MAPVEC. */
1140 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1141 for (i
= 0; i
< len
; i
++)
1143 mapvec
[i
] = Fcar (maps
);
1147 /* Loop over the given keymaps, making a pane for each map.
1148 But don't make a pane that is empty--ignore that map instead. */
1149 for (i
= 0; i
< len
; i
++)
1151 if (SYMBOLP (mapvec
[i
])
1152 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1154 /* Here we have a command at top level in the menu bar
1155 as opposed to a submenu. */
1156 top_level_items
= 1;
1157 push_menu_pane (Qnil
, Qnil
);
1158 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1159 Qnil
, Qnil
, Qnil
, Qnil
);
1164 prompt
= Fkeymap_prompt (mapvec
[i
]);
1165 single_keymap_panes (mapvec
[i
],
1166 !NILP (prompt
) ? prompt
: item_name
,
1171 return top_level_items
;
1175 /* Create a tree of widget_value objects
1176 representing the panes and items
1177 in menu_items starting at index START, up to index END. */
1179 static widget_value
*
1180 digest_single_submenu (start
, end
, top_level_items
)
1181 int start
, end
, top_level_items
;
1183 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1185 int submenu_depth
= 0;
1186 widget_value
**submenu_stack
;
1189 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1190 wv
= xmalloc_widget_value ();
1194 wv
->button_type
= BUTTON_TYPE_NONE
;
1200 /* Loop over all panes and items made by the preceding call
1201 to parse_single_submenu and construct a tree of widget_value objects.
1202 Ignore the panes and items used by previous calls to
1203 digest_single_submenu, even though those are also in menu_items. */
1207 if (EQ (AREF (menu_items
, i
), Qnil
))
1209 submenu_stack
[submenu_depth
++] = save_wv
;
1214 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1217 save_wv
= submenu_stack
[--submenu_depth
];
1220 else if (EQ (AREF (menu_items
, i
), Qt
)
1221 && submenu_depth
!= 0)
1222 i
+= MENU_ITEMS_PANE_LENGTH
;
1223 /* Ignore a nil in the item list.
1224 It's meaningful only for dialog boxes. */
1225 else if (EQ (AREF (menu_items
, i
), Qquote
))
1227 else if (EQ (AREF (menu_items
, i
), Qt
))
1229 /* Create a new pane. */
1230 Lisp_Object pane_name
, prefix
;
1233 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1234 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1236 if (STRINGP (pane_name
))
1238 if (unicode_append_menu
)
1239 /* Encode as UTF-8 for now. */
1240 pane_name
= ENCODE_UTF_8 (pane_name
);
1241 else if (STRING_MULTIBYTE (pane_name
))
1242 pane_name
= ENCODE_SYSTEM (pane_name
);
1244 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1247 pane_string
= (NILP (pane_name
)
1248 ? "" : (char *) SDATA (pane_name
));
1249 /* If there is just one top-level pane, put all its items directly
1250 under the top-level menu. */
1251 if (menu_items_n_panes
== 1)
1254 /* If the pane has a meaningful name,
1255 make the pane a top-level menu item
1256 with its items as a submenu beneath it. */
1257 if (strcmp (pane_string
, ""))
1259 wv
= xmalloc_widget_value ();
1263 first_wv
->contents
= wv
;
1264 wv
->lname
= pane_name
;
1265 /* Set value to 1 so update_submenu_strings can handle '@' */
1266 wv
->value
= (char *) 1;
1268 wv
->button_type
= BUTTON_TYPE_NONE
;
1273 i
+= MENU_ITEMS_PANE_LENGTH
;
1277 /* Create a new item within current pane. */
1278 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1281 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1282 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1283 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1284 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1285 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1286 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1287 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1289 if (STRINGP (item_name
))
1291 if (unicode_append_menu
)
1292 item_name
= ENCODE_UTF_8 (item_name
);
1293 else if (STRING_MULTIBYTE (item_name
))
1294 item_name
= ENCODE_SYSTEM (item_name
);
1296 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1299 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1301 descrip
= ENCODE_SYSTEM (descrip
);
1302 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1305 wv
= xmalloc_widget_value ();
1309 save_wv
->contents
= wv
;
1311 wv
->lname
= item_name
;
1312 if (!NILP (descrip
))
1315 /* The EMACS_INT cast avoids a warning. There's no problem
1316 as long as pointers have enough bits to hold small integers. */
1317 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1318 wv
->enabled
= !NILP (enable
);
1321 wv
->button_type
= BUTTON_TYPE_NONE
;
1322 else if (EQ (type
, QCradio
))
1323 wv
->button_type
= BUTTON_TYPE_RADIO
;
1324 else if (EQ (type
, QCtoggle
))
1325 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1329 wv
->selected
= !NILP (selected
);
1330 if (!STRINGP (help
))
1337 i
+= MENU_ITEMS_ITEM_LENGTH
;
1341 /* If we have just one "menu item"
1342 that was originally a button, return it by itself. */
1343 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1345 wv
= first_wv
->contents
;
1346 free_widget_value (first_wv
);
1354 /* Walk through the widget_value tree starting at FIRST_WV and update
1355 the char * pointers from the corresponding lisp values.
1356 We do this after building the whole tree, since GC may happen while the
1357 tree is constructed, and small strings are relocated. So we must wait
1358 until no GC can happen before storing pointers into lisp values. */
1360 update_submenu_strings (first_wv
)
1361 widget_value
*first_wv
;
1365 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1367 if (wv
->lname
&& ! NILP (wv
->lname
))
1369 wv
->name
= SDATA (wv
->lname
);
1371 /* Ignore the @ that means "separate pane".
1372 This is a kludge, but this isn't worth more time. */
1373 if (wv
->value
== (char *)1)
1375 if (wv
->name
[0] == '@')
1381 if (wv
->lkey
&& ! NILP (wv
->lkey
))
1382 wv
->key
= SDATA (wv
->lkey
);
1385 update_submenu_strings (wv
->contents
);
1390 /* Set the contents of the menubar widgets of frame F.
1391 The argument FIRST_TIME is currently ignored;
1392 it is set the first time this is called, from initialize_frame_menubar. */
1395 set_frame_menubar (f
, first_time
, deep_p
)
1400 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1402 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1404 int *submenu_start
, *submenu_end
;
1405 int *submenu_top_level_items
, *submenu_n_panes
;
1407 /* We must not change the menubar when actually in use. */
1408 if (f
->output_data
.w32
->menubar_active
)
1411 XSETFRAME (Vmenu_updating_frame
, f
);
1413 if (! menubar_widget
)
1415 else if (pending_menu_activation
&& !deep_p
)
1420 /* Make a widget-value tree representing the entire menu trees. */
1422 struct buffer
*prev
= current_buffer
;
1424 int specpdl_count
= SPECPDL_INDEX ();
1425 int previous_menu_items_used
= f
->menu_bar_items_used
;
1426 Lisp_Object
*previous_items
1427 = (Lisp_Object
*) alloca (previous_menu_items_used
1428 * sizeof (Lisp_Object
));
1430 /* If we are making a new widget, its contents are empty,
1431 do always reinitialize them. */
1432 if (! menubar_widget
)
1433 previous_menu_items_used
= 0;
1435 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1436 specbind (Qinhibit_quit
, Qt
);
1437 /* Don't let the debugger step into this code
1438 because it is not reentrant. */
1439 specbind (Qdebug_on_next_call
, Qnil
);
1441 record_unwind_save_match_data ();
1443 if (NILP (Voverriding_local_map_menu_flag
))
1445 specbind (Qoverriding_terminal_local_map
, Qnil
);
1446 specbind (Qoverriding_local_map
, Qnil
);
1449 set_buffer_internal_1 (XBUFFER (buffer
));
1451 /* Run the Lucid hook. */
1452 safe_run_hooks (Qactivate_menubar_hook
);
1453 /* If it has changed current-menubar from previous value,
1454 really recompute the menubar from the value. */
1455 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1456 call0 (Qrecompute_lucid_menubar
);
1457 safe_run_hooks (Qmenu_bar_update_hook
);
1458 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1460 items
= FRAME_MENU_BAR_ITEMS (f
);
1462 /* Save the frame's previous menu bar contents data. */
1463 if (previous_menu_items_used
)
1464 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1465 previous_menu_items_used
* sizeof (Lisp_Object
));
1467 /* Fill in menu_items with the current menu bar contents.
1468 This can evaluate Lisp code. */
1469 menu_items
= f
->menu_bar_vector
;
1470 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1471 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1472 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1473 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1474 submenu_top_level_items
1475 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1477 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1479 Lisp_Object key
, string
, maps
;
1483 key
= AREF (items
, i
);
1484 string
= AREF (items
, i
+ 1);
1485 maps
= AREF (items
, i
+ 2);
1489 submenu_start
[i
] = menu_items_used
;
1491 menu_items_n_panes
= 0;
1492 submenu_top_level_items
[i
]
1493 = parse_single_submenu (key
, string
, maps
);
1494 submenu_n_panes
[i
] = menu_items_n_panes
;
1496 submenu_end
[i
] = menu_items_used
;
1499 finish_menu_items ();
1501 /* Convert menu_items into widget_value trees
1502 to display the menu. This cannot evaluate Lisp code. */
1504 wv
= xmalloc_widget_value ();
1505 wv
->name
= "menubar";
1508 wv
->button_type
= BUTTON_TYPE_NONE
;
1512 for (i
= 0; i
< last_i
; i
+= 4)
1514 menu_items_n_panes
= submenu_n_panes
[i
];
1515 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1516 submenu_top_level_items
[i
]);
1520 first_wv
->contents
= wv
;
1521 /* Don't set wv->name here; GC during the loop might relocate it. */
1523 wv
->button_type
= BUTTON_TYPE_NONE
;
1527 set_buffer_internal_1 (prev
);
1528 unbind_to (specpdl_count
, Qnil
);
1530 /* If there has been no change in the Lisp-level contents
1531 of the menu bar, skip redisplaying it. Just exit. */
1533 for (i
= 0; i
< previous_menu_items_used
; i
++)
1534 if (menu_items_used
== i
1535 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1537 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1539 free_menubar_widget_value_tree (first_wv
);
1545 /* Now GC cannot happen during the lifetime of the widget_value,
1546 so it's safe to store data from a Lisp_String, as long as
1547 local copies are made when the actual menu is created.
1548 Windows takes care of this for normal string items, but
1549 not for owner-drawn items or additional item-info. */
1550 wv
= first_wv
->contents
;
1551 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1554 string
= AREF (items
, i
+ 1);
1557 wv
->name
= (char *) SDATA (string
);
1558 update_submenu_strings (wv
->contents
);
1562 f
->menu_bar_vector
= menu_items
;
1563 f
->menu_bar_items_used
= menu_items_used
;
1568 /* Make a widget-value tree containing
1569 just the top level menu bar strings. */
1571 wv
= xmalloc_widget_value ();
1572 wv
->name
= "menubar";
1575 wv
->button_type
= BUTTON_TYPE_NONE
;
1579 items
= FRAME_MENU_BAR_ITEMS (f
);
1580 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1584 string
= AREF (items
, i
+ 1);
1588 wv
= xmalloc_widget_value ();
1589 wv
->name
= (char *) SDATA (string
);
1592 wv
->button_type
= BUTTON_TYPE_NONE
;
1594 /* This prevents lwlib from assuming this
1595 menu item is really supposed to be empty. */
1596 /* The EMACS_INT cast avoids a warning.
1597 This value just has to be different from small integers. */
1598 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1603 first_wv
->contents
= wv
;
1607 /* Forget what we thought we knew about what is in the
1608 detailed contents of the menu bar menus.
1609 Changing the top level always destroys the contents. */
1610 f
->menu_bar_items_used
= 0;
1613 /* Create or update the menu bar widget. */
1619 /* Empty current menubar, rather than creating a fresh one. */
1620 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1625 menubar_widget
= CreateMenu ();
1627 fill_in_menu (menubar_widget
, first_wv
->contents
);
1629 free_menubar_widget_value_tree (first_wv
);
1632 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1634 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1635 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1636 /* Causes flicker when menu bar is updated
1637 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1639 /* Force the window size to be recomputed so that the frame's text
1640 area remains the same, if menubar has just been created. */
1641 if (old_widget
== NULL
)
1642 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1648 /* Called from Fx_create_frame to create the initial menubar of a frame
1649 before it is mapped, so that the window is mapped with the menubar already
1650 there instead of us tacking it on later and thrashing the window after it
1654 initialize_frame_menubar (f
)
1657 /* This function is called before the first chance to redisplay
1658 the frame. It has to be, so the frame will have the right size. */
1659 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1660 set_frame_menubar (f
, 1, 1);
1663 /* Get rid of the menu bar of frame F, and free its storage.
1664 This is used when deleting a frame, and when turning off the menu bar. */
1667 free_frame_menubar (f
)
1673 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1674 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1675 f
->output_data
.w32
->menubar_widget
= NULL
;
1683 /* w32_menu_show actually displays a menu using the panes and items in
1684 menu_items and returns the value selected from it; we assume input
1685 is blocked by the caller. */
1687 /* F is the frame the menu is for.
1688 X and Y are the frame-relative specified position,
1689 relative to the inside upper left corner of the frame F.
1690 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1691 KEYMAPS is 1 if this menu was specified with keymaps;
1692 in that case, we return a list containing the chosen item's value
1693 and perhaps also the pane's prefix.
1694 TITLE is the specified menu title.
1695 ERROR is a place to store an error message string in case of failure.
1696 (We return nil on failure, but the value doesn't actually matter.) */
1699 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1709 int menu_item_selection
;
1712 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1713 widget_value
**submenu_stack
1714 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1715 Lisp_Object
*subprefix_stack
1716 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1717 int submenu_depth
= 0;
1722 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1724 *error
= "Empty menu";
1728 /* Create a tree of widget_value objects
1729 representing the panes and their items. */
1730 wv
= xmalloc_widget_value ();
1734 wv
->button_type
= BUTTON_TYPE_NONE
;
1739 /* Loop over all panes and items, filling in the tree. */
1741 while (i
< menu_items_used
)
1743 if (EQ (AREF (menu_items
, i
), Qnil
))
1745 submenu_stack
[submenu_depth
++] = save_wv
;
1751 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1754 save_wv
= submenu_stack
[--submenu_depth
];
1758 else if (EQ (AREF (menu_items
, i
), Qt
)
1759 && submenu_depth
!= 0)
1760 i
+= MENU_ITEMS_PANE_LENGTH
;
1761 /* Ignore a nil in the item list.
1762 It's meaningful only for dialog boxes. */
1763 else if (EQ (AREF (menu_items
, i
), Qquote
))
1765 else if (EQ (AREF (menu_items
, i
), Qt
))
1767 /* Create a new pane. */
1768 Lisp_Object pane_name
, prefix
;
1770 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1771 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1773 if (STRINGP (pane_name
))
1775 if (unicode_append_menu
)
1776 pane_name
= ENCODE_UTF_8 (pane_name
);
1777 else if (STRING_MULTIBYTE (pane_name
))
1778 pane_name
= ENCODE_SYSTEM (pane_name
);
1780 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1783 pane_string
= (NILP (pane_name
)
1784 ? "" : (char *) SDATA (pane_name
));
1785 /* If there is just one top-level pane, put all its items directly
1786 under the top-level menu. */
1787 if (menu_items_n_panes
== 1)
1790 /* If the pane has a meaningful name,
1791 make the pane a top-level menu item
1792 with its items as a submenu beneath it. */
1793 if (!keymaps
&& strcmp (pane_string
, ""))
1795 wv
= xmalloc_widget_value ();
1799 first_wv
->contents
= wv
;
1800 wv
->name
= pane_string
;
1801 if (keymaps
&& !NILP (prefix
))
1805 wv
->button_type
= BUTTON_TYPE_NONE
;
1810 else if (first_pane
)
1816 i
+= MENU_ITEMS_PANE_LENGTH
;
1820 /* Create a new item within current pane. */
1821 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1823 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1824 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1825 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1826 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1827 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1828 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1829 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1831 if (STRINGP (item_name
))
1833 if (unicode_append_menu
)
1834 item_name
= ENCODE_UTF_8 (item_name
);
1835 else if (STRING_MULTIBYTE (item_name
))
1836 item_name
= ENCODE_SYSTEM (item_name
);
1838 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1841 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1843 descrip
= ENCODE_SYSTEM (descrip
);
1844 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1847 wv
= xmalloc_widget_value ();
1851 save_wv
->contents
= wv
;
1852 wv
->name
= (char *) SDATA (item_name
);
1853 if (!NILP (descrip
))
1854 wv
->key
= (char *) SDATA (descrip
);
1856 /* Use the contents index as call_data, since we are
1857 restricted to 16-bits. */
1858 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1859 wv
->enabled
= !NILP (enable
);
1862 wv
->button_type
= BUTTON_TYPE_NONE
;
1863 else if (EQ (type
, QCtoggle
))
1864 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1865 else if (EQ (type
, QCradio
))
1866 wv
->button_type
= BUTTON_TYPE_RADIO
;
1870 wv
->selected
= !NILP (selected
);
1871 if (!STRINGP (help
))
1878 i
+= MENU_ITEMS_ITEM_LENGTH
;
1882 /* Deal with the title, if it is non-nil. */
1885 widget_value
*wv_title
= xmalloc_widget_value ();
1886 widget_value
*wv_sep
= xmalloc_widget_value ();
1888 /* Maybe replace this separator with a bitmap or owner-draw item
1889 so that it looks better. Having two separators looks odd. */
1890 wv_sep
->name
= "--";
1891 wv_sep
->next
= first_wv
->contents
;
1892 wv_sep
->help
= Qnil
;
1894 if (unicode_append_menu
)
1895 title
= ENCODE_UTF_8 (title
);
1896 else if (STRING_MULTIBYTE (title
))
1897 title
= ENCODE_SYSTEM (title
);
1899 wv_title
->name
= (char *) SDATA (title
);
1900 wv_title
->enabled
= TRUE
;
1901 wv_title
->title
= TRUE
;
1902 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1903 wv_title
->help
= Qnil
;
1904 wv_title
->next
= wv_sep
;
1905 first_wv
->contents
= wv_title
;
1908 /* Actually create the menu. */
1909 current_popup_menu
= menu
= CreatePopupMenu ();
1910 fill_in_menu (menu
, first_wv
->contents
);
1912 /* Adjust coordinates to be root-window-relative. */
1915 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1917 /* No selection has been chosen yet. */
1918 menu_item_selection
= 0;
1920 /* Display the menu. */
1921 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1922 WM_EMACS_TRACKPOPUPMENU
,
1923 (WPARAM
)menu
, (LPARAM
)&pos
);
1925 /* Clean up extraneous mouse events which might have been generated
1927 discard_mouse_events ();
1929 /* Free the widget_value objects we used to specify the contents. */
1930 free_menubar_widget_value_tree (first_wv
);
1934 /* Free the owner-drawn and help-echo menu strings. */
1935 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1936 f
->output_data
.w32
->menubar_active
= 0;
1938 /* Find the selected item, and its pane, to return
1939 the proper value. */
1940 if (menu_item_selection
!= 0)
1942 Lisp_Object prefix
, entry
;
1944 prefix
= entry
= Qnil
;
1946 while (i
< menu_items_used
)
1948 if (EQ (AREF (menu_items
, i
), Qnil
))
1950 subprefix_stack
[submenu_depth
++] = prefix
;
1954 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1956 prefix
= subprefix_stack
[--submenu_depth
];
1959 else if (EQ (AREF (menu_items
, i
), Qt
))
1961 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1962 i
+= MENU_ITEMS_PANE_LENGTH
;
1964 /* Ignore a nil in the item list.
1965 It's meaningful only for dialog boxes. */
1966 else if (EQ (AREF (menu_items
, i
), Qquote
))
1970 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1971 if (menu_item_selection
== i
)
1977 entry
= Fcons (entry
, Qnil
);
1979 entry
= Fcons (prefix
, entry
);
1980 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1981 if (!NILP (subprefix_stack
[j
]))
1982 entry
= Fcons (subprefix_stack
[j
], entry
);
1986 i
+= MENU_ITEMS_ITEM_LENGTH
;
1990 else if (!for_click
)
1991 /* Make "Cancel" equivalent to C-g. */
1992 Fsignal (Qquit
, Qnil
);
1999 static char * button_names
[] = {
2000 "button1", "button2", "button3", "button4", "button5",
2001 "button6", "button7", "button8", "button9", "button10" };
2004 w32_dialog_show (f
, keymaps
, title
, header
, error
)
2007 Lisp_Object title
, header
;
2010 int i
, nb_buttons
=0;
2011 char dialog_name
[6];
2012 int menu_item_selection
;
2014 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2016 /* Number of elements seen so far, before boundary. */
2018 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2019 int boundary_seen
= 0;
2023 if (menu_items_n_panes
> 1)
2025 *error
= "Multiple panes in dialog box";
2029 /* Create a tree of widget_value objects
2030 representing the text label and buttons. */
2032 Lisp_Object pane_name
, prefix
;
2034 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
2035 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
2036 pane_string
= (NILP (pane_name
)
2037 ? "" : (char *) SDATA (pane_name
));
2038 prev_wv
= xmalloc_widget_value ();
2039 prev_wv
->value
= pane_string
;
2040 if (keymaps
&& !NILP (prefix
))
2042 prev_wv
->enabled
= 1;
2043 prev_wv
->name
= "message";
2044 prev_wv
->help
= Qnil
;
2047 /* Loop over all panes and items, filling in the tree. */
2048 i
= MENU_ITEMS_PANE_LENGTH
;
2049 while (i
< menu_items_used
)
2052 /* Create a new item within current pane. */
2053 Lisp_Object item_name
, enable
, descrip
, help
;
2055 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2056 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2057 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2058 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2060 if (NILP (item_name
))
2062 free_menubar_widget_value_tree (first_wv
);
2063 *error
= "Submenu in dialog items";
2066 if (EQ (item_name
, Qquote
))
2068 /* This is the boundary between left-side elts
2069 and right-side elts. Stop incrementing right_count. */
2074 if (nb_buttons
>= 9)
2076 free_menubar_widget_value_tree (first_wv
);
2077 *error
= "Too many dialog items";
2081 wv
= xmalloc_widget_value ();
2083 wv
->name
= (char *) button_names
[nb_buttons
];
2084 if (!NILP (descrip
))
2085 wv
->key
= (char *) SDATA (descrip
);
2086 wv
->value
= (char *) SDATA (item_name
);
2087 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2088 wv
->enabled
= !NILP (enable
);
2092 if (! boundary_seen
)
2096 i
+= MENU_ITEMS_ITEM_LENGTH
;
2099 /* If the boundary was not specified,
2100 by default put half on the left and half on the right. */
2101 if (! boundary_seen
)
2102 left_count
= nb_buttons
- nb_buttons
/ 2;
2104 wv
= xmalloc_widget_value ();
2105 wv
->name
= dialog_name
;
2108 /* Frame title: 'Q' = Question, 'I' = Information.
2109 Can also have 'E' = Error if, one day, we want
2110 a popup for errors. */
2112 dialog_name
[0] = 'Q';
2114 dialog_name
[0] = 'I';
2116 /* Dialog boxes use a really stupid name encoding
2117 which specifies how many buttons to use
2118 and how many buttons are on the right. */
2119 dialog_name
[1] = '0' + nb_buttons
;
2120 dialog_name
[2] = 'B';
2121 dialog_name
[3] = 'R';
2122 /* Number of buttons to put on the right. */
2123 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2125 wv
->contents
= first_wv
;
2129 /* Actually create the dialog. */
2130 dialog_id
= widget_id_tick
++;
2131 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2132 f
->output_data
.w32
->widget
, 1, 0,
2133 dialog_selection_callback
, 0);
2134 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2136 /* Free the widget_value objects we used to specify the contents. */
2137 free_menubar_widget_value_tree (first_wv
);
2139 /* No selection has been chosen yet. */
2140 menu_item_selection
= 0;
2142 /* Display the menu. */
2143 lw_pop_up_all_widgets (dialog_id
);
2145 /* Process events that apply to the menu. */
2146 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2148 lw_destroy_all_widgets (dialog_id
);
2150 /* Find the selected item, and its pane, to return
2151 the proper value. */
2152 if (menu_item_selection
!= 0)
2158 while (i
< menu_items_used
)
2162 if (EQ (AREF (menu_items
, i
), Qt
))
2164 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2165 i
+= MENU_ITEMS_PANE_LENGTH
;
2169 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2170 if (menu_item_selection
== i
)
2174 entry
= Fcons (entry
, Qnil
);
2176 entry
= Fcons (prefix
, entry
);
2180 i
+= MENU_ITEMS_ITEM_LENGTH
;
2185 /* Make "Cancel" equivalent to C-g. */
2186 Fsignal (Qquit
, Qnil
);
2190 #endif /* HAVE_DIALOGS */
2193 /* Is this item a separator? */
2195 name_is_separator (name
)
2200 /* Check if name string consists of only dashes ('-'). */
2201 while (*name
== '-') name
++;
2202 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2203 or "--deep-shadow". We don't implement them yet, se we just treat
2204 them like normal separators. */
2205 return (*name
== '\0' || start
+ 2 == name
);
2209 /* Indicate boundary between left and right. */
2211 add_left_right_boundary (HMENU menu
)
2213 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2216 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2218 utf8to16 (unsigned char * src
, int len
, WCHAR
* dest
)
2225 *dest
= (WCHAR
) *src
;
2226 dest
++; src
++; len
--;
2228 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2229 else if (*src
< 0xC0)
2233 /* 2 char UTF-8 sequence. */
2234 else if (*src
< 0xE0)
2236 *dest
= (WCHAR
) (((*src
& 0x1f) << 6)
2237 | (*(src
+ 1) & 0x3f));
2238 src
+= 2; len
-= 2; dest
++;
2240 else if (*src
< 0xF0)
2242 *dest
= (WCHAR
) (((*src
& 0x0f) << 12)
2243 | ((*(src
+ 1) & 0x3f) << 6)
2244 | (*(src
+ 2) & 0x3f));
2245 src
+= 3; len
-= 3; dest
++;
2247 else /* Not encodable. Insert Unicode Substitution char. */
2249 *dest
= (WCHAR
) 0xfffd;
2250 src
++; len
--; dest
++;
2257 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2260 char *out_string
, *p
, *q
;
2262 size_t nlen
, orig_len
;
2264 if (name_is_separator (wv
->name
))
2266 fuFlags
= MF_SEPARATOR
;
2272 fuFlags
= MF_STRING
;
2274 fuFlags
= MF_STRING
| MF_GRAYED
;
2276 if (wv
->key
!= NULL
)
2278 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2279 strcpy (out_string
, wv
->name
);
2280 strcat (out_string
, "\t");
2281 strcat (out_string
, wv
->key
);
2284 out_string
= wv
->name
;
2286 /* Quote any special characters within the menu item's text and
2288 nlen
= orig_len
= strlen (out_string
);
2289 if (unicode_append_menu
)
2291 /* With UTF-8, & cannot be part of a multibyte character. */
2292 for (p
= out_string
; *p
; p
++)
2300 /* If encoded with the system codepage, use multibyte string
2301 functions in case of multibyte characters that contain '&'. */
2302 for (p
= out_string
; *p
; p
= _mbsinc (p
))
2304 if (_mbsnextc (p
) == '&')
2309 if (nlen
> orig_len
)
2312 out_string
= alloca (nlen
+ 1);
2316 if (unicode_append_menu
)
2324 if (_mbsnextc (p
) == '&')
2339 else if (wv
->title
|| wv
->call_data
== 0)
2341 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2342 we can't deallocate the memory otherwise. */
2343 if (get_menu_item_info
)
2345 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2346 strcpy (out_string
, wv
->name
);
2348 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2350 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2353 fuFlags
= MF_DISABLED
;
2356 /* Draw radio buttons and tickboxes. */
2357 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2358 wv
->button_type
== BUTTON_TYPE_RADIO
))
2359 fuFlags
|= MF_CHECKED
;
2361 fuFlags
|= MF_UNCHECKED
;
2364 if (unicode_append_menu
&& out_string
)
2366 /* Convert out_string from UTF-8 to UTF-16-LE. */
2367 int utf8_len
= strlen (out_string
);
2368 WCHAR
* utf16_string
;
2369 if (fuFlags
& MF_OWNERDRAW
)
2370 utf16_string
= local_alloc ((utf8_len
+ 1) * sizeof (WCHAR
));
2372 utf16_string
= alloca ((utf8_len
+ 1) * sizeof (WCHAR
));
2374 utf8to16 (out_string
, utf8_len
, utf16_string
);
2375 return_value
= unicode_append_menu (menu
, fuFlags
,
2376 item
!= NULL
? (UINT
) item
2377 : (UINT
) wv
->call_data
,
2381 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2382 apparently does exist at least in some cases and appears to be
2383 stubbed out to do nothing. out_string is UTF-8, but since
2384 our standard menus are in English and this is only going to
2385 happen the first time a menu is used, the encoding is
2386 of minor importance compared with menus not working at all. */
2388 AppendMenu (menu
, fuFlags
,
2389 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2391 /* Don't use unicode menus in future. */
2392 unicode_append_menu
= NULL
;
2395 if (unicode_append_menu
&& (fuFlags
& MF_OWNERDRAW
))
2396 local_free (out_string
);
2403 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2407 /* This must be done after the menu item is created. */
2408 if (!wv
->title
&& wv
->call_data
!= 0)
2410 if (set_menu_item_info
)
2413 bzero (&info
, sizeof (info
));
2414 info
.cbSize
= sizeof (info
);
2415 info
.fMask
= MIIM_DATA
;
2417 /* Set help string for menu item. Leave it as a Lisp_Object
2418 until it is ready to be displayed, since GC can happen while
2419 menus are active. */
2420 if (!NILP (wv
->help
))
2421 #ifdef USE_LISP_UNION_TYPE
2422 info
.dwItemData
= (DWORD
) (wv
->help
).i
;
2424 info
.dwItemData
= (DWORD
) (wv
->help
);
2426 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2428 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2429 RADIO items, but is not available on NT 3.51 and earlier. */
2430 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2431 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2432 info
.dwTypeData
= out_string
;
2433 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2436 set_menu_item_info (menu
,
2437 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2441 return return_value
;
2444 /* Construct native Windows menu(bar) based on widget_value tree. */
2446 fill_in_menu (HMENU menu
, widget_value
*wv
)
2448 int items_added
= 0;
2450 for ( ; wv
!= NULL
; wv
= wv
->next
)
2454 HMENU sub_menu
= CreatePopupMenu ();
2456 if (sub_menu
== NULL
)
2459 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2460 !add_menu_item (menu
, wv
, sub_menu
))
2462 DestroyMenu (sub_menu
);
2468 if (!add_menu_item (menu
, wv
, NULL
))
2475 /* Display help string for currently pointed to menu item. Not
2476 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2479 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2481 if (get_menu_item_info
)
2483 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2484 Lisp_Object frame
, help
;
2486 /* No help echo on owner-draw menu items, or when the keyboard is used
2487 to navigate the menus, since tooltips are distracting if they pop
2489 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
2490 || !(flags
& MF_MOUSESELECT
))
2496 bzero (&info
, sizeof (info
));
2497 info
.cbSize
= sizeof (info
);
2498 info
.fMask
= MIIM_DATA
;
2499 get_menu_item_info (menu
, item
, FALSE
, &info
);
2501 #ifdef USE_LISP_UNION_TYPE
2502 help
= info
.dwItemData
? (Lisp_Object
) ((EMACS_INT
) info
.dwItemData
)
2505 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2509 /* Store the help echo in the keyboard buffer as the X toolkit
2510 version does, rather than directly showing it. This seems to
2511 solve the GC problems that were present when we based the
2512 Windows code on the non-toolkit version. */
2515 XSETFRAME (frame
, f
);
2516 kbd_buffer_store_help_event (frame
, help
);
2519 /* X version has a loop through frames here, which doesn't
2520 appear to do anything, unless it has some side effect. */
2521 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2525 /* Free memory used by owner-drawn strings. */
2527 w32_free_submenu_strings (menu
)
2530 int i
, num
= GetMenuItemCount (menu
);
2531 for (i
= 0; i
< num
; i
++)
2534 bzero (&info
, sizeof (info
));
2535 info
.cbSize
= sizeof (info
);
2536 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2538 get_menu_item_info (menu
, i
, TRUE
, &info
);
2540 /* Owner-drawn names are held in dwItemData. */
2541 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2544 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2546 local_free (info
.dwItemData
);
2549 /* Recurse down submenus. */
2551 w32_free_submenu_strings (info
.hSubMenu
);
2556 w32_free_menu_strings (hwnd
)
2559 HMENU menu
= current_popup_menu
;
2561 if (get_menu_item_info
)
2563 /* If there is no popup menu active, free the strings from the frame's
2566 menu
= GetMenu (hwnd
);
2569 w32_free_submenu_strings (menu
);
2572 current_popup_menu
= NULL
;
2575 #endif /* HAVE_MENUS */
2577 /* The following is used by delayed window autoselection. */
2579 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2580 doc
: /* Return t if a menu or popup dialog is active on selected frame. */)
2585 f
= SELECTED_FRAME ();
2586 return (f
->output_data
.w32
->menubar_active
> 0) ? Qt
: Qnil
;
2589 #endif /* HAVE_MENUS */
2592 void syms_of_w32menu ()
2594 globals_of_w32menu ();
2595 staticpro (&menu_items
);
2598 current_popup_menu
= NULL
;
2600 Qdebug_on_next_call
= intern ("debug-on-next-call");
2601 staticpro (&Qdebug_on_next_call
);
2603 defsubr (&Sx_popup_menu
);
2604 defsubr (&Smenu_or_popup_active_p
);
2606 defsubr (&Sx_popup_dialog
);
2611 globals_of_w32menu is used to initialize those global variables that
2612 must always be initialized on startup even when the global variable
2613 initialized is non zero (see the function main in emacs.c).
2614 globals_of_w32menu is called from syms_of_w32menu when the global
2615 variable initialized is 0 and directly from main when initialized
2618 void globals_of_w32menu ()
2620 /* See if Get/SetMenuItemInfo functions are available. */
2621 HMODULE user32
= GetModuleHandle ("user32.dll");
2622 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2623 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
2624 unicode_append_menu
= (AppendMenuW_Proc
) GetProcAddress (user32
, "AppendMenuW");
2627 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2628 (do not change this comment) */