1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2002, 2003,
3 2004, 2005, 2006 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 2, 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. */
27 #include "termhooks.h"
32 #include "blockinput.h"
37 /* This may include sys/types.h, and that somehow loses
38 if this is not done before the other system files. */
41 /* Load sys/types.h if not already loaded.
42 In some systems loading it twice is suicidal. */
44 #include <sys/types.h>
47 #include "dispextern.h"
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
54 typedef void * XtPointer
;
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
66 typedef struct _widget_value
71 /* value (meaning depend on widget type) */
73 /* keyboard equivalent. no implications for XtTranslations */
76 /* Help string or nil if none.
77 GC finds this string through the frame's menu_bar_vector
78 or through menu_items. */
82 /* true if selected */
84 /* The type of a button. */
85 enum button_type button_type
;
86 /* true if menu title */
89 /* true if was edited (maintained by get_value) */
91 /* true if has changed (maintained by lw library) */
93 /* true if this widget itself has changed,
94 but not counting the other widgets found in the `next' field. */
95 change_type this_one_change
;
97 /* Contents of the sub-widgets, also selected slot for checkbox */
98 struct _widget_value
* contents
;
99 /* data passed to callback */
101 /* next one in the list */
102 struct _widget_value
* next
;
104 /* slot for the toolkit dependent part. Always initialize to NULL. */
106 /* tell us if we should free the toolkit data slot when freeing the
107 widget_value itself. */
108 Boolean free_toolkit_data
;
110 /* we resource the widget_value structures; this points to the next
111 one on the free list if this one has been deallocated.
113 struct _widget_value
*free_list
;
117 /* Local memory management */
118 #define local_heap (GetProcessHeap ())
119 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
120 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
122 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
123 #define free_widget_value(wv) (local_free ((wv)))
125 /******************************************************************/
132 static HMENU current_popup_menu
;
134 void syms_of_w32menu ();
135 void globals_of_w32menu ();
137 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
141 IN OUT LPMENUITEMINFOA
);
142 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
146 IN LPCMENUITEMINFOA
);
148 GetMenuItemInfoA_Proc get_menu_item_info
= NULL
;
149 SetMenuItemInfoA_Proc set_menu_item_info
= NULL
;
150 AppendMenuW_Proc unicode_append_menu
= NULL
;
152 Lisp_Object Qdebug_on_next_call
;
154 extern Lisp_Object Vmenu_updating_frame
;
156 extern Lisp_Object Qmenu_bar
;
158 extern Lisp_Object QCtoggle
, QCradio
;
160 extern Lisp_Object Voverriding_local_map
;
161 extern Lisp_Object Voverriding_local_map_menu_flag
;
163 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
165 extern Lisp_Object Qmenu_bar_update_hook
;
167 void set_frame_menubar ();
169 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
170 Lisp_Object
, Lisp_Object
, Lisp_Object
,
171 Lisp_Object
, Lisp_Object
));
173 static Lisp_Object
w32_dialog_show ();
175 static Lisp_Object
w32_menu_show ();
177 static void keymap_panes ();
178 static void single_keymap_panes ();
179 static void single_menu_item ();
180 static void list_of_panes ();
181 static void list_of_items ();
182 void w32_free_menu_strings (HWND
);
184 /* This holds a Lisp vector that holds the results of decoding
185 the keymaps or alist-of-alists that specify a menu.
187 It describes the panes and items within the panes.
189 Each pane is described by 3 elements in the vector:
190 t, the pane name, the pane's prefix key.
191 Then follow the pane's items, with 5 elements per item:
192 the item string, the enable flag, the item's value,
193 the definition, and the equivalent keyboard key's description string.
195 In some cases, multiple levels of menus may be described.
196 A single vector slot containing nil indicates the start of a submenu.
197 A single vector slot containing lambda indicates the end of a submenu.
198 The submenu follows a menu item which is the way to reach the submenu.
200 A single vector slot containing quote indicates that the
201 following items should appear on the right of a dialog box.
203 Using a Lisp vector to hold this information while we decode it
204 takes care of protecting all the data from GC. */
206 #define MENU_ITEMS_PANE_NAME 1
207 #define MENU_ITEMS_PANE_PREFIX 2
208 #define MENU_ITEMS_PANE_LENGTH 3
212 MENU_ITEMS_ITEM_NAME
= 0,
213 MENU_ITEMS_ITEM_ENABLE
,
214 MENU_ITEMS_ITEM_VALUE
,
215 MENU_ITEMS_ITEM_EQUIV_KEY
,
216 MENU_ITEMS_ITEM_DEFINITION
,
217 MENU_ITEMS_ITEM_TYPE
,
218 MENU_ITEMS_ITEM_SELECTED
,
219 MENU_ITEMS_ITEM_HELP
,
220 MENU_ITEMS_ITEM_LENGTH
223 static Lisp_Object menu_items
;
225 /* Number of slots currently allocated in menu_items. */
226 static int menu_items_allocated
;
228 /* This is the index in menu_items of the first empty slot. */
229 static int menu_items_used
;
231 /* The number of panes currently recorded in menu_items,
232 excluding those within submenus. */
233 static int menu_items_n_panes
;
235 /* Current depth within submenus. */
236 static int menu_items_submenu_depth
;
238 static int next_menubar_widget_id
;
240 /* This is set nonzero after the user activates the menu bar, and set
241 to zero again after the menu bars are redisplayed by prepare_menu_bar.
242 While it is nonzero, all calls to set_frame_menubar go deep.
244 I don't understand why this is needed, but it does seem to be
245 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
247 int pending_menu_activation
;
250 /* Return the frame whose ->output_data.w32->menubar_widget equals
253 static struct frame
*
254 menubar_id_to_frame (id
)
257 Lisp_Object tail
, frame
;
260 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
263 if (!GC_FRAMEP (frame
))
266 if (!FRAME_WINDOW_P (f
))
268 if (f
->output_data
.w32
->menubar_widget
== id
)
274 /* Initialize the menu_items structure if we haven't already done so.
275 Also mark it as currently empty. */
280 if (NILP (menu_items
))
282 menu_items_allocated
= 60;
283 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
287 menu_items_n_panes
= 0;
288 menu_items_submenu_depth
= 0;
291 /* Call at the end of generating the data in menu_items.
292 This fills in the number of items in the last pane. */
299 /* Call when finished using the data for the current menu
303 discard_menu_items ()
305 /* Free the structure if it is especially large.
306 Otherwise, hold on to it, to save time. */
307 if (menu_items_allocated
> 200)
310 menu_items_allocated
= 0;
314 /* Make the menu_items vector twice as large. */
320 int old_size
= menu_items_allocated
;
323 menu_items_allocated
*= 2;
324 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
325 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
326 old_size
* sizeof (Lisp_Object
));
329 /* Begin a submenu. */
332 push_submenu_start ()
334 if (menu_items_used
+ 1 > menu_items_allocated
)
337 ASET (menu_items
, menu_items_used
++, Qnil
);
338 menu_items_submenu_depth
++;
346 if (menu_items_used
+ 1 > menu_items_allocated
)
349 ASET (menu_items
, menu_items_used
++, Qlambda
);
350 menu_items_submenu_depth
--;
353 /* Indicate boundary between left and right. */
356 push_left_right_boundary ()
358 if (menu_items_used
+ 1 > menu_items_allocated
)
361 ASET (menu_items
, menu_items_used
++, Qquote
);
364 /* Start a new menu pane in menu_items.
365 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
368 push_menu_pane (name
, prefix_vec
)
369 Lisp_Object name
, prefix_vec
;
371 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
374 if (menu_items_submenu_depth
== 0)
375 menu_items_n_panes
++;
376 ASET (menu_items
, menu_items_used
++, Qt
);
377 ASET (menu_items
, menu_items_used
++, name
);
378 ASET (menu_items
, menu_items_used
++, prefix_vec
);
381 /* Push one menu item into the current pane. NAME is the string to
382 display. ENABLE if non-nil means this item can be selected. KEY
383 is the key generated by choosing this item, or nil if this item
384 doesn't really have a definition. DEF is the definition of this
385 item. EQUIV is the textual description of the keyboard equivalent
386 for this item (or nil if none). TYPE is the type of this menu
387 item, one of nil, `toggle' or `radio'. */
390 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
391 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
393 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
396 ASET (menu_items
, menu_items_used
++, name
);
397 ASET (menu_items
, menu_items_used
++, enable
);
398 ASET (menu_items
, menu_items_used
++, key
);
399 ASET (menu_items
, menu_items_used
++, equiv
);
400 ASET (menu_items
, menu_items_used
++, def
);
401 ASET (menu_items
, menu_items_used
++, type
);
402 ASET (menu_items
, menu_items_used
++, selected
);
403 ASET (menu_items
, menu_items_used
++, help
);
406 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
407 and generate menu panes for them in menu_items.
408 If NOTREAL is nonzero,
409 don't bother really computing whether an item is enabled. */
412 keymap_panes (keymaps
, nmaps
, notreal
)
413 Lisp_Object
*keymaps
;
421 /* Loop over the given keymaps, making a pane for each map.
422 But don't make a pane that is empty--ignore that map instead.
423 P is the number of panes we have made so far. */
424 for (mapno
= 0; mapno
< nmaps
; mapno
++)
425 single_keymap_panes (keymaps
[mapno
],
426 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
428 finish_menu_items ();
431 /* This is a recursive subroutine of keymap_panes.
432 It handles one keymap, KEYMAP.
433 The other arguments are passed along
434 or point to local variables of the previous function.
435 If NOTREAL is nonzero, only check for equivalent key bindings, don't
436 evaluate expressions in menu items and don't make any menu.
438 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
441 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
443 Lisp_Object pane_name
;
448 Lisp_Object pending_maps
= Qnil
;
449 Lisp_Object tail
, item
;
450 struct gcpro gcpro1
, gcpro2
;
455 push_menu_pane (pane_name
, prefix
);
457 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
459 GCPRO2 (keymap
, pending_maps
);
460 /* Look at each key binding, and if it is a menu item add it
464 single_menu_item (XCAR (item
), XCDR (item
),
465 &pending_maps
, notreal
, maxdepth
);
466 else if (VECTORP (item
))
468 /* Loop over the char values represented in the vector. */
469 int len
= ASIZE (item
);
471 for (c
= 0; c
< len
; c
++)
473 Lisp_Object character
;
474 XSETFASTINT (character
, c
);
475 single_menu_item (character
, AREF (item
, c
),
476 &pending_maps
, notreal
, maxdepth
);
482 /* Process now any submenus which want to be panes at this level. */
483 while (!NILP (pending_maps
))
485 Lisp_Object elt
, eltcdr
, string
;
486 elt
= Fcar (pending_maps
);
488 string
= XCAR (eltcdr
);
489 /* We no longer discard the @ from the beginning of the string here.
490 Instead, we do this in w32_menu_show. */
491 single_keymap_panes (Fcar (elt
), string
,
492 XCDR (eltcdr
), notreal
, maxdepth
- 1);
493 pending_maps
= Fcdr (pending_maps
);
497 /* This is a subroutine of single_keymap_panes that handles one
499 KEY is a key in a keymap and ITEM is its binding.
500 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
502 If NOTREAL is nonzero, only check for equivalent key bindings, don't
503 evaluate expressions in menu items and don't make any menu.
504 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
507 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
508 Lisp_Object key
, item
;
509 Lisp_Object
*pending_maps_ptr
;
510 int maxdepth
, notreal
;
512 Lisp_Object map
, item_string
, enabled
;
513 struct gcpro gcpro1
, gcpro2
;
516 /* Parse the menu item and leave the result in item_properties. */
518 res
= parse_menu_item (item
, notreal
, 0);
521 return; /* Not a menu item. */
523 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
527 /* We don't want to make a menu, just traverse the keymaps to
528 precompute equivalent key bindings. */
530 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
534 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
535 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
537 if (!NILP (map
) && SREF (item_string
, 0) == '@')
540 /* An enabled separate pane. Remember this to handle it later. */
541 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
546 push_menu_item (item_string
, enabled
, key
,
547 AREF (item_properties
, ITEM_PROPERTY_DEF
),
548 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
549 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
550 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
551 AREF (item_properties
, ITEM_PROPERTY_HELP
));
553 /* Display a submenu using the toolkit. */
554 if (! (NILP (map
) || NILP (enabled
)))
556 push_submenu_start ();
557 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
562 /* Push all the panes and items of a menu described by the
563 alist-of-alists MENU.
564 This handles old-fashioned calls to x-popup-menu. */
574 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
576 Lisp_Object elt
, pane_name
, pane_data
;
578 pane_name
= Fcar (elt
);
579 CHECK_STRING (pane_name
);
580 push_menu_pane (pane_name
, Qnil
);
581 pane_data
= Fcdr (elt
);
582 CHECK_CONS (pane_data
);
583 list_of_items (pane_data
);
586 finish_menu_items ();
589 /* Push the items in a single pane defined by the alist PANE. */
595 Lisp_Object tail
, item
, item1
;
597 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
601 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
602 else if (NILP (item
))
603 push_left_right_boundary ();
608 CHECK_STRING (item1
);
609 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
614 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
615 doc
: /* Pop up a deck-of-cards menu and return user's selection.
616 POSITION is a position specification. This is either a mouse button
617 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
618 are positions in pixels from the top left corner of WINDOW's frame
619 \(WINDOW may be a frame object instead of a window). This controls the
620 position of the center of the first line in the first pane of the
621 menu, not the top left of the menu as a whole. If POSITION is t, it
622 means to use the current mouse position.
624 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
625 The menu items come from key bindings that have a menu string as well as
626 a definition; actually, the \"definition\" in such a key binding looks like
627 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
628 the keymap as a top-level element.
630 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
631 Otherwise, REAL-DEFINITION should be a valid key binding definition.
633 You can also use a list of keymaps as MENU. Then each keymap makes a
634 separate pane. When MENU is a keymap or a list of keymaps, the return
635 value is a list of events.
637 Alternatively, you can specify a menu of multiple panes with a list of
638 the form (TITLE PANE1 PANE2...), where each pane is a list of
639 form (TITLE ITEM1 ITEM2...).
640 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
641 appear as an item--that makes a nonselectable line in the menu.
642 With this form of menu, the return value is VALUE from the chosen item.
644 If POSITION is nil, don't display the menu at all, just precalculate the
645 cached information about equivalent key sequences. */)
647 Lisp_Object position
, menu
;
649 Lisp_Object keymap
, tem
;
650 int xpos
= 0, ypos
= 0;
653 Lisp_Object selection
;
655 Lisp_Object x
, y
, window
;
661 if (! NILP (position
))
665 /* Decode the first argument: find the window and the coordinates. */
666 if (EQ (position
, Qt
)
667 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
668 || EQ (XCAR (position
), Qtool_bar
))))
670 /* Use the mouse's current position. */
671 FRAME_PTR new_f
= SELECTED_FRAME ();
672 Lisp_Object bar_window
;
673 enum scroll_bar_part part
;
676 if (mouse_position_hook
)
677 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
678 &part
, &x
, &y
, &time
);
680 XSETFRAME (window
, new_f
);
683 window
= selected_window
;
690 tem
= Fcar (position
);
693 window
= Fcar (Fcdr (position
));
695 y
= Fcar (Fcdr (tem
));
700 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
701 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
702 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
711 /* Decode where to put the menu. */
719 else if (WINDOWP (window
))
721 CHECK_LIVE_WINDOW (window
);
722 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
724 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
725 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
728 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
729 but I don't want to make one now. */
730 CHECK_WINDOW (window
);
735 XSETFRAME (Vmenu_updating_frame
, f
);
738 Vmenu_updating_frame
= Qnil
;
739 #endif /* HAVE_MENUS */
744 /* Decode the menu items from what was specified. */
746 keymap
= get_keymap (menu
, 0, 0);
749 /* We were given a keymap. Extract menu info from the keymap. */
752 /* Extract the detailed info to make one pane. */
753 keymap_panes (&menu
, 1, NILP (position
));
755 /* Search for a string appearing directly as an element of the keymap.
756 That string is the title of the menu. */
757 prompt
= Fkeymap_prompt (keymap
);
758 if (NILP (title
) && !NILP (prompt
))
761 /* Make that be the pane title of the first pane. */
762 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
763 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
767 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
769 /* We were given a list of keymaps. */
770 int nmaps
= XFASTINT (Flength (menu
));
772 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
777 /* The first keymap that has a prompt string
778 supplies the menu title. */
779 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
783 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
785 prompt
= Fkeymap_prompt (keymap
);
786 if (NILP (title
) && !NILP (prompt
))
790 /* Extract the detailed info to make one pane. */
791 keymap_panes (maps
, nmaps
, NILP (position
));
793 /* Make the title be the pane title of the first pane. */
794 if (!NILP (title
) && menu_items_n_panes
>= 0)
795 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
801 /* We were given an old-fashioned menu. */
803 CHECK_STRING (title
);
805 list_of_panes (Fcdr (menu
));
812 discard_menu_items ();
818 /* If resources from a previous popup menu still exist, does nothing
819 until the `menu_free_timer' has freed them (see w32fns.c). This
820 can occur if you press ESC or click outside a menu without selecting
823 if (current_popup_menu
)
825 discard_menu_items ();
830 /* Display them in a menu. */
833 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
834 keymaps
, title
, &error_name
);
837 discard_menu_items ();
838 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
840 #endif /* HAVE_MENUS */
844 if (error_name
) error (error_name
);
850 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
851 doc
: /* Pop up a dialog box and return user's selection.
852 POSITION specifies which frame to use.
853 This is normally a mouse button event or a window or frame.
854 If POSITION is t, it means to use the frame the mouse is on.
855 The dialog box appears in the middle of the specified frame.
857 CONTENTS specifies the alternatives to display in the dialog box.
858 It is a list of the form (TITLE ITEM1 ITEM2...).
859 Each ITEM is a cons cell (STRING . VALUE).
860 The return value is VALUE from the chosen item.
862 An ITEM may also be just a string--that makes a nonselectable item.
863 An ITEM may also be nil--that means to put all preceding items
864 on the left of the dialog box and all following items on the right.
865 \(By default, approximately half appear on each side.)
867 If HEADER is non-nil, the frame title for the box is "Information",
868 otherwise it is "Question". */)
869 (position
, contents
, header
)
870 Lisp_Object position
, contents
, header
;
877 /* Decode the first argument: find the window or frame to use. */
878 if (EQ (position
, Qt
)
879 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
880 || EQ (XCAR (position
), Qtool_bar
))))
882 #if 0 /* Using the frame the mouse is on may not be right. */
883 /* Use the mouse's current position. */
884 FRAME_PTR new_f
= SELECTED_FRAME ();
885 Lisp_Object bar_window
;
886 enum scroll_bar_part part
;
890 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
893 XSETFRAME (window
, new_f
);
895 window
= selected_window
;
897 window
= selected_window
;
899 else if (CONSP (position
))
902 tem
= Fcar (position
);
904 window
= Fcar (Fcdr (position
));
907 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
908 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
911 else if (WINDOWP (position
) || FRAMEP (position
))
916 /* Decode where to put the menu. */
920 else if (WINDOWP (window
))
922 CHECK_LIVE_WINDOW (window
);
923 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
926 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
927 but I don't want to make one now. */
928 CHECK_WINDOW (window
);
931 /* Display a menu with these alternatives
932 in the middle of frame F. */
934 Lisp_Object x
, y
, frame
, newpos
;
935 XSETFRAME (frame
, f
);
936 XSETINT (x
, x_pixel_width (f
) / 2);
937 XSETINT (y
, x_pixel_height (f
) / 2);
938 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
940 return Fx_popup_menu (newpos
,
941 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
943 #else /* HAVE_DIALOGS */
947 Lisp_Object selection
;
949 /* Decode the dialog items from what was specified. */
950 title
= Fcar (contents
);
951 CHECK_STRING (title
);
953 list_of_panes (Fcons (contents
, Qnil
));
955 /* Display them in a dialog box. */
957 selection
= w32_dialog_show (f
, 0, title
, header
, &error_name
);
960 discard_menu_items ();
962 if (error_name
) error (error_name
);
965 #endif /* HAVE_DIALOGS */
968 /* Activate the menu bar of frame F.
969 This is called from keyboard.c when it gets the
970 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
972 To activate the menu bar, we signal to the input thread that it can
973 return from the WM_INITMENU message, allowing the normal Windows
974 processing of the menus.
976 But first we recompute the menu bar contents (the whole tree).
978 This way we can safely execute Lisp code. */
981 x_activate_menubar (f
)
984 set_frame_menubar (f
, 0, 1);
986 /* Lock out further menubar changes while active. */
987 f
->output_data
.w32
->menubar_active
= 1;
989 /* Signal input thread to return from WM_INITMENU. */
990 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
993 /* This callback is called from the menu bar pulldown menu
994 when the user makes a selection.
995 Figure out what the user chose
996 and put the appropriate events into the keyboard buffer. */
999 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1001 Lisp_Object prefix
, entry
;
1003 Lisp_Object
*subprefix_stack
;
1004 int submenu_depth
= 0;
1010 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1011 vector
= f
->menu_bar_vector
;
1014 while (i
< f
->menu_bar_items_used
)
1016 if (EQ (AREF (vector
, i
), Qnil
))
1018 subprefix_stack
[submenu_depth
++] = prefix
;
1022 else if (EQ (AREF (vector
, i
), Qlambda
))
1024 prefix
= subprefix_stack
[--submenu_depth
];
1027 else if (EQ (AREF (vector
, i
), Qt
))
1029 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1030 i
+= MENU_ITEMS_PANE_LENGTH
;
1034 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1035 /* The EMACS_INT cast avoids a warning. There's no problem
1036 as long as pointers have enough bits to hold small integers. */
1037 if ((int) (EMACS_INT
) client_data
== i
)
1040 struct input_event buf
;
1044 XSETFRAME (frame
, f
);
1045 buf
.kind
= MENU_BAR_EVENT
;
1046 buf
.frame_or_window
= frame
;
1048 kbd_buffer_store_event (&buf
);
1050 for (j
= 0; j
< submenu_depth
; j
++)
1051 if (!NILP (subprefix_stack
[j
]))
1053 buf
.kind
= MENU_BAR_EVENT
;
1054 buf
.frame_or_window
= frame
;
1055 buf
.arg
= subprefix_stack
[j
];
1056 kbd_buffer_store_event (&buf
);
1061 buf
.kind
= MENU_BAR_EVENT
;
1062 buf
.frame_or_window
= frame
;
1064 kbd_buffer_store_event (&buf
);
1067 buf
.kind
= MENU_BAR_EVENT
;
1068 buf
.frame_or_window
= frame
;
1070 kbd_buffer_store_event (&buf
);
1072 /* Free memory used by owner-drawn and help-echo strings. */
1073 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1074 f
->output_data
.w32
->menu_command_in_progress
= 0;
1075 f
->output_data
.w32
->menubar_active
= 0;
1078 i
+= MENU_ITEMS_ITEM_LENGTH
;
1081 /* Free memory used by owner-drawn and help-echo strings. */
1082 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1083 f
->output_data
.w32
->menu_command_in_progress
= 0;
1084 f
->output_data
.w32
->menubar_active
= 0;
1087 /* Allocate a widget_value, blocking input. */
1090 xmalloc_widget_value ()
1092 widget_value
*value
;
1095 value
= malloc_widget_value ();
1101 /* This recursively calls free_widget_value on the tree of widgets.
1102 It must free all data that was malloc'ed for these widget_values.
1103 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1104 must be left alone. */
1107 free_menubar_widget_value_tree (wv
)
1112 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1114 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1116 free_menubar_widget_value_tree (wv
->contents
);
1117 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1121 free_menubar_widget_value_tree (wv
->next
);
1122 wv
->next
= (widget_value
*) 0xDEADBEEF;
1125 free_widget_value (wv
);
1129 /* Set up data i menu_items for a menu bar item
1130 whose event type is ITEM_KEY (with string ITEM_NAME)
1131 and whose contents come from the list of keymaps MAPS. */
1134 parse_single_submenu (item_key
, item_name
, maps
)
1135 Lisp_Object item_key
, item_name
, maps
;
1139 Lisp_Object
*mapvec
;
1141 int top_level_items
= 0;
1143 length
= Flength (maps
);
1144 len
= XINT (length
);
1146 /* Convert the list MAPS into a vector MAPVEC. */
1147 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1148 for (i
= 0; i
< len
; i
++)
1150 mapvec
[i
] = Fcar (maps
);
1154 /* Loop over the given keymaps, making a pane for each map.
1155 But don't make a pane that is empty--ignore that map instead. */
1156 for (i
= 0; i
< len
; i
++)
1158 if (SYMBOLP (mapvec
[i
])
1159 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1161 /* Here we have a command at top level in the menu bar
1162 as opposed to a submenu. */
1163 top_level_items
= 1;
1164 push_menu_pane (Qnil
, Qnil
);
1165 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1166 Qnil
, Qnil
, Qnil
, Qnil
);
1171 prompt
= Fkeymap_prompt (mapvec
[i
]);
1172 single_keymap_panes (mapvec
[i
],
1173 !NILP (prompt
) ? prompt
: item_name
,
1178 return top_level_items
;
1182 /* Create a tree of widget_value objects
1183 representing the panes and items
1184 in menu_items starting at index START, up to index END. */
1186 static widget_value
*
1187 digest_single_submenu (start
, end
, top_level_items
)
1188 int start
, end
, top_level_items
;
1190 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1192 int submenu_depth
= 0;
1193 widget_value
**submenu_stack
;
1196 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1197 wv
= xmalloc_widget_value ();
1201 wv
->button_type
= BUTTON_TYPE_NONE
;
1207 /* Loop over all panes and items made by the preceding call
1208 to parse_single_submenu and construct a tree of widget_value objects.
1209 Ignore the panes and items used by previous calls to
1210 digest_single_submenu, even though those are also in menu_items. */
1214 if (EQ (AREF (menu_items
, i
), Qnil
))
1216 submenu_stack
[submenu_depth
++] = save_wv
;
1221 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1224 save_wv
= submenu_stack
[--submenu_depth
];
1227 else if (EQ (AREF (menu_items
, i
), Qt
)
1228 && submenu_depth
!= 0)
1229 i
+= MENU_ITEMS_PANE_LENGTH
;
1230 /* Ignore a nil in the item list.
1231 It's meaningful only for dialog boxes. */
1232 else if (EQ (AREF (menu_items
, i
), Qquote
))
1234 else if (EQ (AREF (menu_items
, i
), Qt
))
1236 /* Create a new pane. */
1237 Lisp_Object pane_name
, prefix
;
1240 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1241 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1243 if (STRINGP (pane_name
))
1245 if (unicode_append_menu
)
1246 /* Encode as UTF-8 for now. */
1247 pane_name
= ENCODE_UTF_8 (pane_name
);
1248 else if (STRING_MULTIBYTE (pane_name
))
1249 pane_name
= ENCODE_SYSTEM (pane_name
);
1251 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1254 pane_string
= (NILP (pane_name
)
1255 ? "" : (char *) SDATA (pane_name
));
1256 /* If there is just one top-level pane, put all its items directly
1257 under the top-level menu. */
1258 if (menu_items_n_panes
== 1)
1261 /* If the pane has a meaningful name,
1262 make the pane a top-level menu item
1263 with its items as a submenu beneath it. */
1264 if (strcmp (pane_string
, ""))
1266 wv
= xmalloc_widget_value ();
1270 first_wv
->contents
= wv
;
1271 wv
->lname
= pane_name
;
1272 /* Set value to 1 so update_submenu_strings can handle '@' */
1273 wv
->value
= (char *) 1;
1275 wv
->button_type
= BUTTON_TYPE_NONE
;
1280 i
+= MENU_ITEMS_PANE_LENGTH
;
1284 /* Create a new item within current pane. */
1285 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1288 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1289 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1290 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1291 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1292 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1293 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1294 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1296 if (STRINGP (item_name
))
1298 if (unicode_append_menu
)
1299 item_name
= ENCODE_UTF_8 (item_name
);
1300 else if (STRING_MULTIBYTE (item_name
))
1301 item_name
= ENCODE_SYSTEM (item_name
);
1303 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1306 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1308 descrip
= ENCODE_SYSTEM (descrip
);
1309 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1312 wv
= xmalloc_widget_value ();
1316 save_wv
->contents
= wv
;
1318 wv
->lname
= item_name
;
1319 if (!NILP (descrip
))
1322 /* The EMACS_INT cast avoids a warning. There's no problem
1323 as long as pointers have enough bits to hold small integers. */
1324 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1325 wv
->enabled
= !NILP (enable
);
1328 wv
->button_type
= BUTTON_TYPE_NONE
;
1329 else if (EQ (type
, QCradio
))
1330 wv
->button_type
= BUTTON_TYPE_RADIO
;
1331 else if (EQ (type
, QCtoggle
))
1332 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1336 wv
->selected
= !NILP (selected
);
1337 if (!STRINGP (help
))
1344 i
+= MENU_ITEMS_ITEM_LENGTH
;
1348 /* If we have just one "menu item"
1349 that was originally a button, return it by itself. */
1350 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1352 wv
= first_wv
->contents
;
1353 free_widget_value (first_wv
);
1361 /* Walk through the widget_value tree starting at FIRST_WV and update
1362 the char * pointers from the corresponding lisp values.
1363 We do this after building the whole tree, since GC may happen while the
1364 tree is constructed, and small strings are relocated. So we must wait
1365 until no GC can happen before storing pointers into lisp values. */
1367 update_submenu_strings (first_wv
)
1368 widget_value
*first_wv
;
1372 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1374 if (wv
->lname
&& ! NILP (wv
->lname
))
1376 wv
->name
= SDATA (wv
->lname
);
1378 /* Ignore the @ that means "separate pane".
1379 This is a kludge, but this isn't worth more time. */
1380 if (wv
->value
== (char *)1)
1382 if (wv
->name
[0] == '@')
1388 if (wv
->lkey
&& ! NILP (wv
->lkey
))
1389 wv
->key
= SDATA (wv
->lkey
);
1392 update_submenu_strings (wv
->contents
);
1397 /* Set the contents of the menubar widgets of frame F.
1398 The argument FIRST_TIME is currently ignored;
1399 it is set the first time this is called, from initialize_frame_menubar. */
1402 set_frame_menubar (f
, first_time
, deep_p
)
1407 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1409 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1411 int *submenu_start
, *submenu_end
;
1412 int *submenu_top_level_items
, *submenu_n_panes
;
1414 /* We must not change the menubar when actually in use. */
1415 if (f
->output_data
.w32
->menubar_active
)
1418 XSETFRAME (Vmenu_updating_frame
, f
);
1420 if (! menubar_widget
)
1422 else if (pending_menu_activation
&& !deep_p
)
1427 /* Make a widget-value tree representing the entire menu trees. */
1429 struct buffer
*prev
= current_buffer
;
1431 int specpdl_count
= SPECPDL_INDEX ();
1432 int previous_menu_items_used
= f
->menu_bar_items_used
;
1433 Lisp_Object
*previous_items
1434 = (Lisp_Object
*) alloca (previous_menu_items_used
1435 * sizeof (Lisp_Object
));
1437 /* If we are making a new widget, its contents are empty,
1438 do always reinitialize them. */
1439 if (! menubar_widget
)
1440 previous_menu_items_used
= 0;
1442 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1443 specbind (Qinhibit_quit
, Qt
);
1444 /* Don't let the debugger step into this code
1445 because it is not reentrant. */
1446 specbind (Qdebug_on_next_call
, Qnil
);
1448 record_unwind_save_match_data ();
1450 if (NILP (Voverriding_local_map_menu_flag
))
1452 specbind (Qoverriding_terminal_local_map
, Qnil
);
1453 specbind (Qoverriding_local_map
, Qnil
);
1456 set_buffer_internal_1 (XBUFFER (buffer
));
1458 /* Run the Lucid hook. */
1459 safe_run_hooks (Qactivate_menubar_hook
);
1460 /* If it has changed current-menubar from previous value,
1461 really recompute the menubar from the value. */
1462 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1463 call0 (Qrecompute_lucid_menubar
);
1464 safe_run_hooks (Qmenu_bar_update_hook
);
1465 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1467 items
= FRAME_MENU_BAR_ITEMS (f
);
1469 /* Save the frame's previous menu bar contents data. */
1470 if (previous_menu_items_used
)
1471 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1472 previous_menu_items_used
* sizeof (Lisp_Object
));
1474 /* Fill in menu_items with the current menu bar contents.
1475 This can evaluate Lisp code. */
1476 menu_items
= f
->menu_bar_vector
;
1477 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1478 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1479 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1480 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1481 submenu_top_level_items
1482 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1484 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1486 Lisp_Object key
, string
, maps
;
1490 key
= AREF (items
, i
);
1491 string
= AREF (items
, i
+ 1);
1492 maps
= AREF (items
, i
+ 2);
1496 submenu_start
[i
] = menu_items_used
;
1498 menu_items_n_panes
= 0;
1499 submenu_top_level_items
[i
]
1500 = parse_single_submenu (key
, string
, maps
);
1501 submenu_n_panes
[i
] = menu_items_n_panes
;
1503 submenu_end
[i
] = menu_items_used
;
1506 finish_menu_items ();
1508 /* Convert menu_items into widget_value trees
1509 to display the menu. This cannot evaluate Lisp code. */
1511 wv
= xmalloc_widget_value ();
1512 wv
->name
= "menubar";
1515 wv
->button_type
= BUTTON_TYPE_NONE
;
1519 for (i
= 0; i
< last_i
; i
+= 4)
1521 menu_items_n_panes
= submenu_n_panes
[i
];
1522 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1523 submenu_top_level_items
[i
]);
1527 first_wv
->contents
= wv
;
1528 /* Don't set wv->name here; GC during the loop might relocate it. */
1530 wv
->button_type
= BUTTON_TYPE_NONE
;
1534 set_buffer_internal_1 (prev
);
1535 unbind_to (specpdl_count
, Qnil
);
1537 /* If there has been no change in the Lisp-level contents
1538 of the menu bar, skip redisplaying it. Just exit. */
1540 for (i
= 0; i
< previous_menu_items_used
; i
++)
1541 if (menu_items_used
== i
1542 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1544 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1546 free_menubar_widget_value_tree (first_wv
);
1552 /* Now GC cannot happen during the lifetime of the widget_value,
1553 so it's safe to store data from a Lisp_String, as long as
1554 local copies are made when the actual menu is created.
1555 Windows takes care of this for normal string items, but
1556 not for owner-drawn items or additional item-info. */
1557 wv
= first_wv
->contents
;
1558 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1561 string
= AREF (items
, i
+ 1);
1564 wv
->name
= (char *) SDATA (string
);
1565 update_submenu_strings (wv
->contents
);
1569 f
->menu_bar_vector
= menu_items
;
1570 f
->menu_bar_items_used
= menu_items_used
;
1575 /* Make a widget-value tree containing
1576 just the top level menu bar strings. */
1578 wv
= xmalloc_widget_value ();
1579 wv
->name
= "menubar";
1582 wv
->button_type
= BUTTON_TYPE_NONE
;
1586 items
= FRAME_MENU_BAR_ITEMS (f
);
1587 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1591 string
= AREF (items
, i
+ 1);
1595 wv
= xmalloc_widget_value ();
1596 wv
->name
= (char *) SDATA (string
);
1599 wv
->button_type
= BUTTON_TYPE_NONE
;
1601 /* This prevents lwlib from assuming this
1602 menu item is really supposed to be empty. */
1603 /* The EMACS_INT cast avoids a warning.
1604 This value just has to be different from small integers. */
1605 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1610 first_wv
->contents
= wv
;
1614 /* Forget what we thought we knew about what is in the
1615 detailed contents of the menu bar menus.
1616 Changing the top level always destroys the contents. */
1617 f
->menu_bar_items_used
= 0;
1620 /* Create or update the menu bar widget. */
1626 /* Empty current menubar, rather than creating a fresh one. */
1627 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1632 menubar_widget
= CreateMenu ();
1634 fill_in_menu (menubar_widget
, first_wv
->contents
);
1636 free_menubar_widget_value_tree (first_wv
);
1639 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1641 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1642 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1643 /* Causes flicker when menu bar is updated
1644 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1646 /* Force the window size to be recomputed so that the frame's text
1647 area remains the same, if menubar has just been created. */
1648 if (old_widget
== NULL
)
1649 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1655 /* Called from Fx_create_frame to create the initial menubar of a frame
1656 before it is mapped, so that the window is mapped with the menubar already
1657 there instead of us tacking it on later and thrashing the window after it
1661 initialize_frame_menubar (f
)
1664 /* This function is called before the first chance to redisplay
1665 the frame. It has to be, so the frame will have the right size. */
1666 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1667 set_frame_menubar (f
, 1, 1);
1670 /* Get rid of the menu bar of frame F, and free its storage.
1671 This is used when deleting a frame, and when turning off the menu bar. */
1674 free_frame_menubar (f
)
1680 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1681 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1682 f
->output_data
.w32
->menubar_widget
= NULL
;
1690 /* w32_menu_show actually displays a menu using the panes and items in
1691 menu_items and returns the value selected from it; we assume input
1692 is blocked by the caller. */
1694 /* F is the frame the menu is for.
1695 X and Y are the frame-relative specified position,
1696 relative to the inside upper left corner of the frame F.
1697 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1698 KEYMAPS is 1 if this menu was specified with keymaps;
1699 in that case, we return a list containing the chosen item's value
1700 and perhaps also the pane's prefix.
1701 TITLE is the specified menu title.
1702 ERROR is a place to store an error message string in case of failure.
1703 (We return nil on failure, but the value doesn't actually matter.) */
1706 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1716 int menu_item_selection
;
1719 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1720 widget_value
**submenu_stack
1721 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1722 Lisp_Object
*subprefix_stack
1723 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1724 int submenu_depth
= 0;
1729 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1731 *error
= "Empty menu";
1735 /* Create a tree of widget_value objects
1736 representing the panes and their items. */
1737 wv
= xmalloc_widget_value ();
1741 wv
->button_type
= BUTTON_TYPE_NONE
;
1746 /* Loop over all panes and items, filling in the tree. */
1748 while (i
< menu_items_used
)
1750 if (EQ (AREF (menu_items
, i
), Qnil
))
1752 submenu_stack
[submenu_depth
++] = save_wv
;
1758 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1761 save_wv
= submenu_stack
[--submenu_depth
];
1765 else if (EQ (AREF (menu_items
, i
), Qt
)
1766 && submenu_depth
!= 0)
1767 i
+= MENU_ITEMS_PANE_LENGTH
;
1768 /* Ignore a nil in the item list.
1769 It's meaningful only for dialog boxes. */
1770 else if (EQ (AREF (menu_items
, i
), Qquote
))
1772 else if (EQ (AREF (menu_items
, i
), Qt
))
1774 /* Create a new pane. */
1775 Lisp_Object pane_name
, prefix
;
1777 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1778 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1780 if (STRINGP (pane_name
))
1782 if (unicode_append_menu
)
1783 pane_name
= ENCODE_UTF_8 (pane_name
);
1784 else if (STRING_MULTIBYTE (pane_name
))
1785 pane_name
= ENCODE_SYSTEM (pane_name
);
1787 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1790 pane_string
= (NILP (pane_name
)
1791 ? "" : (char *) SDATA (pane_name
));
1792 /* If there is just one top-level pane, put all its items directly
1793 under the top-level menu. */
1794 if (menu_items_n_panes
== 1)
1797 /* If the pane has a meaningful name,
1798 make the pane a top-level menu item
1799 with its items as a submenu beneath it. */
1800 if (!keymaps
&& strcmp (pane_string
, ""))
1802 wv
= xmalloc_widget_value ();
1806 first_wv
->contents
= wv
;
1807 wv
->name
= pane_string
;
1808 if (keymaps
&& !NILP (prefix
))
1812 wv
->button_type
= BUTTON_TYPE_NONE
;
1817 else if (first_pane
)
1823 i
+= MENU_ITEMS_PANE_LENGTH
;
1827 /* Create a new item within current pane. */
1828 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1830 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1831 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1832 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1833 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1834 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1835 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1836 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1838 if (STRINGP (item_name
))
1840 if (unicode_append_menu
)
1841 item_name
= ENCODE_UTF_8 (item_name
);
1842 else if (STRING_MULTIBYTE (item_name
))
1843 item_name
= ENCODE_SYSTEM (item_name
);
1845 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1848 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1850 descrip
= ENCODE_SYSTEM (descrip
);
1851 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1854 wv
= xmalloc_widget_value ();
1858 save_wv
->contents
= wv
;
1859 wv
->name
= (char *) SDATA (item_name
);
1860 if (!NILP (descrip
))
1861 wv
->key
= (char *) SDATA (descrip
);
1863 /* Use the contents index as call_data, since we are
1864 restricted to 16-bits. */
1865 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1866 wv
->enabled
= !NILP (enable
);
1869 wv
->button_type
= BUTTON_TYPE_NONE
;
1870 else if (EQ (type
, QCtoggle
))
1871 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1872 else if (EQ (type
, QCradio
))
1873 wv
->button_type
= BUTTON_TYPE_RADIO
;
1877 wv
->selected
= !NILP (selected
);
1878 if (!STRINGP (help
))
1885 i
+= MENU_ITEMS_ITEM_LENGTH
;
1889 /* Deal with the title, if it is non-nil. */
1892 widget_value
*wv_title
= xmalloc_widget_value ();
1893 widget_value
*wv_sep
= xmalloc_widget_value ();
1895 /* Maybe replace this separator with a bitmap or owner-draw item
1896 so that it looks better. Having two separators looks odd. */
1897 wv_sep
->name
= "--";
1898 wv_sep
->next
= first_wv
->contents
;
1899 wv_sep
->help
= Qnil
;
1901 if (unicode_append_menu
)
1902 title
= ENCODE_UTF_8 (title
);
1903 else if (STRING_MULTIBYTE (title
))
1904 title
= ENCODE_SYSTEM (title
);
1906 wv_title
->name
= (char *) SDATA (title
);
1907 wv_title
->enabled
= TRUE
;
1908 wv_title
->title
= TRUE
;
1909 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1910 wv_title
->help
= Qnil
;
1911 wv_title
->next
= wv_sep
;
1912 first_wv
->contents
= wv_title
;
1915 /* Actually create the menu. */
1916 current_popup_menu
= menu
= CreatePopupMenu ();
1917 fill_in_menu (menu
, first_wv
->contents
);
1919 /* Adjust coordinates to be root-window-relative. */
1922 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1924 /* No selection has been chosen yet. */
1925 menu_item_selection
= 0;
1927 /* Display the menu. */
1928 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1929 WM_EMACS_TRACKPOPUPMENU
,
1930 (WPARAM
)menu
, (LPARAM
)&pos
);
1932 /* Clean up extraneous mouse events which might have been generated
1934 discard_mouse_events ();
1936 /* Free the widget_value objects we used to specify the contents. */
1937 free_menubar_widget_value_tree (first_wv
);
1941 /* Find the selected item, and its pane, to return
1942 the proper value. */
1943 if (menu_item_selection
!= 0)
1945 Lisp_Object prefix
, entry
;
1947 prefix
= entry
= Qnil
;
1949 while (i
< menu_items_used
)
1951 if (EQ (AREF (menu_items
, i
), Qnil
))
1953 subprefix_stack
[submenu_depth
++] = prefix
;
1957 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1959 prefix
= subprefix_stack
[--submenu_depth
];
1962 else if (EQ (AREF (menu_items
, i
), Qt
))
1964 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1965 i
+= MENU_ITEMS_PANE_LENGTH
;
1967 /* Ignore a nil in the item list.
1968 It's meaningful only for dialog boxes. */
1969 else if (EQ (AREF (menu_items
, i
), Qquote
))
1973 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1974 if (menu_item_selection
== i
)
1980 entry
= Fcons (entry
, Qnil
);
1982 entry
= Fcons (prefix
, entry
);
1983 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1984 if (!NILP (subprefix_stack
[j
]))
1985 entry
= Fcons (subprefix_stack
[j
], entry
);
1989 i
+= MENU_ITEMS_ITEM_LENGTH
;
1993 else if (!for_click
)
1994 /* Make "Cancel" equivalent to C-g. */
1995 Fsignal (Qquit
, Qnil
);
2002 static char * button_names
[] = {
2003 "button1", "button2", "button3", "button4", "button5",
2004 "button6", "button7", "button8", "button9", "button10" };
2007 w32_dialog_show (f
, keymaps
, title
, header
, error
)
2010 Lisp_Object title
, header
;
2013 int i
, nb_buttons
=0;
2014 char dialog_name
[6];
2015 int menu_item_selection
;
2017 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2019 /* Number of elements seen so far, before boundary. */
2021 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2022 int boundary_seen
= 0;
2026 if (menu_items_n_panes
> 1)
2028 *error
= "Multiple panes in dialog box";
2032 /* Create a tree of widget_value objects
2033 representing the text label and buttons. */
2035 Lisp_Object pane_name
, prefix
;
2037 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
2038 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
2039 pane_string
= (NILP (pane_name
)
2040 ? "" : (char *) SDATA (pane_name
));
2041 prev_wv
= xmalloc_widget_value ();
2042 prev_wv
->value
= pane_string
;
2043 if (keymaps
&& !NILP (prefix
))
2045 prev_wv
->enabled
= 1;
2046 prev_wv
->name
= "message";
2047 prev_wv
->help
= Qnil
;
2050 /* Loop over all panes and items, filling in the tree. */
2051 i
= MENU_ITEMS_PANE_LENGTH
;
2052 while (i
< menu_items_used
)
2055 /* Create a new item within current pane. */
2056 Lisp_Object item_name
, enable
, descrip
, help
;
2058 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2059 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2060 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2061 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2063 if (NILP (item_name
))
2065 free_menubar_widget_value_tree (first_wv
);
2066 *error
= "Submenu in dialog items";
2069 if (EQ (item_name
, Qquote
))
2071 /* This is the boundary between left-side elts
2072 and right-side elts. Stop incrementing right_count. */
2077 if (nb_buttons
>= 9)
2079 free_menubar_widget_value_tree (first_wv
);
2080 *error
= "Too many dialog items";
2084 wv
= xmalloc_widget_value ();
2086 wv
->name
= (char *) button_names
[nb_buttons
];
2087 if (!NILP (descrip
))
2088 wv
->key
= (char *) SDATA (descrip
);
2089 wv
->value
= (char *) SDATA (item_name
);
2090 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2091 wv
->enabled
= !NILP (enable
);
2095 if (! boundary_seen
)
2099 i
+= MENU_ITEMS_ITEM_LENGTH
;
2102 /* If the boundary was not specified,
2103 by default put half on the left and half on the right. */
2104 if (! boundary_seen
)
2105 left_count
= nb_buttons
- nb_buttons
/ 2;
2107 wv
= xmalloc_widget_value ();
2108 wv
->name
= dialog_name
;
2111 /* Frame title: 'Q' = Question, 'I' = Information.
2112 Can also have 'E' = Error if, one day, we want
2113 a popup for errors. */
2115 dialog_name
[0] = 'Q';
2117 dialog_name
[0] = 'I';
2119 /* Dialog boxes use a really stupid name encoding
2120 which specifies how many buttons to use
2121 and how many buttons are on the right. */
2122 dialog_name
[1] = '0' + nb_buttons
;
2123 dialog_name
[2] = 'B';
2124 dialog_name
[3] = 'R';
2125 /* Number of buttons to put on the right. */
2126 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2128 wv
->contents
= first_wv
;
2132 /* Actually create the dialog. */
2133 dialog_id
= widget_id_tick
++;
2134 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2135 f
->output_data
.w32
->widget
, 1, 0,
2136 dialog_selection_callback
, 0);
2137 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2139 /* Free the widget_value objects we used to specify the contents. */
2140 free_menubar_widget_value_tree (first_wv
);
2142 /* No selection has been chosen yet. */
2143 menu_item_selection
= 0;
2145 /* Display the menu. */
2146 lw_pop_up_all_widgets (dialog_id
);
2148 /* Process events that apply to the menu. */
2149 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2151 lw_destroy_all_widgets (dialog_id
);
2153 /* Find the selected item, and its pane, to return
2154 the proper value. */
2155 if (menu_item_selection
!= 0)
2161 while (i
< menu_items_used
)
2165 if (EQ (AREF (menu_items
, i
), Qt
))
2167 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2168 i
+= MENU_ITEMS_PANE_LENGTH
;
2172 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2173 if (menu_item_selection
== i
)
2177 entry
= Fcons (entry
, Qnil
);
2179 entry
= Fcons (prefix
, entry
);
2183 i
+= MENU_ITEMS_ITEM_LENGTH
;
2188 /* Make "Cancel" equivalent to C-g. */
2189 Fsignal (Qquit
, Qnil
);
2193 #endif /* HAVE_DIALOGS */
2196 /* Is this item a separator? */
2198 name_is_separator (name
)
2203 /* Check if name string consists of only dashes ('-'). */
2204 while (*name
== '-') name
++;
2205 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2206 or "--deep-shadow". We don't implement them yet, se we just treat
2207 them like normal separators. */
2208 return (*name
== '\0' || start
+ 2 == name
);
2212 /* Indicate boundary between left and right. */
2214 add_left_right_boundary (HMENU menu
)
2216 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2219 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2221 utf8to16 (unsigned char * src
, int len
, WCHAR
* dest
)
2228 *dest
= (WCHAR
) *src
;
2229 dest
++; src
++; len
--;
2231 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2232 else if (*src
< 0xC0)
2236 /* 2 char UTF-8 sequence. */
2237 else if (*src
< 0xE0)
2239 *dest
= (WCHAR
) (((*src
& 0x1f) << 6)
2240 | (*(src
+ 1) & 0x3f));
2241 src
+= 2; len
-= 2; dest
++;
2243 else if (*src
< 0xF0)
2245 *dest
= (WCHAR
) (((*src
& 0x0f) << 12)
2246 | ((*(src
+ 1) & 0x3f) << 6)
2247 | (*(src
+ 2) & 0x3f));
2248 src
+= 3; len
-= 3; dest
++;
2250 else /* Not encodable. Insert Unicode Substitution char. */
2252 *dest
= (WCHAR
) 0xfffd;
2253 src
++; len
--; dest
++;
2260 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2266 if (name_is_separator (wv
->name
))
2268 fuFlags
= MF_SEPARATOR
;
2274 fuFlags
= MF_STRING
;
2276 fuFlags
= MF_STRING
| MF_GRAYED
;
2278 if (wv
->key
!= NULL
)
2280 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2281 strcpy (out_string
, wv
->name
);
2282 strcat (out_string
, "\t");
2283 strcat (out_string
, wv
->key
);
2286 out_string
= wv
->name
;
2290 else if (wv
->title
|| wv
->call_data
== 0)
2292 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2293 we can't deallocate the memory otherwise. */
2294 if (get_menu_item_info
)
2296 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2297 strcpy (out_string
, wv
->name
);
2299 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2301 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2304 fuFlags
= MF_DISABLED
;
2307 /* Draw radio buttons and tickboxes. */
2308 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2309 wv
->button_type
== BUTTON_TYPE_RADIO
))
2310 fuFlags
|= MF_CHECKED
;
2312 fuFlags
|= MF_UNCHECKED
;
2315 if (unicode_append_menu
&& out_string
)
2317 /* Convert out_string from UTF-8 to UTF-16-LE. */
2318 int utf8_len
= strlen (out_string
);
2319 WCHAR
* utf16_string
;
2320 if (fuFlags
& MF_OWNERDRAW
)
2321 utf16_string
= local_alloc ((utf8_len
+ 1) * sizeof (WCHAR
));
2323 utf16_string
= alloca ((utf8_len
+ 1) * sizeof (WCHAR
));
2325 utf8to16 (out_string
, utf8_len
, utf16_string
);
2326 return_value
= unicode_append_menu (menu
, fuFlags
,
2327 item
!= NULL
? (UINT
) item
2328 : (UINT
) wv
->call_data
,
2332 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2333 apparently does exist at least in some cases and appears to be
2334 stubbed out to do nothing. out_string is UTF-8, but since
2335 our standard menus are in English and this is only going to
2336 happen the first time a menu is used, the encoding is
2337 of minor importance compared with menus not working at all. */
2339 AppendMenu (menu
, fuFlags
,
2340 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2342 /* Don't use unicode menus in future. */
2343 unicode_append_menu
= NULL
;
2346 if (unicode_append_menu
&& (fuFlags
& MF_OWNERDRAW
))
2347 local_free (out_string
);
2354 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2358 /* This must be done after the menu item is created. */
2359 if (!wv
->title
&& wv
->call_data
!= 0)
2361 if (set_menu_item_info
)
2364 bzero (&info
, sizeof (info
));
2365 info
.cbSize
= sizeof (info
);
2366 info
.fMask
= MIIM_DATA
;
2368 /* Set help string for menu item. Leave it as a Lisp_Object
2369 until it is ready to be displayed, since GC can happen while
2370 menus are active. */
2371 if (!NILP (wv
->help
))
2372 #ifdef USE_LISP_UNION_TYPE
2373 info
.dwItemData
= (DWORD
) (wv
->help
).i
;
2375 info
.dwItemData
= (DWORD
) (wv
->help
);
2377 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2379 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2380 RADIO items, but is not available on NT 3.51 and earlier. */
2381 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2382 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2383 info
.dwTypeData
= out_string
;
2384 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2387 set_menu_item_info (menu
,
2388 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2392 return return_value
;
2395 /* Construct native Windows menu(bar) based on widget_value tree. */
2397 fill_in_menu (HMENU menu
, widget_value
*wv
)
2399 int items_added
= 0;
2401 for ( ; wv
!= NULL
; wv
= wv
->next
)
2405 HMENU sub_menu
= CreatePopupMenu ();
2407 if (sub_menu
== NULL
)
2410 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2411 !add_menu_item (menu
, wv
, sub_menu
))
2413 DestroyMenu (sub_menu
);
2419 if (!add_menu_item (menu
, wv
, NULL
))
2426 /* Display help string for currently pointed to menu item. Not
2427 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2430 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2432 if (get_menu_item_info
)
2434 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2435 Lisp_Object frame
, help
;
2437 /* No help echo on owner-draw menu items, or when the keyboard is used
2438 to navigate the menus, since tooltips are distracting if they pop
2440 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
2441 || !(flags
& MF_MOUSESELECT
))
2447 bzero (&info
, sizeof (info
));
2448 info
.cbSize
= sizeof (info
);
2449 info
.fMask
= MIIM_DATA
;
2450 get_menu_item_info (menu
, item
, FALSE
, &info
);
2452 #ifdef USE_LISP_UNION_TYPE
2453 help
= info
.dwItemData
? (Lisp_Object
) ((EMACS_INT
) info
.dwItemData
)
2456 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2460 /* Store the help echo in the keyboard buffer as the X toolkit
2461 version does, rather than directly showing it. This seems to
2462 solve the GC problems that were present when we based the
2463 Windows code on the non-toolkit version. */
2466 XSETFRAME (frame
, f
);
2467 kbd_buffer_store_help_event (frame
, help
);
2470 /* X version has a loop through frames here, which doesn't
2471 appear to do anything, unless it has some side effect. */
2472 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2476 /* Free memory used by owner-drawn strings. */
2478 w32_free_submenu_strings (menu
)
2481 int i
, num
= GetMenuItemCount (menu
);
2482 for (i
= 0; i
< num
; i
++)
2485 bzero (&info
, sizeof (info
));
2486 info
.cbSize
= sizeof (info
);
2487 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2489 get_menu_item_info (menu
, i
, TRUE
, &info
);
2491 /* Owner-drawn names are held in dwItemData. */
2492 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2495 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2497 local_free (info
.dwItemData
);
2500 /* Recurse down submenus. */
2502 w32_free_submenu_strings (info
.hSubMenu
);
2507 w32_free_menu_strings (hwnd
)
2510 HMENU menu
= current_popup_menu
;
2512 if (get_menu_item_info
)
2514 /* If there is no popup menu active, free the strings from the frame's
2517 menu
= GetMenu (hwnd
);
2520 w32_free_submenu_strings (menu
);
2523 current_popup_menu
= NULL
;
2526 #endif /* HAVE_MENUS */
2528 /* The following is used by delayed window autoselection. */
2530 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2531 doc
: /* Return t if a menu or popup dialog is active on selected frame. */)
2536 f
= SELECTED_FRAME ();
2537 return (f
->output_data
.w32
->menubar_active
> 0) ? Qt
: Qnil
;
2540 #endif /* HAVE_MENUS */
2543 void syms_of_w32menu ()
2545 globals_of_w32menu ();
2546 staticpro (&menu_items
);
2549 current_popup_menu
= NULL
;
2551 Qdebug_on_next_call
= intern ("debug-on-next-call");
2552 staticpro (&Qdebug_on_next_call
);
2554 defsubr (&Sx_popup_menu
);
2555 defsubr (&Smenu_or_popup_active_p
);
2557 defsubr (&Sx_popup_dialog
);
2562 globals_of_w32menu is used to initialize those global variables that
2563 must always be initialized on startup even when the global variable
2564 initialized is non zero (see the function main in emacs.c).
2565 globals_of_w32menu is called from syms_of_w32menu when the global
2566 variable initialized is 0 and directly from main when initialized
2569 void globals_of_w32menu ()
2571 /* See if Get/SetMenuItemInfo functions are available. */
2572 HMODULE user32
= GetModuleHandle ("user32.dll");
2573 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2574 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
2575 unicode_append_menu
= (AppendMenuW_Proc
) GetProcAddress (user32
, "AppendMenuW");
2578 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2579 (do not change this comment) */