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, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "termhooks.h"
33 #include "blockinput.h"
36 #include "character.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
46 #include <sys/types.h>
49 #include "dispextern.h"
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
53 /******************************************************************/
54 /* Definitions copied from lwlib.h */
56 typedef void * XtPointer
;
66 /* This structure is based on the one in ../lwlib/lwlib.h, modified
68 typedef struct _widget_value
73 /* value (meaning depend on widget type) */
75 /* keyboard equivalent. no implications for XtTranslations */
78 /* Help string or nil if none.
79 GC finds this string through the frame's menu_bar_vector
80 or through menu_items. */
84 /* true if selected */
86 /* The type of a button. */
87 enum button_type button_type
;
88 /* true if menu title */
91 /* true if was edited (maintained by get_value) */
93 /* true if has changed (maintained by lw library) */
95 /* true if this widget itself has changed,
96 but not counting the other widgets found in the `next' field. */
97 change_type this_one_change
;
99 /* Contents of the sub-widgets, also selected slot for checkbox */
100 struct _widget_value
* contents
;
101 /* data passed to callback */
103 /* next one in the list */
104 struct _widget_value
* next
;
106 /* slot for the toolkit dependent part. Always initialize to NULL. */
108 /* tell us if we should free the toolkit data slot when freeing the
109 widget_value itself. */
110 Boolean free_toolkit_data
;
112 /* we resource the widget_value structures; this points to the next
113 one on the free list if this one has been deallocated.
115 struct _widget_value
*free_list
;
119 /* Local memory management */
120 #define local_heap (GetProcessHeap ())
121 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
122 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
124 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
125 #define free_widget_value(wv) (local_free ((wv)))
127 /******************************************************************/
134 HMENU current_popup_menu
;
136 void syms_of_w32menu ();
137 void globals_of_w32menu ();
139 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
143 IN OUT LPMENUITEMINFOA
);
144 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
148 IN LPCMENUITEMINFOA
);
150 GetMenuItemInfoA_Proc get_menu_item_info
= NULL
;
151 SetMenuItemInfoA_Proc set_menu_item_info
= NULL
;
152 AppendMenuW_Proc unicode_append_menu
= NULL
;
154 Lisp_Object Qdebug_on_next_call
;
156 extern Lisp_Object Vmenu_updating_frame
;
158 extern Lisp_Object Qmenu_bar
;
160 extern Lisp_Object QCtoggle
, QCradio
;
162 extern Lisp_Object Voverriding_local_map
;
163 extern Lisp_Object Voverriding_local_map_menu_flag
;
165 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
167 extern Lisp_Object Qmenu_bar_update_hook
;
169 void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
171 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
172 Lisp_Object
, Lisp_Object
, Lisp_Object
,
173 Lisp_Object
, Lisp_Object
));
175 static Lisp_Object w32_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
, char**));
177 static int is_simple_dialog
P_ ((Lisp_Object
));
178 static Lisp_Object simple_dialog_show
P_ ((FRAME_PTR
, Lisp_Object
, Lisp_Object
));
180 static Lisp_Object w32_menu_show
P_ ((FRAME_PTR
, int, int, int, int,
181 Lisp_Object
, char **));
183 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
184 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
186 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
,
187 Lisp_Object
*, int, int));
188 static void list_of_panes
P_ ((Lisp_Object
));
189 static void list_of_items
P_ ((Lisp_Object
));
190 void w32_free_menu_strings
P_((HWND
));
192 /* This holds a Lisp vector that holds the results of decoding
193 the keymaps or alist-of-alists that specify a menu.
195 It describes the panes and items within the panes.
197 Each pane is described by 3 elements in the vector:
198 t, the pane name, the pane's prefix key.
199 Then follow the pane's items, with 5 elements per item:
200 the item string, the enable flag, the item's value,
201 the definition, and the equivalent keyboard key's description string.
203 In some cases, multiple levels of menus may be described.
204 A single vector slot containing nil indicates the start of a submenu.
205 A single vector slot containing lambda indicates the end of a submenu.
206 The submenu follows a menu item which is the way to reach the submenu.
208 A single vector slot containing quote indicates that the
209 following items should appear on the right of a dialog box.
211 Using a Lisp vector to hold this information while we decode it
212 takes care of protecting all the data from GC. */
214 #define MENU_ITEMS_PANE_NAME 1
215 #define MENU_ITEMS_PANE_PREFIX 2
216 #define MENU_ITEMS_PANE_LENGTH 3
220 MENU_ITEMS_ITEM_NAME
= 0,
221 MENU_ITEMS_ITEM_ENABLE
,
222 MENU_ITEMS_ITEM_VALUE
,
223 MENU_ITEMS_ITEM_EQUIV_KEY
,
224 MENU_ITEMS_ITEM_DEFINITION
,
225 MENU_ITEMS_ITEM_TYPE
,
226 MENU_ITEMS_ITEM_SELECTED
,
227 MENU_ITEMS_ITEM_HELP
,
228 MENU_ITEMS_ITEM_LENGTH
231 static Lisp_Object menu_items
;
233 /* Number of slots currently allocated in menu_items. */
234 static int menu_items_allocated
;
236 /* This is the index in menu_items of the first empty slot. */
237 static int menu_items_used
;
239 /* The number of panes currently recorded in menu_items,
240 excluding those within submenus. */
241 static int menu_items_n_panes
;
243 /* Current depth within submenus. */
244 static int menu_items_submenu_depth
;
246 static int next_menubar_widget_id
;
248 /* This is set nonzero after the user activates the menu bar, and set
249 to zero again after the menu bars are redisplayed by prepare_menu_bar.
250 While it is nonzero, all calls to set_frame_menubar go deep.
252 I don't understand why this is needed, but it does seem to be
253 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
255 int pending_menu_activation
;
258 /* Return the frame whose ->output_data.w32->menubar_widget equals
261 static struct frame
*
262 menubar_id_to_frame (id
)
265 Lisp_Object tail
, frame
;
268 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
274 if (!FRAME_WINDOW_P (f
))
276 if (f
->output_data
.w32
->menubar_widget
== id
)
282 /* Initialize the menu_items structure if we haven't already done so.
283 Also mark it as currently empty. */
288 if (NILP (menu_items
))
290 menu_items_allocated
= 60;
291 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
295 menu_items_n_panes
= 0;
296 menu_items_submenu_depth
= 0;
299 /* Call at the end of generating the data in menu_items.
300 This fills in the number of items in the last pane. */
307 /* Call when finished using the data for the current menu
311 discard_menu_items ()
313 /* Free the structure if it is especially large.
314 Otherwise, hold on to it, to save time. */
315 if (menu_items_allocated
> 200)
318 menu_items_allocated
= 0;
322 /* Make the menu_items vector twice as large. */
327 menu_items_allocated
*= 2;
328 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
331 /* Begin a submenu. */
334 push_submenu_start ()
336 if (menu_items_used
+ 1 > menu_items_allocated
)
339 ASET (menu_items
, menu_items_used
, Qnil
);
341 menu_items_submenu_depth
++;
349 if (menu_items_used
+ 1 > menu_items_allocated
)
352 ASET (menu_items
, menu_items_used
, Qlambda
);
354 menu_items_submenu_depth
--;
357 /* Indicate boundary between left and right. */
360 push_left_right_boundary ()
362 if (menu_items_used
+ 1 > menu_items_allocated
)
365 ASET (menu_items
, menu_items_used
, Qquote
);
369 /* Start a new menu pane in menu_items.
370 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
373 push_menu_pane (name
, prefix_vec
)
374 Lisp_Object name
, prefix_vec
;
376 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
379 if (menu_items_submenu_depth
== 0)
380 menu_items_n_panes
++;
381 ASET (menu_items
, menu_items_used
, Qt
); menu_items_used
++;
382 ASET (menu_items
, menu_items_used
, name
); menu_items_used
++;
383 ASET (menu_items
, menu_items_used
, prefix_vec
); menu_items_used
++;
386 /* Push one menu item into the current pane. NAME is the string to
387 display. ENABLE if non-nil means this item can be selected. KEY
388 is the key generated by choosing this item, or nil if this item
389 doesn't really have a definition. DEF is the definition of this
390 item. EQUIV is the textual description of the keyboard equivalent
391 for this item (or nil if none). TYPE is the type of this menu
392 item, one of nil, `toggle' or `radio'. */
395 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
396 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
398 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
401 ASET (menu_items
, menu_items_used
, name
); menu_items_used
++;
402 ASET (menu_items
, menu_items_used
, enable
); menu_items_used
++;
403 ASET (menu_items
, menu_items_used
, key
); menu_items_used
++;
404 ASET (menu_items
, menu_items_used
, equiv
); menu_items_used
++;
405 ASET (menu_items
, menu_items_used
, def
); menu_items_used
++;
406 ASET (menu_items
, menu_items_used
, type
); menu_items_used
++;
407 ASET (menu_items
, menu_items_used
, selected
); menu_items_used
++;
408 ASET (menu_items
, menu_items_used
, help
); menu_items_used
++;
411 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
412 and generate menu panes for them in menu_items.
413 If NOTREAL is nonzero,
414 don't bother really computing whether an item is enabled. */
417 keymap_panes (keymaps
, nmaps
, notreal
)
418 Lisp_Object
*keymaps
;
426 /* Loop over the given keymaps, making a pane for each map.
427 But don't make a pane that is empty--ignore that map instead.
428 P is the number of panes we have made so far. */
429 for (mapno
= 0; mapno
< nmaps
; mapno
++)
430 single_keymap_panes (keymaps
[mapno
],
431 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
433 finish_menu_items ();
436 /* This is a recursive subroutine of keymap_panes.
437 It handles one keymap, KEYMAP.
438 The other arguments are passed along
439 or point to local variables of the previous function.
440 If NOTREAL is nonzero, only check for equivalent key bindings, don't
441 evaluate expressions in menu items and don't make any menu.
443 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
446 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
448 Lisp_Object pane_name
;
453 Lisp_Object pending_maps
= Qnil
;
454 Lisp_Object tail
, item
;
455 struct gcpro gcpro1
, gcpro2
;
460 push_menu_pane (pane_name
, prefix
);
462 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
464 GCPRO2 (keymap
, pending_maps
);
465 /* Look at each key binding, and if it is a menu item add it
469 single_menu_item (XCAR (item
), XCDR (item
),
470 &pending_maps
, notreal
, maxdepth
);
471 else if (VECTORP (item
))
473 /* Loop over the char values represented in the vector. */
474 int len
= ASIZE (item
);
476 for (c
= 0; c
< len
; c
++)
478 Lisp_Object character
;
479 XSETFASTINT (character
, c
);
480 single_menu_item (character
, AREF (item
, c
),
481 &pending_maps
, notreal
, maxdepth
);
487 /* Process now any submenus which want to be panes at this level. */
488 while (!NILP (pending_maps
))
490 Lisp_Object elt
, eltcdr
, string
;
491 elt
= Fcar (pending_maps
);
493 string
= XCAR (eltcdr
);
494 /* We no longer discard the @ from the beginning of the string here.
495 Instead, we do this in w32_menu_show. */
496 single_keymap_panes (Fcar (elt
), string
,
497 XCDR (eltcdr
), notreal
, maxdepth
- 1);
498 pending_maps
= Fcdr (pending_maps
);
502 /* This is a subroutine of single_keymap_panes that handles one
504 KEY is a key in a keymap and ITEM is its binding.
505 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
507 If NOTREAL is nonzero, only check for equivalent key bindings, don't
508 evaluate expressions in menu items and don't make any menu.
509 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
512 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
513 Lisp_Object key
, item
;
514 Lisp_Object
*pending_maps_ptr
;
515 int maxdepth
, notreal
;
517 Lisp_Object map
, item_string
, enabled
;
518 struct gcpro gcpro1
, gcpro2
;
521 /* Parse the menu item and leave the result in item_properties. */
523 res
= parse_menu_item (item
, notreal
, 0);
526 return; /* Not a menu item. */
528 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
532 /* We don't want to make a menu, just traverse the keymaps to
533 precompute equivalent key bindings. */
535 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
539 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
540 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
542 if (!NILP (map
) && SREF (item_string
, 0) == '@')
545 /* An enabled separate pane. Remember this to handle it later. */
546 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
551 push_menu_item (item_string
, enabled
, key
,
552 AREF (item_properties
, ITEM_PROPERTY_DEF
),
553 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
554 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
555 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
556 AREF (item_properties
, ITEM_PROPERTY_HELP
));
558 /* Display a submenu using the toolkit. */
559 if (! (NILP (map
) || NILP (enabled
)))
561 push_submenu_start ();
562 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
567 /* Push all the panes and items of a menu described by the
568 alist-of-alists MENU.
569 This handles old-fashioned calls to x-popup-menu. */
579 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
581 Lisp_Object elt
, pane_name
, pane_data
;
583 pane_name
= Fcar (elt
);
584 CHECK_STRING (pane_name
);
585 push_menu_pane (pane_name
, Qnil
);
586 pane_data
= Fcdr (elt
);
587 CHECK_CONS (pane_data
);
588 list_of_items (pane_data
);
591 finish_menu_items ();
594 /* Push the items in a single pane defined by the alist PANE. */
600 Lisp_Object tail
, item
, item1
;
602 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
606 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
607 else if (NILP (item
))
608 push_left_right_boundary ();
613 CHECK_STRING (item1
);
614 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
619 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
620 doc
: /* Pop up a deck-of-cards menu and return user's selection.
621 POSITION is a position specification. This is either a mouse button
622 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
623 are positions in pixels from the top left corner of WINDOW's frame
624 \(WINDOW may be a frame object instead of a window). This controls the
625 position of the center of the first line in the first pane of the
626 menu, not the top left of the menu as a whole. If POSITION is t, it
627 means to use the current mouse position.
629 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
630 The menu items come from key bindings that have a menu string as well as
631 a definition; actually, the \"definition\" in such a key binding looks like
632 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
633 the keymap as a top-level element.
635 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
636 Otherwise, REAL-DEFINITION should be a valid key binding definition.
638 You can also use a list of keymaps as MENU. Then each keymap makes a
639 separate pane. When MENU is a keymap or a list of keymaps, the return
640 value is a list of events.
642 Alternatively, you can specify a menu of multiple panes with a list of
643 the form (TITLE PANE1 PANE2...), where each pane is a list of
644 form (TITLE ITEM1 ITEM2...).
645 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
646 appear as an item--that makes a nonselectable line in the menu.
647 With this form of menu, the return value is VALUE from the chosen item.
649 If POSITION is nil, don't display the menu at all, just precalculate the
650 cached information about equivalent key sequences. */)
652 Lisp_Object position
, menu
;
654 Lisp_Object keymap
, tem
;
655 int xpos
= 0, ypos
= 0;
658 Lisp_Object selection
;
660 Lisp_Object x
, y
, window
;
666 if (! NILP (position
))
670 /* Decode the first argument: find the window and the coordinates. */
671 if (EQ (position
, Qt
)
672 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
673 || EQ (XCAR (position
), Qtool_bar
))))
675 /* Use the mouse's current position. */
676 FRAME_PTR new_f
= SELECTED_FRAME ();
677 Lisp_Object bar_window
;
678 enum scroll_bar_part part
;
681 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
682 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
683 &part
, &x
, &y
, &time
);
685 XSETFRAME (window
, new_f
);
688 window
= selected_window
;
695 tem
= Fcar (position
);
698 window
= Fcar (Fcdr (position
));
700 y
= Fcar (Fcdr (tem
));
705 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
706 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
707 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
716 /* Decode where to put the menu. */
724 else if (WINDOWP (window
))
726 CHECK_LIVE_WINDOW (window
);
727 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
729 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
730 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
733 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
734 but I don't want to make one now. */
735 CHECK_WINDOW (window
);
740 XSETFRAME (Vmenu_updating_frame
, f
);
743 Vmenu_updating_frame
= Qnil
;
744 #endif /* HAVE_MENUS */
749 /* Decode the menu items from what was specified. */
751 keymap
= get_keymap (menu
, 0, 0);
754 /* We were given a keymap. Extract menu info from the keymap. */
757 /* Extract the detailed info to make one pane. */
758 keymap_panes (&menu
, 1, NILP (position
));
760 /* Search for a string appearing directly as an element of the keymap.
761 That string is the title of the menu. */
762 prompt
= Fkeymap_prompt (keymap
);
763 if (NILP (title
) && !NILP (prompt
))
766 /* Make that be the pane title of the first pane. */
767 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
768 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
772 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
774 /* We were given a list of keymaps. */
775 int nmaps
= XFASTINT (Flength (menu
));
777 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
782 /* The first keymap that has a prompt string
783 supplies the menu title. */
784 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
788 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
790 prompt
= Fkeymap_prompt (keymap
);
791 if (NILP (title
) && !NILP (prompt
))
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (maps
, nmaps
, NILP (position
));
798 /* Make the title be the pane title of the first pane. */
799 if (!NILP (title
) && menu_items_n_panes
>= 0)
800 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
806 /* We were given an old-fashioned menu. */
808 CHECK_STRING (title
);
810 list_of_panes (Fcdr (menu
));
817 discard_menu_items ();
823 /* If resources from a previous popup menu still exist, does nothing
824 until the `menu_free_timer' has freed them (see w32fns.c). This
825 can occur if you press ESC or click outside a menu without selecting
828 if (current_popup_menu
)
830 discard_menu_items ();
835 /* Display them in a menu. */
838 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
839 keymaps
, title
, &error_name
);
842 discard_menu_items ();
844 #endif /* HAVE_MENUS */
848 if (error_name
) error (error_name
);
854 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
855 doc
: /* Pop up a dialog box and return user's selection.
856 POSITION specifies which frame to use.
857 This is normally a mouse button event or a window or frame.
858 If POSITION is t, it means to use the frame the mouse is on.
859 The dialog box appears in the middle of the specified frame.
861 CONTENTS specifies the alternatives to display in the dialog box.
862 It is a list of the form (TITLE ITEM1 ITEM2...).
863 Each ITEM is a cons cell (STRING . VALUE).
864 The return value is VALUE from the chosen item.
866 An ITEM may also be just a string--that makes a nonselectable item.
867 An ITEM may also be nil--that means to put all preceding items
868 on the left of the dialog box and all following items on the right.
869 \(By default, approximately half appear on each side.)
871 If HEADER is non-nil, the frame title for the box is "Information",
872 otherwise it is "Question". */)
873 (position
, contents
, header
)
874 Lisp_Object position
, contents
, header
;
881 /* Decode the first argument: find the window or frame to use. */
882 if (EQ (position
, Qt
)
883 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
884 || EQ (XCAR (position
), Qtool_bar
))))
886 #if 0 /* Using the frame the mouse is on may not be right. */
887 /* Use the mouse's current position. */
888 FRAME_PTR new_f
= SELECTED_FRAME ();
889 Lisp_Object bar_window
;
890 enum scroll_bar_part part
;
894 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
897 XSETFRAME (window
, new_f
);
899 window
= selected_window
;
901 window
= selected_window
;
903 else if (CONSP (position
))
906 tem
= Fcar (position
);
908 window
= Fcar (Fcdr (position
));
911 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
912 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
915 else if (WINDOWP (position
) || FRAMEP (position
))
920 /* Decode where to put the menu. */
924 else if (WINDOWP (window
))
926 CHECK_LIVE_WINDOW (window
);
927 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
930 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
931 but I don't want to make one now. */
932 CHECK_WINDOW (window
);
937 /* Handle simple Yes/No choices as MessageBox popups. */
938 if (is_simple_dialog (contents
))
939 return simple_dialog_show (f
, contents
, header
);
942 /* Display a menu with these alternatives
943 in the middle of frame F. */
944 Lisp_Object x
, y
, frame
, newpos
;
945 XSETFRAME (frame
, f
);
946 XSETINT (x
, x_pixel_width (f
) / 2);
947 XSETINT (y
, x_pixel_height (f
) / 2);
948 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
949 return Fx_popup_menu (newpos
,
950 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
953 #else /* HAVE_DIALOGS */
957 Lisp_Object selection
;
959 /* Decode the dialog items from what was specified. */
960 title
= Fcar (contents
);
961 CHECK_STRING (title
);
963 list_of_panes (Fcons (contents
, Qnil
));
965 /* Display them in a dialog box. */
967 selection
= w32_dialog_show (f
, 0, title
, header
, &error_name
);
970 discard_menu_items ();
972 if (error_name
) error (error_name
);
975 #endif /* HAVE_DIALOGS */
978 /* Activate the menu bar of frame F.
979 This is called from keyboard.c when it gets the
980 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
982 To activate the menu bar, we signal to the input thread that it can
983 return from the WM_INITMENU message, allowing the normal Windows
984 processing of the menus.
986 But first we recompute the menu bar contents (the whole tree).
988 This way we can safely execute Lisp code. */
991 x_activate_menubar (f
)
994 set_frame_menubar (f
, 0, 1);
996 /* Lock out further menubar changes while active. */
997 f
->output_data
.w32
->menubar_active
= 1;
999 /* Signal input thread to return from WM_INITMENU. */
1000 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1003 /* This callback is called from the menu bar pulldown menu
1004 when the user makes a selection.
1005 Figure out what the user chose
1006 and put the appropriate events into the keyboard buffer. */
1009 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1011 Lisp_Object prefix
, entry
;
1013 Lisp_Object
*subprefix_stack
;
1014 int submenu_depth
= 0;
1020 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1021 vector
= f
->menu_bar_vector
;
1024 while (i
< f
->menu_bar_items_used
)
1026 if (EQ (AREF (vector
, i
), Qnil
))
1028 subprefix_stack
[submenu_depth
++] = prefix
;
1032 else if (EQ (AREF (vector
, i
), Qlambda
))
1034 prefix
= subprefix_stack
[--submenu_depth
];
1037 else if (EQ (AREF (vector
, i
), Qt
))
1039 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1040 i
+= MENU_ITEMS_PANE_LENGTH
;
1044 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1045 /* The EMACS_INT cast avoids a warning. There's no problem
1046 as long as pointers have enough bits to hold small integers. */
1047 if ((int) (EMACS_INT
) client_data
== i
)
1050 struct input_event buf
;
1054 XSETFRAME (frame
, f
);
1055 buf
.kind
= MENU_BAR_EVENT
;
1056 buf
.frame_or_window
= frame
;
1058 kbd_buffer_store_event (&buf
);
1060 for (j
= 0; j
< submenu_depth
; j
++)
1061 if (!NILP (subprefix_stack
[j
]))
1063 buf
.kind
= MENU_BAR_EVENT
;
1064 buf
.frame_or_window
= frame
;
1065 buf
.arg
= subprefix_stack
[j
];
1066 kbd_buffer_store_event (&buf
);
1071 buf
.kind
= MENU_BAR_EVENT
;
1072 buf
.frame_or_window
= frame
;
1074 kbd_buffer_store_event (&buf
);
1077 buf
.kind
= MENU_BAR_EVENT
;
1078 buf
.frame_or_window
= frame
;
1080 /* Free memory used by owner-drawn and help-echo strings. */
1081 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1082 kbd_buffer_store_event (&buf
);
1084 f
->output_data
.w32
->menubar_active
= 0;
1087 i
+= MENU_ITEMS_ITEM_LENGTH
;
1090 /* Free memory used by owner-drawn and help-echo strings. */
1091 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1092 f
->output_data
.w32
->menubar_active
= 0;
1095 /* Allocate a widget_value, blocking input. */
1098 xmalloc_widget_value ()
1100 widget_value
*value
;
1103 value
= malloc_widget_value ();
1109 /* This recursively calls free_widget_value on the tree of widgets.
1110 It must free all data that was malloc'ed for these widget_values.
1111 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1112 must be left alone. */
1115 free_menubar_widget_value_tree (wv
)
1120 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1122 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1124 free_menubar_widget_value_tree (wv
->contents
);
1125 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1129 free_menubar_widget_value_tree (wv
->next
);
1130 wv
->next
= (widget_value
*) 0xDEADBEEF;
1133 free_widget_value (wv
);
1137 /* Set up data i menu_items for a menu bar item
1138 whose event type is ITEM_KEY (with string ITEM_NAME)
1139 and whose contents come from the list of keymaps MAPS. */
1142 parse_single_submenu (item_key
, item_name
, maps
)
1143 Lisp_Object item_key
, item_name
, maps
;
1147 Lisp_Object
*mapvec
;
1149 int top_level_items
= 0;
1151 length
= Flength (maps
);
1152 len
= XINT (length
);
1154 /* Convert the list MAPS into a vector MAPVEC. */
1155 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1156 for (i
= 0; i
< len
; i
++)
1158 mapvec
[i
] = Fcar (maps
);
1162 /* Loop over the given keymaps, making a pane for each map.
1163 But don't make a pane that is empty--ignore that map instead. */
1164 for (i
= 0; i
< len
; i
++)
1166 if (SYMBOLP (mapvec
[i
])
1167 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1169 /* Here we have a command at top level in the menu bar
1170 as opposed to a submenu. */
1171 top_level_items
= 1;
1172 push_menu_pane (Qnil
, Qnil
);
1173 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1174 Qnil
, Qnil
, Qnil
, Qnil
);
1179 prompt
= Fkeymap_prompt (mapvec
[i
]);
1180 single_keymap_panes (mapvec
[i
],
1181 !NILP (prompt
) ? prompt
: item_name
,
1186 return top_level_items
;
1190 /* Create a tree of widget_value objects
1191 representing the panes and items
1192 in menu_items starting at index START, up to index END. */
1194 static widget_value
*
1195 digest_single_submenu (start
, end
, top_level_items
)
1196 int start
, end
, top_level_items
;
1198 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1200 int submenu_depth
= 0;
1201 widget_value
**submenu_stack
;
1204 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1205 wv
= xmalloc_widget_value ();
1209 wv
->button_type
= BUTTON_TYPE_NONE
;
1215 /* Loop over all panes and items made by the preceding call
1216 to parse_single_submenu and construct a tree of widget_value objects.
1217 Ignore the panes and items used by previous calls to
1218 digest_single_submenu, even though those are also in menu_items. */
1222 if (EQ (AREF (menu_items
, i
), Qnil
))
1224 submenu_stack
[submenu_depth
++] = save_wv
;
1229 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1232 save_wv
= submenu_stack
[--submenu_depth
];
1235 else if (EQ (AREF (menu_items
, i
), Qt
)
1236 && submenu_depth
!= 0)
1237 i
+= MENU_ITEMS_PANE_LENGTH
;
1238 /* Ignore a nil in the item list.
1239 It's meaningful only for dialog boxes. */
1240 else if (EQ (AREF (menu_items
, i
), Qquote
))
1242 else if (EQ (AREF (menu_items
, i
), Qt
))
1244 /* Create a new pane. */
1245 Lisp_Object pane_name
, prefix
;
1248 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1249 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1251 if (STRINGP (pane_name
))
1253 if (unicode_append_menu
)
1254 /* Encode as UTF-8 for now. */
1255 pane_name
= ENCODE_UTF_8 (pane_name
);
1256 else if (STRING_MULTIBYTE (pane_name
))
1257 pane_name
= ENCODE_SYSTEM (pane_name
);
1259 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1262 pane_string
= (NILP (pane_name
)
1263 ? "" : (char *) SDATA (pane_name
));
1264 /* If there is just one top-level pane, put all its items directly
1265 under the top-level menu. */
1266 if (menu_items_n_panes
== 1)
1269 /* If the pane has a meaningful name,
1270 make the pane a top-level menu item
1271 with its items as a submenu beneath it. */
1272 if (strcmp (pane_string
, ""))
1274 wv
= xmalloc_widget_value ();
1278 first_wv
->contents
= wv
;
1279 wv
->lname
= pane_name
;
1280 /* Set value to 1 so update_submenu_strings can handle '@' */
1281 wv
->value
= (char *) 1;
1283 wv
->button_type
= BUTTON_TYPE_NONE
;
1288 i
+= MENU_ITEMS_PANE_LENGTH
;
1292 /* Create a new item within current pane. */
1293 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1296 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1297 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1298 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1299 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1300 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1301 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1302 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1304 if (STRINGP (item_name
))
1306 if (unicode_append_menu
)
1307 item_name
= ENCODE_UTF_8 (item_name
);
1308 else if (STRING_MULTIBYTE (item_name
))
1309 item_name
= ENCODE_SYSTEM (item_name
);
1311 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1314 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1316 descrip
= ENCODE_SYSTEM (descrip
);
1317 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1320 wv
= xmalloc_widget_value ();
1324 save_wv
->contents
= wv
;
1326 wv
->lname
= item_name
;
1327 if (!NILP (descrip
))
1330 /* The EMACS_INT cast avoids a warning. There's no problem
1331 as long as pointers have enough bits to hold small integers. */
1332 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1333 wv
->enabled
= !NILP (enable
);
1336 wv
->button_type
= BUTTON_TYPE_NONE
;
1337 else if (EQ (type
, QCradio
))
1338 wv
->button_type
= BUTTON_TYPE_RADIO
;
1339 else if (EQ (type
, QCtoggle
))
1340 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1344 wv
->selected
= !NILP (selected
);
1345 if (!STRINGP (help
))
1352 i
+= MENU_ITEMS_ITEM_LENGTH
;
1356 /* If we have just one "menu item"
1357 that was originally a button, return it by itself. */
1358 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1360 wv
= first_wv
->contents
;
1361 free_widget_value (first_wv
);
1369 /* Walk through the widget_value tree starting at FIRST_WV and update
1370 the char * pointers from the corresponding lisp values.
1371 We do this after building the whole tree, since GC may happen while the
1372 tree is constructed, and small strings are relocated. So we must wait
1373 until no GC can happen before storing pointers into lisp values. */
1375 update_submenu_strings (first_wv
)
1376 widget_value
*first_wv
;
1380 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1382 if (wv
->lname
&& ! NILP (wv
->lname
))
1384 wv
->name
= SDATA (wv
->lname
);
1386 /* Ignore the @ that means "separate pane".
1387 This is a kludge, but this isn't worth more time. */
1388 if (wv
->value
== (char *)1)
1390 if (wv
->name
[0] == '@')
1396 if (wv
->lkey
&& ! NILP (wv
->lkey
))
1397 wv
->key
= SDATA (wv
->lkey
);
1400 update_submenu_strings (wv
->contents
);
1405 /* Set the contents of the menubar widgets of frame F.
1406 The argument FIRST_TIME is currently ignored;
1407 it is set the first time this is called, from initialize_frame_menubar. */
1410 set_frame_menubar (f
, first_time
, deep_p
)
1415 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1417 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1419 int *submenu_start
, *submenu_end
;
1420 int *submenu_top_level_items
, *submenu_n_panes
;
1422 /* We must not change the menubar when actually in use. */
1423 if (f
->output_data
.w32
->menubar_active
)
1426 XSETFRAME (Vmenu_updating_frame
, f
);
1428 if (! menubar_widget
)
1430 else if (pending_menu_activation
&& !deep_p
)
1435 /* Make a widget-value tree representing the entire menu trees. */
1437 struct buffer
*prev
= current_buffer
;
1439 int specpdl_count
= SPECPDL_INDEX ();
1440 int previous_menu_items_used
= f
->menu_bar_items_used
;
1441 Lisp_Object
*previous_items
1442 = (Lisp_Object
*) alloca (previous_menu_items_used
1443 * sizeof (Lisp_Object
));
1445 /* If we are making a new widget, its contents are empty,
1446 do always reinitialize them. */
1447 if (! menubar_widget
)
1448 previous_menu_items_used
= 0;
1450 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1451 specbind (Qinhibit_quit
, Qt
);
1452 /* Don't let the debugger step into this code
1453 because it is not reentrant. */
1454 specbind (Qdebug_on_next_call
, Qnil
);
1456 record_unwind_save_match_data ();
1458 if (NILP (Voverriding_local_map_menu_flag
))
1460 specbind (Qoverriding_terminal_local_map
, Qnil
);
1461 specbind (Qoverriding_local_map
, Qnil
);
1464 set_buffer_internal_1 (XBUFFER (buffer
));
1466 /* Run the Lucid hook. */
1467 safe_run_hooks (Qactivate_menubar_hook
);
1468 /* If it has changed current-menubar from previous value,
1469 really recompute the menubar from the value. */
1470 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1471 call0 (Qrecompute_lucid_menubar
);
1472 safe_run_hooks (Qmenu_bar_update_hook
);
1473 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1475 items
= FRAME_MENU_BAR_ITEMS (f
);
1477 /* Save the frame's previous menu bar contents data. */
1478 if (previous_menu_items_used
)
1479 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1480 previous_menu_items_used
* sizeof (Lisp_Object
));
1482 /* Fill in menu_items with the current menu bar contents.
1483 This can evaluate Lisp code. */
1484 menu_items
= f
->menu_bar_vector
;
1485 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1486 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1487 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1488 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1489 submenu_top_level_items
1490 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1492 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1494 Lisp_Object key
, string
, maps
;
1498 key
= AREF (items
, i
);
1499 string
= AREF (items
, i
+ 1);
1500 maps
= AREF (items
, i
+ 2);
1504 submenu_start
[i
] = menu_items_used
;
1506 menu_items_n_panes
= 0;
1507 submenu_top_level_items
[i
]
1508 = parse_single_submenu (key
, string
, maps
);
1509 submenu_n_panes
[i
] = menu_items_n_panes
;
1511 submenu_end
[i
] = menu_items_used
;
1514 finish_menu_items ();
1516 /* Convert menu_items into widget_value trees
1517 to display the menu. This cannot evaluate Lisp code. */
1519 wv
= xmalloc_widget_value ();
1520 wv
->name
= "menubar";
1523 wv
->button_type
= BUTTON_TYPE_NONE
;
1527 for (i
= 0; i
< last_i
; i
+= 4)
1529 menu_items_n_panes
= submenu_n_panes
[i
];
1530 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1531 submenu_top_level_items
[i
]);
1535 first_wv
->contents
= wv
;
1536 /* Don't set wv->name here; GC during the loop might relocate it. */
1538 wv
->button_type
= BUTTON_TYPE_NONE
;
1542 set_buffer_internal_1 (prev
);
1543 unbind_to (specpdl_count
, Qnil
);
1545 /* If there has been no change in the Lisp-level contents
1546 of the menu bar, skip redisplaying it. Just exit. */
1548 for (i
= 0; i
< previous_menu_items_used
; i
++)
1549 if (menu_items_used
== i
1550 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1552 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1554 free_menubar_widget_value_tree (first_wv
);
1560 /* Now GC cannot happen during the lifetime of the widget_value,
1561 so it's safe to store data from a Lisp_String, as long as
1562 local copies are made when the actual menu is created.
1563 Windows takes care of this for normal string items, but
1564 not for owner-drawn items or additional item-info. */
1565 wv
= first_wv
->contents
;
1566 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1569 string
= AREF (items
, i
+ 1);
1572 wv
->name
= (char *) SDATA (string
);
1573 update_submenu_strings (wv
->contents
);
1577 f
->menu_bar_vector
= menu_items
;
1578 f
->menu_bar_items_used
= menu_items_used
;
1583 /* Make a widget-value tree containing
1584 just the top level menu bar strings. */
1586 wv
= xmalloc_widget_value ();
1587 wv
->name
= "menubar";
1590 wv
->button_type
= BUTTON_TYPE_NONE
;
1594 items
= FRAME_MENU_BAR_ITEMS (f
);
1595 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1599 string
= AREF (items
, i
+ 1);
1603 wv
= xmalloc_widget_value ();
1604 wv
->name
= (char *) SDATA (string
);
1607 wv
->button_type
= BUTTON_TYPE_NONE
;
1609 /* This prevents lwlib from assuming this
1610 menu item is really supposed to be empty. */
1611 /* The EMACS_INT cast avoids a warning.
1612 This value just has to be different from small integers. */
1613 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1618 first_wv
->contents
= wv
;
1622 /* Forget what we thought we knew about what is in the
1623 detailed contents of the menu bar menus.
1624 Changing the top level always destroys the contents. */
1625 f
->menu_bar_items_used
= 0;
1628 /* Create or update the menu bar widget. */
1634 /* Empty current menubar, rather than creating a fresh one. */
1635 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1640 menubar_widget
= CreateMenu ();
1642 fill_in_menu (menubar_widget
, first_wv
->contents
);
1644 free_menubar_widget_value_tree (first_wv
);
1647 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1649 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1650 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1651 /* Causes flicker when menu bar is updated
1652 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1654 /* Force the window size to be recomputed so that the frame's text
1655 area remains the same, if menubar has just been created. */
1656 if (old_widget
== NULL
)
1657 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1663 /* Called from Fx_create_frame to create the initial menubar of a frame
1664 before it is mapped, so that the window is mapped with the menubar already
1665 there instead of us tacking it on later and thrashing the window after it
1669 initialize_frame_menubar (f
)
1672 /* This function is called before the first chance to redisplay
1673 the frame. It has to be, so the frame will have the right size. */
1674 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1675 set_frame_menubar (f
, 1, 1);
1678 /* Get rid of the menu bar of frame F, and free its storage.
1679 This is used when deleting a frame, and when turning off the menu bar. */
1682 free_frame_menubar (f
)
1688 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1689 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1690 f
->output_data
.w32
->menubar_widget
= NULL
;
1698 /* w32_menu_show actually displays a menu using the panes and items in
1699 menu_items and returns the value selected from it; we assume input
1700 is blocked by the caller. */
1702 /* F is the frame the menu is for.
1703 X and Y are the frame-relative specified position,
1704 relative to the inside upper left corner of the frame F.
1705 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1706 KEYMAPS is 1 if this menu was specified with keymaps;
1707 in that case, we return a list containing the chosen item's value
1708 and perhaps also the pane's prefix.
1709 TITLE is the specified menu title.
1710 ERROR is a place to store an error message string in case of failure.
1711 (We return nil on failure, but the value doesn't actually matter.) */
1714 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1724 int menu_item_selection
;
1727 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1728 widget_value
**submenu_stack
1729 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1730 Lisp_Object
*subprefix_stack
1731 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1732 int submenu_depth
= 0;
1737 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1739 *error
= "Empty menu";
1743 /* Create a tree of widget_value objects
1744 representing the panes and their items. */
1745 wv
= xmalloc_widget_value ();
1749 wv
->button_type
= BUTTON_TYPE_NONE
;
1754 /* Loop over all panes and items, filling in the tree. */
1756 while (i
< menu_items_used
)
1758 if (EQ (AREF (menu_items
, i
), Qnil
))
1760 submenu_stack
[submenu_depth
++] = save_wv
;
1766 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1769 save_wv
= submenu_stack
[--submenu_depth
];
1773 else if (EQ (AREF (menu_items
, i
), Qt
)
1774 && submenu_depth
!= 0)
1775 i
+= MENU_ITEMS_PANE_LENGTH
;
1776 /* Ignore a nil in the item list.
1777 It's meaningful only for dialog boxes. */
1778 else if (EQ (AREF (menu_items
, i
), Qquote
))
1780 else if (EQ (AREF (menu_items
, i
), Qt
))
1782 /* Create a new pane. */
1783 Lisp_Object pane_name
, prefix
;
1785 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1786 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1788 if (STRINGP (pane_name
))
1790 if (unicode_append_menu
)
1791 pane_name
= ENCODE_UTF_8 (pane_name
);
1792 else if (STRING_MULTIBYTE (pane_name
))
1793 pane_name
= ENCODE_SYSTEM (pane_name
);
1795 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1798 pane_string
= (NILP (pane_name
)
1799 ? "" : (char *) SDATA (pane_name
));
1800 /* If there is just one top-level pane, put all its items directly
1801 under the top-level menu. */
1802 if (menu_items_n_panes
== 1)
1805 /* If the pane has a meaningful name,
1806 make the pane a top-level menu item
1807 with its items as a submenu beneath it. */
1808 if (!keymaps
&& strcmp (pane_string
, ""))
1810 wv
= xmalloc_widget_value ();
1814 first_wv
->contents
= wv
;
1815 wv
->name
= pane_string
;
1816 if (keymaps
&& !NILP (prefix
))
1820 wv
->button_type
= BUTTON_TYPE_NONE
;
1825 else if (first_pane
)
1831 i
+= MENU_ITEMS_PANE_LENGTH
;
1835 /* Create a new item within current pane. */
1836 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1838 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1839 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1840 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1841 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1842 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1843 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1844 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1846 if (STRINGP (item_name
))
1848 if (unicode_append_menu
)
1849 item_name
= ENCODE_UTF_8 (item_name
);
1850 else if (STRING_MULTIBYTE (item_name
))
1851 item_name
= ENCODE_SYSTEM (item_name
);
1853 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1856 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1858 descrip
= ENCODE_SYSTEM (descrip
);
1859 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1862 wv
= xmalloc_widget_value ();
1866 save_wv
->contents
= wv
;
1867 wv
->name
= (char *) SDATA (item_name
);
1868 if (!NILP (descrip
))
1869 wv
->key
= (char *) SDATA (descrip
);
1871 /* Use the contents index as call_data, since we are
1872 restricted to 16-bits. */
1873 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1874 wv
->enabled
= !NILP (enable
);
1877 wv
->button_type
= BUTTON_TYPE_NONE
;
1878 else if (EQ (type
, QCtoggle
))
1879 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1880 else if (EQ (type
, QCradio
))
1881 wv
->button_type
= BUTTON_TYPE_RADIO
;
1885 wv
->selected
= !NILP (selected
);
1886 if (!STRINGP (help
))
1893 i
+= MENU_ITEMS_ITEM_LENGTH
;
1897 /* Deal with the title, if it is non-nil. */
1900 widget_value
*wv_title
= xmalloc_widget_value ();
1901 widget_value
*wv_sep
= xmalloc_widget_value ();
1903 /* Maybe replace this separator with a bitmap or owner-draw item
1904 so that it looks better. Having two separators looks odd. */
1905 wv_sep
->name
= "--";
1906 wv_sep
->next
= first_wv
->contents
;
1907 wv_sep
->help
= Qnil
;
1909 if (unicode_append_menu
)
1910 title
= ENCODE_UTF_8 (title
);
1911 else if (STRING_MULTIBYTE (title
))
1912 title
= ENCODE_SYSTEM (title
);
1914 wv_title
->name
= (char *) SDATA (title
);
1915 wv_title
->enabled
= TRUE
;
1916 wv_title
->title
= TRUE
;
1917 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1918 wv_title
->help
= Qnil
;
1919 wv_title
->next
= wv_sep
;
1920 first_wv
->contents
= wv_title
;
1923 /* Actually create the menu. */
1924 current_popup_menu
= menu
= CreatePopupMenu ();
1925 fill_in_menu (menu
, first_wv
->contents
);
1927 /* Adjust coordinates to be root-window-relative. */
1930 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1932 /* No selection has been chosen yet. */
1933 menu_item_selection
= 0;
1935 /* Display the menu. */
1936 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1937 WM_EMACS_TRACKPOPUPMENU
,
1938 (WPARAM
)menu
, (LPARAM
)&pos
);
1940 /* Clean up extraneous mouse events which might have been generated
1942 discard_mouse_events ();
1944 /* Free the widget_value objects we used to specify the contents. */
1945 free_menubar_widget_value_tree (first_wv
);
1949 /* Free the owner-drawn and help-echo menu strings. */
1950 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1951 f
->output_data
.w32
->menubar_active
= 0;
1953 /* Find the selected item, and its pane, to return
1954 the proper value. */
1955 if (menu_item_selection
!= 0)
1957 Lisp_Object prefix
, entry
;
1959 prefix
= entry
= Qnil
;
1961 while (i
< menu_items_used
)
1963 if (EQ (AREF (menu_items
, i
), Qnil
))
1965 subprefix_stack
[submenu_depth
++] = prefix
;
1969 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1971 prefix
= subprefix_stack
[--submenu_depth
];
1974 else if (EQ (AREF (menu_items
, i
), Qt
))
1976 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1977 i
+= MENU_ITEMS_PANE_LENGTH
;
1979 /* Ignore a nil in the item list.
1980 It's meaningful only for dialog boxes. */
1981 else if (EQ (AREF (menu_items
, i
), Qquote
))
1985 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1986 if (menu_item_selection
== i
)
1992 entry
= Fcons (entry
, Qnil
);
1994 entry
= Fcons (prefix
, entry
);
1995 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1996 if (!NILP (subprefix_stack
[j
]))
1997 entry
= Fcons (subprefix_stack
[j
], entry
);
2001 i
+= MENU_ITEMS_ITEM_LENGTH
;
2005 else if (!for_click
)
2006 /* Make "Cancel" equivalent to C-g. */
2007 Fsignal (Qquit
, Qnil
);
2014 /* TODO: On Windows, there are two ways of defining a dialog.
2016 1. Create a predefined dialog resource and include it in nt/emacs.rc.
2017 Using this method, we could then set the titles and make unneeded
2018 buttons invisible before displaying the dialog. Everything would
2019 be a fixed size though, so there is a risk that text does not
2021 2. Create the dialog template in memory on the fly. This allows us
2022 to size the dialog and buttons dynamically, probably giving more
2023 natural looking results for dialogs with few buttons, and eliminating
2024 the problem of text overflowing the buttons. But the API for this is
2025 quite complex - structures have to be allocated in particular ways,
2026 text content is tacked onto the end of structures in variable length
2027 arrays with further structures tacked on after these, there are
2028 certain alignment requirements for all this, and we have to
2029 measure all the text and convert to "dialog coordinates" to figure
2030 out how big to make everything.
2032 For now, we'll just stick with menus for dialogs that are more
2033 complicated than simple yes/no type questions for which we can use
2034 the MessageBox function.
2037 static char * button_names
[] = {
2038 "button1", "button2", "button3", "button4", "button5",
2039 "button6", "button7", "button8", "button9", "button10" };
2042 w32_dialog_show (f
, keymaps
, title
, header
, error
)
2045 Lisp_Object title
, header
;
2048 int i
, nb_buttons
=0;
2049 char dialog_name
[6];
2050 int menu_item_selection
;
2052 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2054 /* Number of elements seen so far, before boundary. */
2056 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2057 int boundary_seen
= 0;
2061 if (menu_items_n_panes
> 1)
2063 *error
= "Multiple panes in dialog box";
2067 /* Create a tree of widget_value objects
2068 representing the text label and buttons. */
2070 Lisp_Object pane_name
, prefix
;
2072 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
2073 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
2074 pane_string
= (NILP (pane_name
)
2075 ? "" : (char *) SDATA (pane_name
));
2076 prev_wv
= xmalloc_widget_value ();
2077 prev_wv
->value
= pane_string
;
2078 if (keymaps
&& !NILP (prefix
))
2080 prev_wv
->enabled
= 1;
2081 prev_wv
->name
= "message";
2082 prev_wv
->help
= Qnil
;
2085 /* Loop over all panes and items, filling in the tree. */
2086 i
= MENU_ITEMS_PANE_LENGTH
;
2087 while (i
< menu_items_used
)
2090 /* Create a new item within current pane. */
2091 Lisp_Object item_name
, enable
, descrip
, help
;
2093 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2094 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2095 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2096 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2098 if (NILP (item_name
))
2100 free_menubar_widget_value_tree (first_wv
);
2101 *error
= "Submenu in dialog items";
2104 if (EQ (item_name
, Qquote
))
2106 /* This is the boundary between left-side elts
2107 and right-side elts. Stop incrementing right_count. */
2112 if (nb_buttons
>= 9)
2114 free_menubar_widget_value_tree (first_wv
);
2115 *error
= "Too many dialog items";
2119 wv
= xmalloc_widget_value ();
2121 wv
->name
= (char *) button_names
[nb_buttons
];
2122 if (!NILP (descrip
))
2123 wv
->key
= (char *) SDATA (descrip
);
2124 wv
->value
= (char *) SDATA (item_name
);
2125 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2126 wv
->enabled
= !NILP (enable
);
2130 if (! boundary_seen
)
2134 i
+= MENU_ITEMS_ITEM_LENGTH
;
2137 /* If the boundary was not specified,
2138 by default put half on the left and half on the right. */
2139 if (! boundary_seen
)
2140 left_count
= nb_buttons
- nb_buttons
/ 2;
2142 wv
= xmalloc_widget_value ();
2143 wv
->name
= dialog_name
;
2146 /* Frame title: 'Q' = Question, 'I' = Information.
2147 Can also have 'E' = Error if, one day, we want
2148 a popup for errors. */
2150 dialog_name
[0] = 'Q';
2152 dialog_name
[0] = 'I';
2154 /* Dialog boxes use a really stupid name encoding
2155 which specifies how many buttons to use
2156 and how many buttons are on the right. */
2157 dialog_name
[1] = '0' + nb_buttons
;
2158 dialog_name
[2] = 'B';
2159 dialog_name
[3] = 'R';
2160 /* Number of buttons to put on the right. */
2161 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2163 wv
->contents
= first_wv
;
2167 /* Actually create the dialog. */
2168 dialog_id
= widget_id_tick
++;
2169 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2170 f
->output_data
.w32
->widget
, 1, 0,
2171 dialog_selection_callback
, 0);
2172 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2174 /* Free the widget_value objects we used to specify the contents. */
2175 free_menubar_widget_value_tree (first_wv
);
2177 /* No selection has been chosen yet. */
2178 menu_item_selection
= 0;
2180 /* Display the menu. */
2181 lw_pop_up_all_widgets (dialog_id
);
2183 /* Process events that apply to the menu. */
2184 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2186 lw_destroy_all_widgets (dialog_id
);
2188 /* Find the selected item, and its pane, to return
2189 the proper value. */
2190 if (menu_item_selection
!= 0)
2196 while (i
< menu_items_used
)
2200 if (EQ (AREF (menu_items
, i
), Qt
))
2202 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2203 i
+= MENU_ITEMS_PANE_LENGTH
;
2207 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2208 if (menu_item_selection
== i
)
2212 entry
= Fcons (entry
, Qnil
);
2214 entry
= Fcons (prefix
, entry
);
2218 i
+= MENU_ITEMS_ITEM_LENGTH
;
2223 /* Make "Cancel" equivalent to C-g. */
2224 Fsignal (Qquit
, Qnil
);
2228 #else /* !HAVE_DIALOGS */
2230 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
2231 simple dialogs. We could handle a few more, but I'm not aware of
2232 anywhere in Emacs that uses the other specific dialog choices that
2233 MessageBox provides. */
2235 static int is_simple_dialog (contents
)
2236 Lisp_Object contents
;
2238 Lisp_Object options
= XCDR (contents
);
2239 Lisp_Object name
, yes
, no
, other
;
2241 yes
= build_string ("Yes");
2242 no
= build_string ("No");
2244 if (!CONSP (options
))
2247 name
= XCAR (XCAR (options
));
2248 if (!CONSP (options
))
2251 if (!NILP (Fstring_equal (name
, yes
)))
2253 else if (!NILP (Fstring_equal (name
, no
)))
2258 options
= XCDR (options
);
2259 if (!CONSP (options
))
2262 name
= XCAR (XCAR (options
));
2263 if (NILP (Fstring_equal (name
, other
)))
2266 /* Check there are no more options. */
2267 options
= XCDR (options
);
2268 return !(CONSP (options
));
2271 static Lisp_Object
simple_dialog_show (f
, contents
, header
)
2273 Lisp_Object contents
, header
;
2278 Lisp_Object lispy_answer
= Qnil
, temp
= XCAR (contents
);
2281 text
= SDATA (temp
);
2288 type
= MB_ICONQUESTION
;
2292 title
= "Information";
2293 type
= MB_ICONINFORMATION
;
2297 /* Since we only handle Yes/No dialogs, and we already checked
2298 is_simple_dialog, we don't need to worry about checking contents
2299 to see what type of dialog to use. */
2300 answer
= MessageBox (FRAME_W32_WINDOW (f
), text
, title
, type
);
2302 if (answer
== IDYES
)
2303 lispy_answer
= build_string ("Yes");
2304 else if (answer
== IDNO
)
2305 lispy_answer
= build_string ("No");
2307 Fsignal (Qquit
, Qnil
);
2309 for (temp
= XCDR (contents
); CONSP (temp
); temp
= XCDR (temp
))
2311 Lisp_Object item
, name
, value
;
2316 value
= XCDR (item
);
2324 if (!NILP (Fstring_equal (name
, lispy_answer
)))
2329 Fsignal (Qquit
, Qnil
);
2332 #endif /* !HAVE_DIALOGS */
2335 /* Is this item a separator? */
2337 name_is_separator (name
)
2342 /* Check if name string consists of only dashes ('-'). */
2343 while (*name
== '-') name
++;
2344 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2345 or "--deep-shadow". We don't implement them yet, se we just treat
2346 them like normal separators. */
2347 return (*name
== '\0' || start
+ 2 == name
);
2351 /* Indicate boundary between left and right. */
2353 add_left_right_boundary (HMENU menu
)
2355 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2358 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2360 utf8to16 (unsigned char * src
, int len
, WCHAR
* dest
)
2367 *dest
= (WCHAR
) *src
;
2368 dest
++; src
++; len
--;
2370 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2371 else if (*src
< 0xC0)
2375 /* 2 char UTF-8 sequence. */
2376 else if (*src
< 0xE0)
2378 *dest
= (WCHAR
) (((*src
& 0x1f) << 6)
2379 | (*(src
+ 1) & 0x3f));
2380 src
+= 2; len
-= 2; dest
++;
2382 else if (*src
< 0xF0)
2384 *dest
= (WCHAR
) (((*src
& 0x0f) << 12)
2385 | ((*(src
+ 1) & 0x3f) << 6)
2386 | (*(src
+ 2) & 0x3f));
2387 src
+= 3; len
-= 3; dest
++;
2389 else /* Not encodable. Insert Unicode Substitution char. */
2391 *dest
= (WCHAR
) 0xfffd;
2392 src
++; len
--; dest
++;
2399 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2402 char *out_string
, *p
, *q
;
2404 size_t nlen
, orig_len
;
2406 if (name_is_separator (wv
->name
))
2408 fuFlags
= MF_SEPARATOR
;
2414 fuFlags
= MF_STRING
;
2416 fuFlags
= MF_STRING
| MF_GRAYED
;
2418 if (wv
->key
!= NULL
)
2420 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2421 strcpy (out_string
, wv
->name
);
2422 strcat (out_string
, "\t");
2423 strcat (out_string
, wv
->key
);
2426 out_string
= wv
->name
;
2428 /* Quote any special characters within the menu item's text and
2430 nlen
= orig_len
= strlen (out_string
);
2431 if (unicode_append_menu
)
2433 /* With UTF-8, & cannot be part of a multibyte character. */
2434 for (p
= out_string
; *p
; p
++)
2442 /* If encoded with the system codepage, use multibyte string
2443 functions in case of multibyte characters that contain '&'. */
2444 for (p
= out_string
; *p
; p
= _mbsinc (p
))
2446 if (_mbsnextc (p
) == '&')
2451 if (nlen
> orig_len
)
2454 out_string
= alloca (nlen
+ 1);
2458 if (unicode_append_menu
)
2466 if (_mbsnextc (p
) == '&')
2481 else if (wv
->title
|| wv
->call_data
== 0)
2483 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2484 we can't deallocate the memory otherwise. */
2485 if (get_menu_item_info
)
2487 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2488 strcpy (out_string
, wv
->name
);
2490 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2492 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2495 fuFlags
= MF_DISABLED
;
2498 /* Draw radio buttons and tickboxes. */
2499 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2500 wv
->button_type
== BUTTON_TYPE_RADIO
))
2501 fuFlags
|= MF_CHECKED
;
2503 fuFlags
|= MF_UNCHECKED
;
2506 if (unicode_append_menu
&& out_string
)
2508 /* Convert out_string from UTF-8 to UTF-16-LE. */
2509 int utf8_len
= strlen (out_string
);
2510 WCHAR
* utf16_string
;
2511 if (fuFlags
& MF_OWNERDRAW
)
2512 utf16_string
= local_alloc ((utf8_len
+ 1) * sizeof (WCHAR
));
2514 utf16_string
= alloca ((utf8_len
+ 1) * sizeof (WCHAR
));
2516 utf8to16 (out_string
, utf8_len
, utf16_string
);
2517 return_value
= unicode_append_menu (menu
, fuFlags
,
2518 item
!= NULL
? (UINT
) item
2519 : (UINT
) wv
->call_data
,
2523 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2524 apparently does exist at least in some cases and appears to be
2525 stubbed out to do nothing. out_string is UTF-8, but since
2526 our standard menus are in English and this is only going to
2527 happen the first time a menu is used, the encoding is
2528 of minor importance compared with menus not working at all. */
2530 AppendMenu (menu
, fuFlags
,
2531 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2533 /* Don't use unicode menus in future. */
2534 unicode_append_menu
= NULL
;
2537 if (unicode_append_menu
&& (fuFlags
& MF_OWNERDRAW
))
2538 local_free (out_string
);
2545 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2549 /* This must be done after the menu item is created. */
2550 if (!wv
->title
&& wv
->call_data
!= 0)
2552 if (set_menu_item_info
)
2555 bzero (&info
, sizeof (info
));
2556 info
.cbSize
= sizeof (info
);
2557 info
.fMask
= MIIM_DATA
;
2559 /* Set help string for menu item. Leave it as a Lisp_Object
2560 until it is ready to be displayed, since GC can happen while
2561 menus are active. */
2562 if (!NILP (wv
->help
))
2563 #ifdef USE_LISP_UNION_TYPE
2564 info
.dwItemData
= (DWORD
) (wv
->help
).i
;
2566 info
.dwItemData
= (DWORD
) (wv
->help
);
2568 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2570 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2571 RADIO items, but is not available on NT 3.51 and earlier. */
2572 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2573 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2574 info
.dwTypeData
= out_string
;
2575 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2578 set_menu_item_info (menu
,
2579 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2583 return return_value
;
2586 /* Construct native Windows menu(bar) based on widget_value tree. */
2588 fill_in_menu (HMENU menu
, widget_value
*wv
)
2590 int items_added
= 0;
2592 for ( ; wv
!= NULL
; wv
= wv
->next
)
2596 HMENU sub_menu
= CreatePopupMenu ();
2598 if (sub_menu
== NULL
)
2601 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2602 !add_menu_item (menu
, wv
, sub_menu
))
2604 DestroyMenu (sub_menu
);
2610 if (!add_menu_item (menu
, wv
, NULL
))
2617 /* Display help string for currently pointed to menu item. Not
2618 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2621 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2623 if (get_menu_item_info
)
2625 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2626 Lisp_Object frame
, help
;
2628 /* No help echo on owner-draw menu items, or when the keyboard is used
2629 to navigate the menus, since tooltips are distracting if they pop
2631 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
2632 || !(flags
& MF_MOUSESELECT
))
2638 bzero (&info
, sizeof (info
));
2639 info
.cbSize
= sizeof (info
);
2640 info
.fMask
= MIIM_DATA
;
2641 get_menu_item_info (menu
, item
, FALSE
, &info
);
2643 #ifdef USE_LISP_UNION_TYPE
2644 help
= info
.dwItemData
? (Lisp_Object
) ((EMACS_INT
) info
.dwItemData
)
2647 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2651 /* Store the help echo in the keyboard buffer as the X toolkit
2652 version does, rather than directly showing it. This seems to
2653 solve the GC problems that were present when we based the
2654 Windows code on the non-toolkit version. */
2657 XSETFRAME (frame
, f
);
2658 kbd_buffer_store_help_event (frame
, help
);
2661 /* X version has a loop through frames here, which doesn't
2662 appear to do anything, unless it has some side effect. */
2663 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2667 /* Free memory used by owner-drawn strings. */
2669 w32_free_submenu_strings (menu
)
2672 int i
, num
= GetMenuItemCount (menu
);
2673 for (i
= 0; i
< num
; i
++)
2676 bzero (&info
, sizeof (info
));
2677 info
.cbSize
= sizeof (info
);
2678 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2680 get_menu_item_info (menu
, i
, TRUE
, &info
);
2682 /* Owner-drawn names are held in dwItemData. */
2683 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2686 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2688 local_free (info
.dwItemData
);
2691 /* Recurse down submenus. */
2693 w32_free_submenu_strings (info
.hSubMenu
);
2698 w32_free_menu_strings (hwnd
)
2701 HMENU menu
= current_popup_menu
;
2703 if (get_menu_item_info
)
2705 /* If there is no popup menu active, free the strings from the frame's
2708 menu
= GetMenu (hwnd
);
2711 w32_free_submenu_strings (menu
);
2714 current_popup_menu
= NULL
;
2717 #endif /* HAVE_MENUS */
2719 /* The following is used by delayed window autoselection. */
2721 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2722 doc
: /* Return t if a menu or popup dialog is active on selected frame. */)
2727 f
= SELECTED_FRAME ();
2728 return (f
->output_data
.w32
->menubar_active
> 0) ? Qt
: Qnil
;
2731 #endif /* HAVE_MENUS */
2734 void syms_of_w32menu ()
2736 globals_of_w32menu ();
2737 staticpro (&menu_items
);
2740 current_popup_menu
= NULL
;
2742 DEFSYM (Qdebug_on_next_call
, "debug-on-next-call");
2744 defsubr (&Sx_popup_menu
);
2745 defsubr (&Smenu_or_popup_active_p
);
2747 defsubr (&Sx_popup_dialog
);
2752 globals_of_w32menu is used to initialize those global variables that
2753 must always be initialized on startup even when the global variable
2754 initialized is non zero (see the function main in emacs.c).
2755 globals_of_w32menu is called from syms_of_w32menu when the global
2756 variable initialized is 0 and directly from main when initialized
2759 void globals_of_w32menu ()
2761 /* See if Get/SetMenuItemInfo functions are available. */
2762 HMODULE user32
= GetModuleHandle ("user32.dll");
2763 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2764 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
2765 unicode_append_menu
= (AppendMenuW_Proc
) GetProcAddress (user32
, "AppendMenuW");
2768 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2769 (do not change this comment) */