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"
37 #include "character.h"
40 /* This may include sys/types.h, and that somehow loses
41 if this is not done before the other system files. */
44 /* Load sys/types.h if not already loaded.
45 In some systems loading it twice is suicidal. */
47 #include <sys/types.h>
50 #include "dispextern.h"
52 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
54 /******************************************************************/
55 /* Definitions copied from lwlib.h */
57 typedef void * XtPointer
;
67 /* This structure is based on the one in ../lwlib/lwlib.h, modified
69 typedef struct _widget_value
74 /* value (meaning depend on widget type) */
76 /* keyboard equivalent. no implications for XtTranslations */
79 /* Help string or nil if none.
80 GC finds this string through the frame's menu_bar_vector
81 or through menu_items. */
85 /* true if selected */
87 /* The type of a button. */
88 enum button_type button_type
;
89 /* true if menu title */
92 /* true if was edited (maintained by get_value) */
94 /* true if has changed (maintained by lw library) */
96 /* true if this widget itself has changed,
97 but not counting the other widgets found in the `next' field. */
98 change_type this_one_change
;
100 /* Contents of the sub-widgets, also selected slot for checkbox */
101 struct _widget_value
* contents
;
102 /* data passed to callback */
104 /* next one in the list */
105 struct _widget_value
* next
;
107 /* slot for the toolkit dependent part. Always initialize to NULL. */
109 /* tell us if we should free the toolkit data slot when freeing the
110 widget_value itself. */
111 Boolean free_toolkit_data
;
113 /* we resource the widget_value structures; this points to the next
114 one on the free list if this one has been deallocated.
116 struct _widget_value
*free_list
;
120 /* Local memory management */
121 #define local_heap (GetProcessHeap ())
122 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
123 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
125 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
126 #define free_widget_value(wv) (local_free ((wv)))
128 /******************************************************************/
135 HMENU current_popup_menu
;
137 void syms_of_w32menu ();
138 void globals_of_w32menu ();
140 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
144 IN OUT LPMENUITEMINFOA
);
145 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
149 IN LPCMENUITEMINFOA
);
151 GetMenuItemInfoA_Proc get_menu_item_info
= NULL
;
152 SetMenuItemInfoA_Proc set_menu_item_info
= NULL
;
153 AppendMenuW_Proc unicode_append_menu
= NULL
;
155 Lisp_Object Qdebug_on_next_call
;
157 extern Lisp_Object Vmenu_updating_frame
;
159 extern Lisp_Object Qmenu_bar
;
161 extern Lisp_Object QCtoggle
, QCradio
;
163 extern Lisp_Object Voverriding_local_map
;
164 extern Lisp_Object Voverriding_local_map_menu_flag
;
166 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
168 extern Lisp_Object Qmenu_bar_update_hook
;
170 void set_frame_menubar ();
172 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
173 Lisp_Object
, Lisp_Object
, Lisp_Object
,
174 Lisp_Object
, Lisp_Object
));
176 static Lisp_Object
w32_dialog_show ();
178 static Lisp_Object
w32_menu_show ();
180 static void keymap_panes ();
181 static void single_keymap_panes ();
182 static void single_menu_item ();
183 static void list_of_panes ();
184 static void list_of_items ();
185 void w32_free_menu_strings (HWND
);
187 /* This holds a Lisp vector that holds the results of decoding
188 the keymaps or alist-of-alists that specify a menu.
190 It describes the panes and items within the panes.
192 Each pane is described by 3 elements in the vector:
193 t, the pane name, the pane's prefix key.
194 Then follow the pane's items, with 5 elements per item:
195 the item string, the enable flag, the item's value,
196 the definition, and the equivalent keyboard key's description string.
198 In some cases, multiple levels of menus may be described.
199 A single vector slot containing nil indicates the start of a submenu.
200 A single vector slot containing lambda indicates the end of a submenu.
201 The submenu follows a menu item which is the way to reach the submenu.
203 A single vector slot containing quote indicates that the
204 following items should appear on the right of a dialog box.
206 Using a Lisp vector to hold this information while we decode it
207 takes care of protecting all the data from GC. */
209 #define MENU_ITEMS_PANE_NAME 1
210 #define MENU_ITEMS_PANE_PREFIX 2
211 #define MENU_ITEMS_PANE_LENGTH 3
215 MENU_ITEMS_ITEM_NAME
= 0,
216 MENU_ITEMS_ITEM_ENABLE
,
217 MENU_ITEMS_ITEM_VALUE
,
218 MENU_ITEMS_ITEM_EQUIV_KEY
,
219 MENU_ITEMS_ITEM_DEFINITION
,
220 MENU_ITEMS_ITEM_TYPE
,
221 MENU_ITEMS_ITEM_SELECTED
,
222 MENU_ITEMS_ITEM_HELP
,
223 MENU_ITEMS_ITEM_LENGTH
226 static Lisp_Object menu_items
;
228 /* Number of slots currently allocated in menu_items. */
229 static int menu_items_allocated
;
231 /* This is the index in menu_items of the first empty slot. */
232 static int menu_items_used
;
234 /* The number of panes currently recorded in menu_items,
235 excluding those within submenus. */
236 static int menu_items_n_panes
;
238 /* Current depth within submenus. */
239 static int menu_items_submenu_depth
;
241 static int next_menubar_widget_id
;
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
250 int pending_menu_activation
;
253 /* Return the frame whose ->output_data.w32->menubar_widget equals
256 static struct frame
*
257 menubar_id_to_frame (id
)
260 Lisp_Object tail
, frame
;
263 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
269 if (!FRAME_WINDOW_P (f
))
271 if (f
->output_data
.w32
->menubar_widget
== id
)
277 /* Initialize the menu_items structure if we haven't already done so.
278 Also mark it as currently empty. */
283 if (NILP (menu_items
))
285 menu_items_allocated
= 60;
286 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
290 menu_items_n_panes
= 0;
291 menu_items_submenu_depth
= 0;
294 /* Call at the end of generating the data in menu_items.
295 This fills in the number of items in the last pane. */
302 /* Call when finished using the data for the current menu
306 discard_menu_items ()
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated
> 200)
313 menu_items_allocated
= 0;
317 /* Make the menu_items vector twice as large. */
322 menu_items_allocated
*= 2;
323 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
326 /* Begin a submenu. */
329 push_submenu_start ()
331 if (menu_items_used
+ 1 > menu_items_allocated
)
334 ASET (menu_items
, menu_items_used
++, Qnil
);
335 menu_items_submenu_depth
++;
343 if (menu_items_used
+ 1 > menu_items_allocated
)
346 ASET (menu_items
, menu_items_used
++, Qlambda
);
347 menu_items_submenu_depth
--;
350 /* Indicate boundary between left and right. */
353 push_left_right_boundary ()
355 if (menu_items_used
+ 1 > menu_items_allocated
)
358 ASET (menu_items
, menu_items_used
++, Qquote
);
361 /* Start a new menu pane in menu_items.
362 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
365 push_menu_pane (name
, prefix_vec
)
366 Lisp_Object name
, prefix_vec
;
368 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
371 if (menu_items_submenu_depth
== 0)
372 menu_items_n_panes
++;
373 ASET (menu_items
, menu_items_used
++, Qt
);
374 ASET (menu_items
, menu_items_used
++, name
);
375 ASET (menu_items
, menu_items_used
++, prefix_vec
);
378 /* Push one menu item into the current pane. NAME is the string to
379 display. ENABLE if non-nil means this item can be selected. KEY
380 is the key generated by choosing this item, or nil if this item
381 doesn't really have a definition. DEF is the definition of this
382 item. EQUIV is the textual description of the keyboard equivalent
383 for this item (or nil if none). TYPE is the type of this menu
384 item, one of nil, `toggle' or `radio'. */
387 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
388 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
390 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
393 ASET (menu_items
, menu_items_used
++, name
);
394 ASET (menu_items
, menu_items_used
++, enable
);
395 ASET (menu_items
, menu_items_used
++, key
);
396 ASET (menu_items
, menu_items_used
++, equiv
);
397 ASET (menu_items
, menu_items_used
++, def
);
398 ASET (menu_items
, menu_items_used
++, type
);
399 ASET (menu_items
, menu_items_used
++, selected
);
400 ASET (menu_items
, menu_items_used
++, help
);
403 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
404 and generate menu panes for them in menu_items.
405 If NOTREAL is nonzero,
406 don't bother really computing whether an item is enabled. */
409 keymap_panes (keymaps
, nmaps
, notreal
)
410 Lisp_Object
*keymaps
;
418 /* Loop over the given keymaps, making a pane for each map.
419 But don't make a pane that is empty--ignore that map instead.
420 P is the number of panes we have made so far. */
421 for (mapno
= 0; mapno
< nmaps
; mapno
++)
422 single_keymap_panes (keymaps
[mapno
],
423 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
425 finish_menu_items ();
428 /* This is a recursive subroutine of keymap_panes.
429 It handles one keymap, KEYMAP.
430 The other arguments are passed along
431 or point to local variables of the previous function.
432 If NOTREAL is nonzero, only check for equivalent key bindings, don't
433 evaluate expressions in menu items and don't make any menu.
435 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
438 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
440 Lisp_Object pane_name
;
445 Lisp_Object pending_maps
= Qnil
;
446 Lisp_Object tail
, item
;
447 struct gcpro gcpro1
, gcpro2
;
452 push_menu_pane (pane_name
, prefix
);
454 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
456 GCPRO2 (keymap
, pending_maps
);
457 /* Look at each key binding, and if it is a menu item add it
461 single_menu_item (XCAR (item
), XCDR (item
),
462 &pending_maps
, notreal
, maxdepth
);
463 else if (VECTORP (item
))
465 /* Loop over the char values represented in the vector. */
466 int len
= ASIZE (item
);
468 for (c
= 0; c
< len
; c
++)
470 Lisp_Object character
;
471 XSETFASTINT (character
, c
);
472 single_menu_item (character
, AREF (item
, c
),
473 &pending_maps
, notreal
, maxdepth
);
479 /* Process now any submenus which want to be panes at this level. */
480 while (!NILP (pending_maps
))
482 Lisp_Object elt
, eltcdr
, string
;
483 elt
= Fcar (pending_maps
);
485 string
= XCAR (eltcdr
);
486 /* We no longer discard the @ from the beginning of the string here.
487 Instead, we do this in w32_menu_show. */
488 single_keymap_panes (Fcar (elt
), string
,
489 XCDR (eltcdr
), notreal
, maxdepth
- 1);
490 pending_maps
= Fcdr (pending_maps
);
494 /* This is a subroutine of single_keymap_panes that handles one
496 KEY is a key in a keymap and ITEM is its binding.
497 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
499 If NOTREAL is nonzero, only check for equivalent key bindings, don't
500 evaluate expressions in menu items and don't make any menu.
501 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
504 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
505 Lisp_Object key
, item
;
506 Lisp_Object
*pending_maps_ptr
;
507 int maxdepth
, notreal
;
509 Lisp_Object map
, item_string
, enabled
;
510 struct gcpro gcpro1
, gcpro2
;
513 /* Parse the menu item and leave the result in item_properties. */
515 res
= parse_menu_item (item
, notreal
, 0);
518 return; /* Not a menu item. */
520 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
524 /* We don't want to make a menu, just traverse the keymaps to
525 precompute equivalent key bindings. */
527 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
531 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
532 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
534 if (!NILP (map
) && SREF (item_string
, 0) == '@')
537 /* An enabled separate pane. Remember this to handle it later. */
538 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
543 push_menu_item (item_string
, enabled
, key
,
544 AREF (item_properties
, ITEM_PROPERTY_DEF
),
545 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
546 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
547 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
548 AREF (item_properties
, ITEM_PROPERTY_HELP
));
550 /* Display a submenu using the toolkit. */
551 if (! (NILP (map
) || NILP (enabled
)))
553 push_submenu_start ();
554 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
559 /* Push all the panes and items of a menu described by the
560 alist-of-alists MENU.
561 This handles old-fashioned calls to x-popup-menu. */
571 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
573 Lisp_Object elt
, pane_name
, pane_data
;
575 pane_name
= Fcar (elt
);
576 CHECK_STRING (pane_name
);
577 push_menu_pane (pane_name
, Qnil
);
578 pane_data
= Fcdr (elt
);
579 CHECK_CONS (pane_data
);
580 list_of_items (pane_data
);
583 finish_menu_items ();
586 /* Push the items in a single pane defined by the alist PANE. */
592 Lisp_Object tail
, item
, item1
;
594 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
598 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
599 else if (NILP (item
))
600 push_left_right_boundary ();
605 CHECK_STRING (item1
);
606 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
611 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
612 doc
: /* Pop up a deck-of-cards menu and return user's selection.
613 POSITION is a position specification. This is either a mouse button
614 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
615 are positions in pixels from the top left corner of WINDOW's frame
616 \(WINDOW may be a frame object instead of a window). This controls the
617 position of the center of the first line in the first pane of the
618 menu, not the top left of the menu as a whole. If POSITION is t, it
619 means to use the current mouse position.
621 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
622 The menu items come from key bindings that have a menu string as well as
623 a definition; actually, the \"definition\" in such a key binding looks like
624 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
625 the keymap as a top-level element.
627 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
628 Otherwise, REAL-DEFINITION should be a valid key binding definition.
630 You can also use a list of keymaps as MENU. Then each keymap makes a
631 separate pane. When MENU is a keymap or a list of keymaps, the return
632 value is a list of events.
634 Alternatively, you can specify a menu of multiple panes with a list of
635 the form (TITLE PANE1 PANE2...), where each pane is a list of
636 form (TITLE ITEM1 ITEM2...).
637 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
638 appear as an item--that makes a nonselectable line in the menu.
639 With this form of menu, the return value is VALUE from the chosen item.
641 If POSITION is nil, don't display the menu at all, just precalculate the
642 cached information about equivalent key sequences. */)
644 Lisp_Object position
, menu
;
646 Lisp_Object keymap
, tem
;
647 int xpos
= 0, ypos
= 0;
650 Lisp_Object selection
;
652 Lisp_Object x
, y
, window
;
658 if (! NILP (position
))
662 /* Decode the first argument: find the window and the coordinates. */
663 if (EQ (position
, Qt
)
664 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
665 || EQ (XCAR (position
), Qtool_bar
))))
667 /* Use the mouse's current position. */
668 FRAME_PTR new_f
= SELECTED_FRAME ();
669 Lisp_Object bar_window
;
670 enum scroll_bar_part part
;
673 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
674 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
675 &part
, &x
, &y
, &time
);
677 XSETFRAME (window
, new_f
);
680 window
= selected_window
;
687 tem
= Fcar (position
);
690 window
= Fcar (Fcdr (position
));
692 y
= Fcar (Fcdr (tem
));
697 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
698 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
699 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
708 /* Decode where to put the menu. */
716 else if (WINDOWP (window
))
718 CHECK_LIVE_WINDOW (window
);
719 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
721 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
722 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
725 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
726 but I don't want to make one now. */
727 CHECK_WINDOW (window
);
732 XSETFRAME (Vmenu_updating_frame
, f
);
735 Vmenu_updating_frame
= Qnil
;
736 #endif /* HAVE_MENUS */
741 /* Decode the menu items from what was specified. */
743 keymap
= get_keymap (menu
, 0, 0);
746 /* We were given a keymap. Extract menu info from the keymap. */
749 /* Extract the detailed info to make one pane. */
750 keymap_panes (&menu
, 1, NILP (position
));
752 /* Search for a string appearing directly as an element of the keymap.
753 That string is the title of the menu. */
754 prompt
= Fkeymap_prompt (keymap
);
755 if (NILP (title
) && !NILP (prompt
))
758 /* Make that be the pane title of the first pane. */
759 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
760 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
764 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
766 /* We were given a list of keymaps. */
767 int nmaps
= XFASTINT (Flength (menu
));
769 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
774 /* The first keymap that has a prompt string
775 supplies the menu title. */
776 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
780 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
782 prompt
= Fkeymap_prompt (keymap
);
783 if (NILP (title
) && !NILP (prompt
))
787 /* Extract the detailed info to make one pane. */
788 keymap_panes (maps
, nmaps
, NILP (position
));
790 /* Make the title be the pane title of the first pane. */
791 if (!NILP (title
) && menu_items_n_panes
>= 0)
792 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
798 /* We were given an old-fashioned menu. */
800 CHECK_STRING (title
);
802 list_of_panes (Fcdr (menu
));
809 discard_menu_items ();
815 /* If resources from a previous popup menu still exist, does nothing
816 until the `menu_free_timer' has freed them (see w32fns.c). This
817 can occur if you press ESC or click outside a menu without selecting
820 if (current_popup_menu
)
822 discard_menu_items ();
827 /* Display them in a menu. */
830 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
831 keymaps
, title
, &error_name
);
834 discard_menu_items ();
836 #endif /* HAVE_MENUS */
840 if (error_name
) error (error_name
);
846 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
847 doc
: /* Pop up a dialog box and return user's selection.
848 POSITION specifies which frame to use.
849 This is normally a mouse button event or a window or frame.
850 If POSITION is t, it means to use the frame the mouse is on.
851 The dialog box appears in the middle of the specified frame.
853 CONTENTS specifies the alternatives to display in the dialog box.
854 It is a list of the form (TITLE ITEM1 ITEM2...).
855 Each ITEM is a cons cell (STRING . VALUE).
856 The return value is VALUE from the chosen item.
858 An ITEM may also be just a string--that makes a nonselectable item.
859 An ITEM may also be nil--that means to put all preceding items
860 on the left of the dialog box and all following items on the right.
861 \(By default, approximately half appear on each side.)
863 If HEADER is non-nil, the frame title for the box is "Information",
864 otherwise it is "Question". */)
865 (position
, contents
, header
)
866 Lisp_Object position
, contents
, header
;
873 /* Decode the first argument: find the window or frame to use. */
874 if (EQ (position
, Qt
)
875 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
876 || EQ (XCAR (position
), Qtool_bar
))))
878 #if 0 /* Using the frame the mouse is on may not be right. */
879 /* Use the mouse's current position. */
880 FRAME_PTR new_f
= SELECTED_FRAME ();
881 Lisp_Object bar_window
;
882 enum scroll_bar_part part
;
886 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
889 XSETFRAME (window
, new_f
);
891 window
= selected_window
;
893 window
= selected_window
;
895 else if (CONSP (position
))
898 tem
= Fcar (position
);
900 window
= Fcar (Fcdr (position
));
903 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
904 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
907 else if (WINDOWP (position
) || FRAMEP (position
))
912 /* Decode where to put the menu. */
916 else if (WINDOWP (window
))
918 CHECK_LIVE_WINDOW (window
);
919 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
922 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
923 but I don't want to make one now. */
924 CHECK_WINDOW (window
);
927 /* Display a menu with these alternatives
928 in the middle of frame F. */
930 Lisp_Object x
, y
, frame
, newpos
;
931 XSETFRAME (frame
, f
);
932 XSETINT (x
, x_pixel_width (f
) / 2);
933 XSETINT (y
, x_pixel_height (f
) / 2);
934 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
936 return Fx_popup_menu (newpos
,
937 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
939 #else /* HAVE_DIALOGS */
943 Lisp_Object selection
;
945 /* Decode the dialog items from what was specified. */
946 title
= Fcar (contents
);
947 CHECK_STRING (title
);
949 list_of_panes (Fcons (contents
, Qnil
));
951 /* Display them in a dialog box. */
953 selection
= w32_dialog_show (f
, 0, title
, header
, &error_name
);
956 discard_menu_items ();
958 if (error_name
) error (error_name
);
961 #endif /* HAVE_DIALOGS */
964 /* Activate the menu bar of frame F.
965 This is called from keyboard.c when it gets the
966 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
968 To activate the menu bar, we signal to the input thread that it can
969 return from the WM_INITMENU message, allowing the normal Windows
970 processing of the menus.
972 But first we recompute the menu bar contents (the whole tree).
974 This way we can safely execute Lisp code. */
977 x_activate_menubar (f
)
980 set_frame_menubar (f
, 0, 1);
982 /* Lock out further menubar changes while active. */
983 f
->output_data
.w32
->menubar_active
= 1;
985 /* Signal input thread to return from WM_INITMENU. */
986 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
989 /* This callback is called from the menu bar pulldown menu
990 when the user makes a selection.
991 Figure out what the user chose
992 and put the appropriate events into the keyboard buffer. */
995 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
997 Lisp_Object prefix
, entry
;
999 Lisp_Object
*subprefix_stack
;
1000 int submenu_depth
= 0;
1006 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1007 vector
= f
->menu_bar_vector
;
1010 while (i
< f
->menu_bar_items_used
)
1012 if (EQ (AREF (vector
, i
), Qnil
))
1014 subprefix_stack
[submenu_depth
++] = prefix
;
1018 else if (EQ (AREF (vector
, i
), Qlambda
))
1020 prefix
= subprefix_stack
[--submenu_depth
];
1023 else if (EQ (AREF (vector
, i
), Qt
))
1025 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1026 i
+= MENU_ITEMS_PANE_LENGTH
;
1030 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1031 /* The EMACS_INT cast avoids a warning. There's no problem
1032 as long as pointers have enough bits to hold small integers. */
1033 if ((int) (EMACS_INT
) client_data
== i
)
1036 struct input_event buf
;
1040 XSETFRAME (frame
, f
);
1041 buf
.kind
= MENU_BAR_EVENT
;
1042 buf
.frame_or_window
= frame
;
1044 kbd_buffer_store_event (&buf
);
1046 for (j
= 0; j
< submenu_depth
; j
++)
1047 if (!NILP (subprefix_stack
[j
]))
1049 buf
.kind
= MENU_BAR_EVENT
;
1050 buf
.frame_or_window
= frame
;
1051 buf
.arg
= subprefix_stack
[j
];
1052 kbd_buffer_store_event (&buf
);
1057 buf
.kind
= MENU_BAR_EVENT
;
1058 buf
.frame_or_window
= frame
;
1060 kbd_buffer_store_event (&buf
);
1063 buf
.kind
= MENU_BAR_EVENT
;
1064 buf
.frame_or_window
= frame
;
1066 /* Free memory used by owner-drawn and help-echo strings. */
1067 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1068 kbd_buffer_store_event (&buf
);
1070 f
->output_data
.w32
->menubar_active
= 0;
1073 i
+= MENU_ITEMS_ITEM_LENGTH
;
1076 /* Free memory used by owner-drawn and help-echo strings. */
1077 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1078 f
->output_data
.w32
->menubar_active
= 0;
1081 /* Allocate a widget_value, blocking input. */
1084 xmalloc_widget_value ()
1086 widget_value
*value
;
1089 value
= malloc_widget_value ();
1095 /* This recursively calls free_widget_value on the tree of widgets.
1096 It must free all data that was malloc'ed for these widget_values.
1097 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1098 must be left alone. */
1101 free_menubar_widget_value_tree (wv
)
1106 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1108 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1110 free_menubar_widget_value_tree (wv
->contents
);
1111 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1115 free_menubar_widget_value_tree (wv
->next
);
1116 wv
->next
= (widget_value
*) 0xDEADBEEF;
1119 free_widget_value (wv
);
1123 /* Set up data i menu_items for a menu bar item
1124 whose event type is ITEM_KEY (with string ITEM_NAME)
1125 and whose contents come from the list of keymaps MAPS. */
1128 parse_single_submenu (item_key
, item_name
, maps
)
1129 Lisp_Object item_key
, item_name
, maps
;
1133 Lisp_Object
*mapvec
;
1135 int top_level_items
= 0;
1137 length
= Flength (maps
);
1138 len
= XINT (length
);
1140 /* Convert the list MAPS into a vector MAPVEC. */
1141 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1142 for (i
= 0; i
< len
; i
++)
1144 mapvec
[i
] = Fcar (maps
);
1148 /* Loop over the given keymaps, making a pane for each map.
1149 But don't make a pane that is empty--ignore that map instead. */
1150 for (i
= 0; i
< len
; i
++)
1152 if (SYMBOLP (mapvec
[i
])
1153 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1155 /* Here we have a command at top level in the menu bar
1156 as opposed to a submenu. */
1157 top_level_items
= 1;
1158 push_menu_pane (Qnil
, Qnil
);
1159 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1160 Qnil
, Qnil
, Qnil
, Qnil
);
1165 prompt
= Fkeymap_prompt (mapvec
[i
]);
1166 single_keymap_panes (mapvec
[i
],
1167 !NILP (prompt
) ? prompt
: item_name
,
1172 return top_level_items
;
1176 /* Create a tree of widget_value objects
1177 representing the panes and items
1178 in menu_items starting at index START, up to index END. */
1180 static widget_value
*
1181 digest_single_submenu (start
, end
, top_level_items
)
1182 int start
, end
, top_level_items
;
1184 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1186 int submenu_depth
= 0;
1187 widget_value
**submenu_stack
;
1190 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1191 wv
= xmalloc_widget_value ();
1195 wv
->button_type
= BUTTON_TYPE_NONE
;
1201 /* Loop over all panes and items made by the preceding call
1202 to parse_single_submenu and construct a tree of widget_value objects.
1203 Ignore the panes and items used by previous calls to
1204 digest_single_submenu, even though those are also in menu_items. */
1208 if (EQ (AREF (menu_items
, i
), Qnil
))
1210 submenu_stack
[submenu_depth
++] = save_wv
;
1215 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1218 save_wv
= submenu_stack
[--submenu_depth
];
1221 else if (EQ (AREF (menu_items
, i
), Qt
)
1222 && submenu_depth
!= 0)
1223 i
+= MENU_ITEMS_PANE_LENGTH
;
1224 /* Ignore a nil in the item list.
1225 It's meaningful only for dialog boxes. */
1226 else if (EQ (AREF (menu_items
, i
), Qquote
))
1228 else if (EQ (AREF (menu_items
, i
), Qt
))
1230 /* Create a new pane. */
1231 Lisp_Object pane_name
, prefix
;
1234 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1235 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1237 if (STRINGP (pane_name
))
1239 if (unicode_append_menu
)
1240 /* Encode as UTF-8 for now. */
1241 pane_name
= ENCODE_UTF_8 (pane_name
);
1242 else if (STRING_MULTIBYTE (pane_name
))
1243 pane_name
= ENCODE_SYSTEM (pane_name
);
1245 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1248 pane_string
= (NILP (pane_name
)
1249 ? "" : (char *) SDATA (pane_name
));
1250 /* If there is just one top-level pane, put all its items directly
1251 under the top-level menu. */
1252 if (menu_items_n_panes
== 1)
1255 /* If the pane has a meaningful name,
1256 make the pane a top-level menu item
1257 with its items as a submenu beneath it. */
1258 if (strcmp (pane_string
, ""))
1260 wv
= xmalloc_widget_value ();
1264 first_wv
->contents
= wv
;
1265 wv
->lname
= pane_name
;
1266 /* Set value to 1 so update_submenu_strings can handle '@' */
1267 wv
->value
= (char *) 1;
1269 wv
->button_type
= BUTTON_TYPE_NONE
;
1274 i
+= MENU_ITEMS_PANE_LENGTH
;
1278 /* Create a new item within current pane. */
1279 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1282 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1283 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1284 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1285 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1286 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1287 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1288 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1290 if (STRINGP (item_name
))
1292 if (unicode_append_menu
)
1293 item_name
= ENCODE_UTF_8 (item_name
);
1294 else if (STRING_MULTIBYTE (item_name
))
1295 item_name
= ENCODE_SYSTEM (item_name
);
1297 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1300 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1302 descrip
= ENCODE_SYSTEM (descrip
);
1303 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1306 wv
= xmalloc_widget_value ();
1310 save_wv
->contents
= wv
;
1312 wv
->lname
= item_name
;
1313 if (!NILP (descrip
))
1316 /* The EMACS_INT cast avoids a warning. There's no problem
1317 as long as pointers have enough bits to hold small integers. */
1318 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1319 wv
->enabled
= !NILP (enable
);
1322 wv
->button_type
= BUTTON_TYPE_NONE
;
1323 else if (EQ (type
, QCradio
))
1324 wv
->button_type
= BUTTON_TYPE_RADIO
;
1325 else if (EQ (type
, QCtoggle
))
1326 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1330 wv
->selected
= !NILP (selected
);
1331 if (!STRINGP (help
))
1338 i
+= MENU_ITEMS_ITEM_LENGTH
;
1342 /* If we have just one "menu item"
1343 that was originally a button, return it by itself. */
1344 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1346 wv
= first_wv
->contents
;
1347 free_widget_value (first_wv
);
1355 /* Walk through the widget_value tree starting at FIRST_WV and update
1356 the char * pointers from the corresponding lisp values.
1357 We do this after building the whole tree, since GC may happen while the
1358 tree is constructed, and small strings are relocated. So we must wait
1359 until no GC can happen before storing pointers into lisp values. */
1361 update_submenu_strings (first_wv
)
1362 widget_value
*first_wv
;
1366 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1368 if (wv
->lname
&& ! NILP (wv
->lname
))
1370 wv
->name
= SDATA (wv
->lname
);
1372 /* Ignore the @ that means "separate pane".
1373 This is a kludge, but this isn't worth more time. */
1374 if (wv
->value
== (char *)1)
1376 if (wv
->name
[0] == '@')
1382 if (wv
->lkey
&& ! NILP (wv
->lkey
))
1383 wv
->key
= SDATA (wv
->lkey
);
1386 update_submenu_strings (wv
->contents
);
1391 /* Set the contents of the menubar widgets of frame F.
1392 The argument FIRST_TIME is currently ignored;
1393 it is set the first time this is called, from initialize_frame_menubar. */
1396 set_frame_menubar (f
, first_time
, deep_p
)
1401 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1403 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1405 int *submenu_start
, *submenu_end
;
1406 int *submenu_top_level_items
, *submenu_n_panes
;
1408 /* We must not change the menubar when actually in use. */
1409 if (f
->output_data
.w32
->menubar_active
)
1412 XSETFRAME (Vmenu_updating_frame
, f
);
1414 if (! menubar_widget
)
1416 else if (pending_menu_activation
&& !deep_p
)
1421 /* Make a widget-value tree representing the entire menu trees. */
1423 struct buffer
*prev
= current_buffer
;
1425 int specpdl_count
= SPECPDL_INDEX ();
1426 int previous_menu_items_used
= f
->menu_bar_items_used
;
1427 Lisp_Object
*previous_items
1428 = (Lisp_Object
*) alloca (previous_menu_items_used
1429 * sizeof (Lisp_Object
));
1431 /* If we are making a new widget, its contents are empty,
1432 do always reinitialize them. */
1433 if (! menubar_widget
)
1434 previous_menu_items_used
= 0;
1436 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1437 specbind (Qinhibit_quit
, Qt
);
1438 /* Don't let the debugger step into this code
1439 because it is not reentrant. */
1440 specbind (Qdebug_on_next_call
, Qnil
);
1442 record_unwind_save_match_data ();
1444 if (NILP (Voverriding_local_map_menu_flag
))
1446 specbind (Qoverriding_terminal_local_map
, Qnil
);
1447 specbind (Qoverriding_local_map
, Qnil
);
1450 set_buffer_internal_1 (XBUFFER (buffer
));
1452 /* Run the Lucid hook. */
1453 safe_run_hooks (Qactivate_menubar_hook
);
1454 /* If it has changed current-menubar from previous value,
1455 really recompute the menubar from the value. */
1456 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1457 call0 (Qrecompute_lucid_menubar
);
1458 safe_run_hooks (Qmenu_bar_update_hook
);
1459 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1461 items
= FRAME_MENU_BAR_ITEMS (f
);
1463 /* Save the frame's previous menu bar contents data. */
1464 if (previous_menu_items_used
)
1465 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1466 previous_menu_items_used
* sizeof (Lisp_Object
));
1468 /* Fill in menu_items with the current menu bar contents.
1469 This can evaluate Lisp code. */
1470 menu_items
= f
->menu_bar_vector
;
1471 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1472 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1473 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1474 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1475 submenu_top_level_items
1476 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1478 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1480 Lisp_Object key
, string
, maps
;
1484 key
= AREF (items
, i
);
1485 string
= AREF (items
, i
+ 1);
1486 maps
= AREF (items
, i
+ 2);
1490 submenu_start
[i
] = menu_items_used
;
1492 menu_items_n_panes
= 0;
1493 submenu_top_level_items
[i
]
1494 = parse_single_submenu (key
, string
, maps
);
1495 submenu_n_panes
[i
] = menu_items_n_panes
;
1497 submenu_end
[i
] = menu_items_used
;
1500 finish_menu_items ();
1502 /* Convert menu_items into widget_value trees
1503 to display the menu. This cannot evaluate Lisp code. */
1505 wv
= xmalloc_widget_value ();
1506 wv
->name
= "menubar";
1509 wv
->button_type
= BUTTON_TYPE_NONE
;
1513 for (i
= 0; i
< last_i
; i
+= 4)
1515 menu_items_n_panes
= submenu_n_panes
[i
];
1516 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1517 submenu_top_level_items
[i
]);
1521 first_wv
->contents
= wv
;
1522 /* Don't set wv->name here; GC during the loop might relocate it. */
1524 wv
->button_type
= BUTTON_TYPE_NONE
;
1528 set_buffer_internal_1 (prev
);
1529 unbind_to (specpdl_count
, Qnil
);
1531 /* If there has been no change in the Lisp-level contents
1532 of the menu bar, skip redisplaying it. Just exit. */
1534 for (i
= 0; i
< previous_menu_items_used
; i
++)
1535 if (menu_items_used
== i
1536 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1538 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1540 free_menubar_widget_value_tree (first_wv
);
1546 /* Now GC cannot happen during the lifetime of the widget_value,
1547 so it's safe to store data from a Lisp_String, as long as
1548 local copies are made when the actual menu is created.
1549 Windows takes care of this for normal string items, but
1550 not for owner-drawn items or additional item-info. */
1551 wv
= first_wv
->contents
;
1552 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1555 string
= AREF (items
, i
+ 1);
1558 wv
->name
= (char *) SDATA (string
);
1559 update_submenu_strings (wv
->contents
);
1563 f
->menu_bar_vector
= menu_items
;
1564 f
->menu_bar_items_used
= menu_items_used
;
1569 /* Make a widget-value tree containing
1570 just the top level menu bar strings. */
1572 wv
= xmalloc_widget_value ();
1573 wv
->name
= "menubar";
1576 wv
->button_type
= BUTTON_TYPE_NONE
;
1580 items
= FRAME_MENU_BAR_ITEMS (f
);
1581 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1585 string
= AREF (items
, i
+ 1);
1589 wv
= xmalloc_widget_value ();
1590 wv
->name
= (char *) SDATA (string
);
1593 wv
->button_type
= BUTTON_TYPE_NONE
;
1595 /* This prevents lwlib from assuming this
1596 menu item is really supposed to be empty. */
1597 /* The EMACS_INT cast avoids a warning.
1598 This value just has to be different from small integers. */
1599 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1604 first_wv
->contents
= wv
;
1608 /* Forget what we thought we knew about what is in the
1609 detailed contents of the menu bar menus.
1610 Changing the top level always destroys the contents. */
1611 f
->menu_bar_items_used
= 0;
1614 /* Create or update the menu bar widget. */
1620 /* Empty current menubar, rather than creating a fresh one. */
1621 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1626 menubar_widget
= CreateMenu ();
1628 fill_in_menu (menubar_widget
, first_wv
->contents
);
1630 free_menubar_widget_value_tree (first_wv
);
1633 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1635 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1636 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1637 /* Causes flicker when menu bar is updated
1638 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1640 /* Force the window size to be recomputed so that the frame's text
1641 area remains the same, if menubar has just been created. */
1642 if (old_widget
== NULL
)
1643 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1649 /* Called from Fx_create_frame to create the initial menubar of a frame
1650 before it is mapped, so that the window is mapped with the menubar already
1651 there instead of us tacking it on later and thrashing the window after it
1655 initialize_frame_menubar (f
)
1658 /* This function is called before the first chance to redisplay
1659 the frame. It has to be, so the frame will have the right size. */
1660 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1661 set_frame_menubar (f
, 1, 1);
1664 /* Get rid of the menu bar of frame F, and free its storage.
1665 This is used when deleting a frame, and when turning off the menu bar. */
1668 free_frame_menubar (f
)
1674 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1675 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1676 f
->output_data
.w32
->menubar_widget
= NULL
;
1684 /* w32_menu_show actually displays a menu using the panes and items in
1685 menu_items and returns the value selected from it; we assume input
1686 is blocked by the caller. */
1688 /* F is the frame the menu is for.
1689 X and Y are the frame-relative specified position,
1690 relative to the inside upper left corner of the frame F.
1691 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1692 KEYMAPS is 1 if this menu was specified with keymaps;
1693 in that case, we return a list containing the chosen item's value
1694 and perhaps also the pane's prefix.
1695 TITLE is the specified menu title.
1696 ERROR is a place to store an error message string in case of failure.
1697 (We return nil on failure, but the value doesn't actually matter.) */
1700 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1710 int menu_item_selection
;
1713 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1714 widget_value
**submenu_stack
1715 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1716 Lisp_Object
*subprefix_stack
1717 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1718 int submenu_depth
= 0;
1723 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1725 *error
= "Empty menu";
1729 /* Create a tree of widget_value objects
1730 representing the panes and their items. */
1731 wv
= xmalloc_widget_value ();
1735 wv
->button_type
= BUTTON_TYPE_NONE
;
1740 /* Loop over all panes and items, filling in the tree. */
1742 while (i
< menu_items_used
)
1744 if (EQ (AREF (menu_items
, i
), Qnil
))
1746 submenu_stack
[submenu_depth
++] = save_wv
;
1752 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1755 save_wv
= submenu_stack
[--submenu_depth
];
1759 else if (EQ (AREF (menu_items
, i
), Qt
)
1760 && submenu_depth
!= 0)
1761 i
+= MENU_ITEMS_PANE_LENGTH
;
1762 /* Ignore a nil in the item list.
1763 It's meaningful only for dialog boxes. */
1764 else if (EQ (AREF (menu_items
, i
), Qquote
))
1766 else if (EQ (AREF (menu_items
, i
), Qt
))
1768 /* Create a new pane. */
1769 Lisp_Object pane_name
, prefix
;
1771 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1772 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1774 if (STRINGP (pane_name
))
1776 if (unicode_append_menu
)
1777 pane_name
= ENCODE_UTF_8 (pane_name
);
1778 else if (STRING_MULTIBYTE (pane_name
))
1779 pane_name
= ENCODE_SYSTEM (pane_name
);
1781 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1784 pane_string
= (NILP (pane_name
)
1785 ? "" : (char *) SDATA (pane_name
));
1786 /* If there is just one top-level pane, put all its items directly
1787 under the top-level menu. */
1788 if (menu_items_n_panes
== 1)
1791 /* If the pane has a meaningful name,
1792 make the pane a top-level menu item
1793 with its items as a submenu beneath it. */
1794 if (!keymaps
&& strcmp (pane_string
, ""))
1796 wv
= xmalloc_widget_value ();
1800 first_wv
->contents
= wv
;
1801 wv
->name
= pane_string
;
1802 if (keymaps
&& !NILP (prefix
))
1806 wv
->button_type
= BUTTON_TYPE_NONE
;
1811 else if (first_pane
)
1817 i
+= MENU_ITEMS_PANE_LENGTH
;
1821 /* Create a new item within current pane. */
1822 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1824 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1825 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1826 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1827 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1828 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1829 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1830 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1832 if (STRINGP (item_name
))
1834 if (unicode_append_menu
)
1835 item_name
= ENCODE_UTF_8 (item_name
);
1836 else if (STRING_MULTIBYTE (item_name
))
1837 item_name
= ENCODE_SYSTEM (item_name
);
1839 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1842 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1844 descrip
= ENCODE_SYSTEM (descrip
);
1845 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1848 wv
= xmalloc_widget_value ();
1852 save_wv
->contents
= wv
;
1853 wv
->name
= (char *) SDATA (item_name
);
1854 if (!NILP (descrip
))
1855 wv
->key
= (char *) SDATA (descrip
);
1857 /* Use the contents index as call_data, since we are
1858 restricted to 16-bits. */
1859 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1860 wv
->enabled
= !NILP (enable
);
1863 wv
->button_type
= BUTTON_TYPE_NONE
;
1864 else if (EQ (type
, QCtoggle
))
1865 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1866 else if (EQ (type
, QCradio
))
1867 wv
->button_type
= BUTTON_TYPE_RADIO
;
1871 wv
->selected
= !NILP (selected
);
1872 if (!STRINGP (help
))
1879 i
+= MENU_ITEMS_ITEM_LENGTH
;
1883 /* Deal with the title, if it is non-nil. */
1886 widget_value
*wv_title
= xmalloc_widget_value ();
1887 widget_value
*wv_sep
= xmalloc_widget_value ();
1889 /* Maybe replace this separator with a bitmap or owner-draw item
1890 so that it looks better. Having two separators looks odd. */
1891 wv_sep
->name
= "--";
1892 wv_sep
->next
= first_wv
->contents
;
1893 wv_sep
->help
= Qnil
;
1895 if (unicode_append_menu
)
1896 title
= ENCODE_UTF_8 (title
);
1897 else if (STRING_MULTIBYTE (title
))
1898 title
= ENCODE_SYSTEM (title
);
1900 wv_title
->name
= (char *) SDATA (title
);
1901 wv_title
->enabled
= TRUE
;
1902 wv_title
->title
= TRUE
;
1903 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1904 wv_title
->help
= Qnil
;
1905 wv_title
->next
= wv_sep
;
1906 first_wv
->contents
= wv_title
;
1909 /* Actually create the menu. */
1910 current_popup_menu
= menu
= CreatePopupMenu ();
1911 fill_in_menu (menu
, first_wv
->contents
);
1913 /* Adjust coordinates to be root-window-relative. */
1916 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1918 /* No selection has been chosen yet. */
1919 menu_item_selection
= 0;
1921 /* Display the menu. */
1922 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1923 WM_EMACS_TRACKPOPUPMENU
,
1924 (WPARAM
)menu
, (LPARAM
)&pos
);
1926 /* Clean up extraneous mouse events which might have been generated
1928 discard_mouse_events ();
1930 /* Free the widget_value objects we used to specify the contents. */
1931 free_menubar_widget_value_tree (first_wv
);
1935 /* Free the owner-drawn and help-echo menu strings. */
1936 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1937 f
->output_data
.w32
->menubar_active
= 0;
1939 /* Find the selected item, and its pane, to return
1940 the proper value. */
1941 if (menu_item_selection
!= 0)
1943 Lisp_Object prefix
, entry
;
1945 prefix
= entry
= Qnil
;
1947 while (i
< menu_items_used
)
1949 if (EQ (AREF (menu_items
, i
), Qnil
))
1951 subprefix_stack
[submenu_depth
++] = prefix
;
1955 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1957 prefix
= subprefix_stack
[--submenu_depth
];
1960 else if (EQ (AREF (menu_items
, i
), Qt
))
1962 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1963 i
+= MENU_ITEMS_PANE_LENGTH
;
1965 /* Ignore a nil in the item list.
1966 It's meaningful only for dialog boxes. */
1967 else if (EQ (AREF (menu_items
, i
), Qquote
))
1971 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1972 if (menu_item_selection
== i
)
1978 entry
= Fcons (entry
, Qnil
);
1980 entry
= Fcons (prefix
, entry
);
1981 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1982 if (!NILP (subprefix_stack
[j
]))
1983 entry
= Fcons (subprefix_stack
[j
], entry
);
1987 i
+= MENU_ITEMS_ITEM_LENGTH
;
1991 else if (!for_click
)
1992 /* Make "Cancel" equivalent to C-g. */
1993 Fsignal (Qquit
, Qnil
);
2000 static char * button_names
[] = {
2001 "button1", "button2", "button3", "button4", "button5",
2002 "button6", "button7", "button8", "button9", "button10" };
2005 w32_dialog_show (f
, keymaps
, title
, header
, error
)
2008 Lisp_Object title
, header
;
2011 int i
, nb_buttons
=0;
2012 char dialog_name
[6];
2013 int menu_item_selection
;
2015 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2017 /* Number of elements seen so far, before boundary. */
2019 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2020 int boundary_seen
= 0;
2024 if (menu_items_n_panes
> 1)
2026 *error
= "Multiple panes in dialog box";
2030 /* Create a tree of widget_value objects
2031 representing the text label and buttons. */
2033 Lisp_Object pane_name
, prefix
;
2035 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
2036 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
2037 pane_string
= (NILP (pane_name
)
2038 ? "" : (char *) SDATA (pane_name
));
2039 prev_wv
= xmalloc_widget_value ();
2040 prev_wv
->value
= pane_string
;
2041 if (keymaps
&& !NILP (prefix
))
2043 prev_wv
->enabled
= 1;
2044 prev_wv
->name
= "message";
2045 prev_wv
->help
= Qnil
;
2048 /* Loop over all panes and items, filling in the tree. */
2049 i
= MENU_ITEMS_PANE_LENGTH
;
2050 while (i
< menu_items_used
)
2053 /* Create a new item within current pane. */
2054 Lisp_Object item_name
, enable
, descrip
, help
;
2056 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2057 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2058 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2059 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2061 if (NILP (item_name
))
2063 free_menubar_widget_value_tree (first_wv
);
2064 *error
= "Submenu in dialog items";
2067 if (EQ (item_name
, Qquote
))
2069 /* This is the boundary between left-side elts
2070 and right-side elts. Stop incrementing right_count. */
2075 if (nb_buttons
>= 9)
2077 free_menubar_widget_value_tree (first_wv
);
2078 *error
= "Too many dialog items";
2082 wv
= xmalloc_widget_value ();
2084 wv
->name
= (char *) button_names
[nb_buttons
];
2085 if (!NILP (descrip
))
2086 wv
->key
= (char *) SDATA (descrip
);
2087 wv
->value
= (char *) SDATA (item_name
);
2088 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2089 wv
->enabled
= !NILP (enable
);
2093 if (! boundary_seen
)
2097 i
+= MENU_ITEMS_ITEM_LENGTH
;
2100 /* If the boundary was not specified,
2101 by default put half on the left and half on the right. */
2102 if (! boundary_seen
)
2103 left_count
= nb_buttons
- nb_buttons
/ 2;
2105 wv
= xmalloc_widget_value ();
2106 wv
->name
= dialog_name
;
2109 /* Frame title: 'Q' = Question, 'I' = Information.
2110 Can also have 'E' = Error if, one day, we want
2111 a popup for errors. */
2113 dialog_name
[0] = 'Q';
2115 dialog_name
[0] = 'I';
2117 /* Dialog boxes use a really stupid name encoding
2118 which specifies how many buttons to use
2119 and how many buttons are on the right. */
2120 dialog_name
[1] = '0' + nb_buttons
;
2121 dialog_name
[2] = 'B';
2122 dialog_name
[3] = 'R';
2123 /* Number of buttons to put on the right. */
2124 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2126 wv
->contents
= first_wv
;
2130 /* Actually create the dialog. */
2131 dialog_id
= widget_id_tick
++;
2132 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2133 f
->output_data
.w32
->widget
, 1, 0,
2134 dialog_selection_callback
, 0);
2135 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2137 /* Free the widget_value objects we used to specify the contents. */
2138 free_menubar_widget_value_tree (first_wv
);
2140 /* No selection has been chosen yet. */
2141 menu_item_selection
= 0;
2143 /* Display the menu. */
2144 lw_pop_up_all_widgets (dialog_id
);
2146 /* Process events that apply to the menu. */
2147 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2149 lw_destroy_all_widgets (dialog_id
);
2151 /* Find the selected item, and its pane, to return
2152 the proper value. */
2153 if (menu_item_selection
!= 0)
2159 while (i
< menu_items_used
)
2163 if (EQ (AREF (menu_items
, i
), Qt
))
2165 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2166 i
+= MENU_ITEMS_PANE_LENGTH
;
2170 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2171 if (menu_item_selection
== i
)
2175 entry
= Fcons (entry
, Qnil
);
2177 entry
= Fcons (prefix
, entry
);
2181 i
+= MENU_ITEMS_ITEM_LENGTH
;
2186 /* Make "Cancel" equivalent to C-g. */
2187 Fsignal (Qquit
, Qnil
);
2191 #endif /* HAVE_DIALOGS */
2194 /* Is this item a separator? */
2196 name_is_separator (name
)
2201 /* Check if name string consists of only dashes ('-'). */
2202 while (*name
== '-') name
++;
2203 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2204 or "--deep-shadow". We don't implement them yet, se we just treat
2205 them like normal separators. */
2206 return (*name
== '\0' || start
+ 2 == name
);
2210 /* Indicate boundary between left and right. */
2212 add_left_right_boundary (HMENU menu
)
2214 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2217 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2219 utf8to16 (unsigned char * src
, int len
, WCHAR
* dest
)
2226 *dest
= (WCHAR
) *src
;
2227 dest
++; src
++; len
--;
2229 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2230 else if (*src
< 0xC0)
2234 /* 2 char UTF-8 sequence. */
2235 else if (*src
< 0xE0)
2237 *dest
= (WCHAR
) (((*src
& 0x1f) << 6)
2238 | (*(src
+ 1) & 0x3f));
2239 src
+= 2; len
-= 2; dest
++;
2241 else if (*src
< 0xF0)
2243 *dest
= (WCHAR
) (((*src
& 0x0f) << 12)
2244 | ((*(src
+ 1) & 0x3f) << 6)
2245 | (*(src
+ 2) & 0x3f));
2246 src
+= 3; len
-= 3; dest
++;
2248 else /* Not encodable. Insert Unicode Substitution char. */
2250 *dest
= (WCHAR
) 0xfffd;
2251 src
++; len
--; dest
++;
2258 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2261 char *out_string
, *p
, *q
;
2263 size_t nlen
, orig_len
;
2265 if (name_is_separator (wv
->name
))
2267 fuFlags
= MF_SEPARATOR
;
2273 fuFlags
= MF_STRING
;
2275 fuFlags
= MF_STRING
| MF_GRAYED
;
2277 if (wv
->key
!= NULL
)
2279 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2280 strcpy (out_string
, wv
->name
);
2281 strcat (out_string
, "\t");
2282 strcat (out_string
, wv
->key
);
2285 out_string
= wv
->name
;
2287 /* Quote any special characters within the menu item's text and
2289 nlen
= orig_len
= strlen (out_string
);
2290 if (unicode_append_menu
)
2292 /* With UTF-8, & cannot be part of a multibyte character. */
2293 for (p
= out_string
; *p
; p
++)
2301 /* If encoded with the system codepage, use multibyte string
2302 functions in case of multibyte characters that contain '&'. */
2303 for (p
= out_string
; *p
; p
= _mbsinc (p
))
2305 if (_mbsnextc (p
) == '&')
2310 if (nlen
> orig_len
)
2313 out_string
= alloca (nlen
+ 1);
2317 if (unicode_append_menu
)
2325 if (_mbsnextc (p
) == '&')
2340 else if (wv
->title
|| wv
->call_data
== 0)
2342 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2343 we can't deallocate the memory otherwise. */
2344 if (get_menu_item_info
)
2346 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2347 strcpy (out_string
, wv
->name
);
2349 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2351 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2354 fuFlags
= MF_DISABLED
;
2357 /* Draw radio buttons and tickboxes. */
2358 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2359 wv
->button_type
== BUTTON_TYPE_RADIO
))
2360 fuFlags
|= MF_CHECKED
;
2362 fuFlags
|= MF_UNCHECKED
;
2365 if (unicode_append_menu
&& out_string
)
2367 /* Convert out_string from UTF-8 to UTF-16-LE. */
2368 int utf8_len
= strlen (out_string
);
2369 WCHAR
* utf16_string
;
2370 if (fuFlags
& MF_OWNERDRAW
)
2371 utf16_string
= local_alloc ((utf8_len
+ 1) * sizeof (WCHAR
));
2373 utf16_string
= alloca ((utf8_len
+ 1) * sizeof (WCHAR
));
2375 utf8to16 (out_string
, utf8_len
, utf16_string
);
2376 return_value
= unicode_append_menu (menu
, fuFlags
,
2377 item
!= NULL
? (UINT
) item
2378 : (UINT
) wv
->call_data
,
2382 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2383 apparently does exist at least in some cases and appears to be
2384 stubbed out to do nothing. out_string is UTF-8, but since
2385 our standard menus are in English and this is only going to
2386 happen the first time a menu is used, the encoding is
2387 of minor importance compared with menus not working at all. */
2389 AppendMenu (menu
, fuFlags
,
2390 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2392 /* Don't use unicode menus in future. */
2393 unicode_append_menu
= NULL
;
2396 if (unicode_append_menu
&& (fuFlags
& MF_OWNERDRAW
))
2397 local_free (out_string
);
2404 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2408 /* This must be done after the menu item is created. */
2409 if (!wv
->title
&& wv
->call_data
!= 0)
2411 if (set_menu_item_info
)
2414 bzero (&info
, sizeof (info
));
2415 info
.cbSize
= sizeof (info
);
2416 info
.fMask
= MIIM_DATA
;
2418 /* Set help string for menu item. Leave it as a Lisp_Object
2419 until it is ready to be displayed, since GC can happen while
2420 menus are active. */
2421 if (!NILP (wv
->help
))
2422 #ifdef USE_LISP_UNION_TYPE
2423 info
.dwItemData
= (DWORD
) (wv
->help
).i
;
2425 info
.dwItemData
= (DWORD
) (wv
->help
);
2427 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2429 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2430 RADIO items, but is not available on NT 3.51 and earlier. */
2431 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2432 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2433 info
.dwTypeData
= out_string
;
2434 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2437 set_menu_item_info (menu
,
2438 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2442 return return_value
;
2445 /* Construct native Windows menu(bar) based on widget_value tree. */
2447 fill_in_menu (HMENU menu
, widget_value
*wv
)
2449 int items_added
= 0;
2451 for ( ; wv
!= NULL
; wv
= wv
->next
)
2455 HMENU sub_menu
= CreatePopupMenu ();
2457 if (sub_menu
== NULL
)
2460 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2461 !add_menu_item (menu
, wv
, sub_menu
))
2463 DestroyMenu (sub_menu
);
2469 if (!add_menu_item (menu
, wv
, NULL
))
2476 /* Display help string for currently pointed to menu item. Not
2477 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2480 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2482 if (get_menu_item_info
)
2484 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2485 Lisp_Object frame
, help
;
2487 /* No help echo on owner-draw menu items, or when the keyboard is used
2488 to navigate the menus, since tooltips are distracting if they pop
2490 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
2491 || !(flags
& MF_MOUSESELECT
))
2497 bzero (&info
, sizeof (info
));
2498 info
.cbSize
= sizeof (info
);
2499 info
.fMask
= MIIM_DATA
;
2500 get_menu_item_info (menu
, item
, FALSE
, &info
);
2502 #ifdef USE_LISP_UNION_TYPE
2503 help
= info
.dwItemData
? (Lisp_Object
) ((EMACS_INT
) info
.dwItemData
)
2506 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2510 /* Store the help echo in the keyboard buffer as the X toolkit
2511 version does, rather than directly showing it. This seems to
2512 solve the GC problems that were present when we based the
2513 Windows code on the non-toolkit version. */
2516 XSETFRAME (frame
, f
);
2517 kbd_buffer_store_help_event (frame
, help
);
2520 /* X version has a loop through frames here, which doesn't
2521 appear to do anything, unless it has some side effect. */
2522 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2526 /* Free memory used by owner-drawn strings. */
2528 w32_free_submenu_strings (menu
)
2531 int i
, num
= GetMenuItemCount (menu
);
2532 for (i
= 0; i
< num
; i
++)
2535 bzero (&info
, sizeof (info
));
2536 info
.cbSize
= sizeof (info
);
2537 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2539 get_menu_item_info (menu
, i
, TRUE
, &info
);
2541 /* Owner-drawn names are held in dwItemData. */
2542 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2545 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2547 local_free (info
.dwItemData
);
2550 /* Recurse down submenus. */
2552 w32_free_submenu_strings (info
.hSubMenu
);
2557 w32_free_menu_strings (hwnd
)
2560 HMENU menu
= current_popup_menu
;
2562 if (get_menu_item_info
)
2564 /* If there is no popup menu active, free the strings from the frame's
2567 menu
= GetMenu (hwnd
);
2570 w32_free_submenu_strings (menu
);
2573 current_popup_menu
= NULL
;
2576 #endif /* HAVE_MENUS */
2578 /* The following is used by delayed window autoselection. */
2580 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2581 doc
: /* Return t if a menu or popup dialog is active on selected frame. */)
2586 f
= SELECTED_FRAME ();
2587 return (f
->output_data
.w32
->menubar_active
> 0) ? Qt
: Qnil
;
2590 #endif /* HAVE_MENUS */
2593 void syms_of_w32menu ()
2595 globals_of_w32menu ();
2596 staticpro (&menu_items
);
2599 current_popup_menu
= NULL
;
2601 DEFSYM (Qdebug_on_next_call
, "debug-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) */