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, or (at your option)
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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
33 #include "termhooks.h"
35 #include "blockinput.h"
38 #include "character.h"
41 /* This may include sys/types.h, and that somehow loses
42 if this is not done before the other system files. */
45 /* Load sys/types.h if not already loaded.
46 In some systems loading it twice is suicidal. */
48 #include <sys/types.h>
51 #include "dispextern.h"
53 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
55 /******************************************************************/
56 /* Definitions copied from lwlib.h */
58 typedef void * XtPointer
;
68 /* This structure is based on the one in ../lwlib/lwlib.h, modified
70 typedef struct _widget_value
75 /* value (meaning depend on widget type) */
77 /* keyboard equivalent. no implications for XtTranslations */
80 /* Help string or nil if none.
81 GC finds this string through the frame's menu_bar_vector
82 or through menu_items. */
86 /* true if selected */
88 /* The type of a button. */
89 enum button_type button_type
;
90 /* true if menu title */
93 /* true if was edited (maintained by get_value) */
95 /* true if has changed (maintained by lw library) */
97 /* true if this widget itself has changed,
98 but not counting the other widgets found in the `next' field. */
99 change_type this_one_change
;
101 /* Contents of the sub-widgets, also selected slot for checkbox */
102 struct _widget_value
* contents
;
103 /* data passed to callback */
105 /* next one in the list */
106 struct _widget_value
* next
;
108 /* slot for the toolkit dependent part. Always initialize to NULL. */
110 /* tell us if we should free the toolkit data slot when freeing the
111 widget_value itself. */
112 Boolean free_toolkit_data
;
114 /* we resource the widget_value structures; this points to the next
115 one on the free list if this one has been deallocated.
117 struct _widget_value
*free_list
;
121 /* Local memory management */
122 #define local_heap (GetProcessHeap ())
123 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
124 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
126 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
127 #define free_widget_value(wv) (local_free ((wv)))
129 /******************************************************************/
136 HMENU current_popup_menu
;
138 void syms_of_w32menu ();
139 void globals_of_w32menu ();
141 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
145 IN OUT LPMENUITEMINFOA
);
146 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
150 IN LPCMENUITEMINFOA
);
152 GetMenuItemInfoA_Proc get_menu_item_info
= NULL
;
153 SetMenuItemInfoA_Proc set_menu_item_info
= NULL
;
154 AppendMenuW_Proc unicode_append_menu
= NULL
;
156 Lisp_Object Qdebug_on_next_call
;
158 extern Lisp_Object Vmenu_updating_frame
;
160 extern Lisp_Object Qmenu_bar
;
162 extern Lisp_Object QCtoggle
, QCradio
;
164 extern Lisp_Object Voverriding_local_map
;
165 extern Lisp_Object Voverriding_local_map_menu_flag
;
167 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
169 extern Lisp_Object Qmenu_bar_update_hook
;
171 void set_frame_menubar
P_ ((FRAME_PTR
, int, int));
173 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
174 Lisp_Object
, Lisp_Object
, Lisp_Object
,
175 Lisp_Object
, Lisp_Object
));
177 static Lisp_Object w32_dialog_show
P_ ((FRAME_PTR
, int, Lisp_Object
, char**));
179 static int is_simple_dialog
P_ ((Lisp_Object
));
180 static Lisp_Object simple_dialog_show
P_ ((FRAME_PTR
, Lisp_Object
, Lisp_Object
));
182 static Lisp_Object w32_menu_show
P_ ((FRAME_PTR
, int, int, int, int,
183 Lisp_Object
, char **));
185 static void keymap_panes
P_ ((Lisp_Object
*, int, int));
186 static void single_keymap_panes
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
188 static void single_menu_item
P_ ((Lisp_Object
, Lisp_Object
,
189 Lisp_Object
*, int, int));
190 static void list_of_panes
P_ ((Lisp_Object
));
191 static void list_of_items
P_ ((Lisp_Object
));
192 void w32_free_menu_strings
P_((HWND
));
194 /* This holds a Lisp vector that holds the results of decoding
195 the keymaps or alist-of-alists that specify a menu.
197 It describes the panes and items within the panes.
199 Each pane is described by 3 elements in the vector:
200 t, the pane name, the pane's prefix key.
201 Then follow the pane's items, with 5 elements per item:
202 the item string, the enable flag, the item's value,
203 the definition, and the equivalent keyboard key's description string.
205 In some cases, multiple levels of menus may be described.
206 A single vector slot containing nil indicates the start of a submenu.
207 A single vector slot containing lambda indicates the end of a submenu.
208 The submenu follows a menu item which is the way to reach the submenu.
210 A single vector slot containing quote indicates that the
211 following items should appear on the right of a dialog box.
213 Using a Lisp vector to hold this information while we decode it
214 takes care of protecting all the data from GC. */
216 #define MENU_ITEMS_PANE_NAME 1
217 #define MENU_ITEMS_PANE_PREFIX 2
218 #define MENU_ITEMS_PANE_LENGTH 3
222 MENU_ITEMS_ITEM_NAME
= 0,
223 MENU_ITEMS_ITEM_ENABLE
,
224 MENU_ITEMS_ITEM_VALUE
,
225 MENU_ITEMS_ITEM_EQUIV_KEY
,
226 MENU_ITEMS_ITEM_DEFINITION
,
227 MENU_ITEMS_ITEM_TYPE
,
228 MENU_ITEMS_ITEM_SELECTED
,
229 MENU_ITEMS_ITEM_HELP
,
230 MENU_ITEMS_ITEM_LENGTH
233 static Lisp_Object menu_items
;
235 /* Number of slots currently allocated in menu_items. */
236 static int menu_items_allocated
;
238 /* This is the index in menu_items of the first empty slot. */
239 static int menu_items_used
;
241 /* The number of panes currently recorded in menu_items,
242 excluding those within submenus. */
243 static int menu_items_n_panes
;
245 /* Current depth within submenus. */
246 static int menu_items_submenu_depth
;
248 static int next_menubar_widget_id
;
250 /* This is set nonzero after the user activates the menu bar, and set
251 to zero again after the menu bars are redisplayed by prepare_menu_bar.
252 While it is nonzero, all calls to set_frame_menubar go deep.
254 I don't understand why this is needed, but it does seem to be
255 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
257 int pending_menu_activation
;
260 /* Return the frame whose ->output_data.w32->menubar_widget equals
263 static struct frame
*
264 menubar_id_to_frame (id
)
267 Lisp_Object tail
, frame
;
270 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
276 if (!FRAME_WINDOW_P (f
))
278 if (f
->output_data
.w32
->menubar_widget
== id
)
284 /* Initialize the menu_items structure if we haven't already done so.
285 Also mark it as currently empty. */
290 if (NILP (menu_items
))
292 menu_items_allocated
= 60;
293 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
297 menu_items_n_panes
= 0;
298 menu_items_submenu_depth
= 0;
301 /* Call at the end of generating the data in menu_items.
302 This fills in the number of items in the last pane. */
309 /* Call when finished using the data for the current menu
313 discard_menu_items ()
315 /* Free the structure if it is especially large.
316 Otherwise, hold on to it, to save time. */
317 if (menu_items_allocated
> 200)
320 menu_items_allocated
= 0;
324 /* Make the menu_items vector twice as large. */
329 menu_items_allocated
*= 2;
330 menu_items
= larger_vector (menu_items
, menu_items_allocated
, Qnil
);
333 /* Begin a submenu. */
336 push_submenu_start ()
338 if (menu_items_used
+ 1 > menu_items_allocated
)
341 ASET (menu_items
, menu_items_used
, Qnil
);
343 menu_items_submenu_depth
++;
351 if (menu_items_used
+ 1 > menu_items_allocated
)
354 ASET (menu_items
, menu_items_used
, Qlambda
);
356 menu_items_submenu_depth
--;
359 /* Indicate boundary between left and right. */
362 push_left_right_boundary ()
364 if (menu_items_used
+ 1 > menu_items_allocated
)
367 ASET (menu_items
, menu_items_used
, Qquote
);
371 /* Start a new menu pane in menu_items.
372 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
375 push_menu_pane (name
, prefix_vec
)
376 Lisp_Object name
, prefix_vec
;
378 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
381 if (menu_items_submenu_depth
== 0)
382 menu_items_n_panes
++;
383 ASET (menu_items
, menu_items_used
, Qt
); menu_items_used
++;
384 ASET (menu_items
, menu_items_used
, name
); menu_items_used
++;
385 ASET (menu_items
, menu_items_used
, prefix_vec
); menu_items_used
++;
388 /* Push one menu item into the current pane. NAME is the string to
389 display. ENABLE if non-nil means this item can be selected. KEY
390 is the key generated by choosing this item, or nil if this item
391 doesn't really have a definition. DEF is the definition of this
392 item. EQUIV is the textual description of the keyboard equivalent
393 for this item (or nil if none). TYPE is the type of this menu
394 item, one of nil, `toggle' or `radio'. */
397 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
398 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
400 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
403 ASET (menu_items
, menu_items_used
, name
); menu_items_used
++;
404 ASET (menu_items
, menu_items_used
, enable
); menu_items_used
++;
405 ASET (menu_items
, menu_items_used
, key
); menu_items_used
++;
406 ASET (menu_items
, menu_items_used
, equiv
); menu_items_used
++;
407 ASET (menu_items
, menu_items_used
, def
); menu_items_used
++;
408 ASET (menu_items
, menu_items_used
, type
); menu_items_used
++;
409 ASET (menu_items
, menu_items_used
, selected
); menu_items_used
++;
410 ASET (menu_items
, menu_items_used
, help
); menu_items_used
++;
413 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
414 and generate menu panes for them in menu_items.
415 If NOTREAL is nonzero,
416 don't bother really computing whether an item is enabled. */
419 keymap_panes (keymaps
, nmaps
, notreal
)
420 Lisp_Object
*keymaps
;
428 /* Loop over the given keymaps, making a pane for each map.
429 But don't make a pane that is empty--ignore that map instead.
430 P is the number of panes we have made so far. */
431 for (mapno
= 0; mapno
< nmaps
; mapno
++)
432 single_keymap_panes (keymaps
[mapno
],
433 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
435 finish_menu_items ();
438 /* This is a recursive subroutine of keymap_panes.
439 It handles one keymap, KEYMAP.
440 The other arguments are passed along
441 or point to local variables of the previous function.
442 If NOTREAL is nonzero, only check for equivalent key bindings, don't
443 evaluate expressions in menu items and don't make any menu.
445 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
448 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
450 Lisp_Object pane_name
;
455 Lisp_Object pending_maps
= Qnil
;
456 Lisp_Object tail
, item
;
457 struct gcpro gcpro1
, gcpro2
;
462 push_menu_pane (pane_name
, prefix
);
464 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
466 GCPRO2 (keymap
, pending_maps
);
467 /* Look at each key binding, and if it is a menu item add it
471 single_menu_item (XCAR (item
), XCDR (item
),
472 &pending_maps
, notreal
, maxdepth
);
473 else if (VECTORP (item
))
475 /* Loop over the char values represented in the vector. */
476 int len
= ASIZE (item
);
478 for (c
= 0; c
< len
; c
++)
480 Lisp_Object character
;
481 XSETFASTINT (character
, c
);
482 single_menu_item (character
, AREF (item
, c
),
483 &pending_maps
, notreal
, maxdepth
);
489 /* Process now any submenus which want to be panes at this level. */
490 while (!NILP (pending_maps
))
492 Lisp_Object elt
, eltcdr
, string
;
493 elt
= Fcar (pending_maps
);
495 string
= XCAR (eltcdr
);
496 /* We no longer discard the @ from the beginning of the string here.
497 Instead, we do this in w32_menu_show. */
498 single_keymap_panes (Fcar (elt
), string
,
499 XCDR (eltcdr
), notreal
, maxdepth
- 1);
500 pending_maps
= Fcdr (pending_maps
);
504 /* This is a subroutine of single_keymap_panes that handles one
506 KEY is a key in a keymap and ITEM is its binding.
507 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
509 If NOTREAL is nonzero, only check for equivalent key bindings, don't
510 evaluate expressions in menu items and don't make any menu.
511 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
514 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
515 Lisp_Object key
, item
;
516 Lisp_Object
*pending_maps_ptr
;
517 int maxdepth
, notreal
;
519 Lisp_Object map
, item_string
, enabled
;
520 struct gcpro gcpro1
, gcpro2
;
523 /* Parse the menu item and leave the result in item_properties. */
525 res
= parse_menu_item (item
, notreal
, 0);
528 return; /* Not a menu item. */
530 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
534 /* We don't want to make a menu, just traverse the keymaps to
535 precompute equivalent key bindings. */
537 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
541 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
542 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
544 if (!NILP (map
) && SREF (item_string
, 0) == '@')
547 /* An enabled separate pane. Remember this to handle it later. */
548 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
553 push_menu_item (item_string
, enabled
, key
,
554 AREF (item_properties
, ITEM_PROPERTY_DEF
),
555 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
556 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
557 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
558 AREF (item_properties
, ITEM_PROPERTY_HELP
));
560 /* Display a submenu using the toolkit. */
561 if (! (NILP (map
) || NILP (enabled
)))
563 push_submenu_start ();
564 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
569 /* Push all the panes and items of a menu described by the
570 alist-of-alists MENU.
571 This handles old-fashioned calls to x-popup-menu. */
581 for (tail
= menu
; CONSP (tail
); tail
= XCDR (tail
))
583 Lisp_Object elt
, pane_name
, pane_data
;
585 pane_name
= Fcar (elt
);
586 CHECK_STRING (pane_name
);
587 push_menu_pane (pane_name
, Qnil
);
588 pane_data
= Fcdr (elt
);
589 CHECK_CONS (pane_data
);
590 list_of_items (pane_data
);
593 finish_menu_items ();
596 /* Push the items in a single pane defined by the alist PANE. */
602 Lisp_Object tail
, item
, item1
;
604 for (tail
= pane
; CONSP (tail
); tail
= XCDR (tail
))
608 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
609 else if (NILP (item
))
610 push_left_right_boundary ();
615 CHECK_STRING (item1
);
616 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
621 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
622 doc
: /* Pop up a deck-of-cards menu and return user's selection.
623 POSITION is a position specification. This is either a mouse button
624 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
625 are positions in pixels from the top left corner of WINDOW's frame
626 \(WINDOW may be a frame object instead of a window). This controls the
627 position of the center of the first line in the first pane of the
628 menu, not the top left of the menu as a whole. If POSITION is t, it
629 means to use the current mouse position.
631 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
632 The menu items come from key bindings that have a menu string as well as
633 a definition; actually, the \"definition\" in such a key binding looks like
634 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
635 the keymap as a top-level element.
637 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
638 Otherwise, REAL-DEFINITION should be a valid key binding definition.
640 You can also use a list of keymaps as MENU. Then each keymap makes a
641 separate pane. When MENU is a keymap or a list of keymaps, the return
642 value is a list of events.
644 Alternatively, you can specify a menu of multiple panes with a list of
645 the form (TITLE PANE1 PANE2...), where each pane is a list of
646 form (TITLE ITEM1 ITEM2...).
647 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
648 appear as an item--that makes a nonselectable line in the menu.
649 With this form of menu, the return value is VALUE from the chosen item.
651 If POSITION is nil, don't display the menu at all, just precalculate the
652 cached information about equivalent key sequences. */)
654 Lisp_Object position
, menu
;
656 Lisp_Object keymap
, tem
;
657 int xpos
= 0, ypos
= 0;
660 Lisp_Object selection
;
662 Lisp_Object x
, y
, window
;
668 if (! NILP (position
))
672 /* Decode the first argument: find the window and the coordinates. */
673 if (EQ (position
, Qt
)
674 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
675 || EQ (XCAR (position
), Qtool_bar
))))
677 /* Use the mouse's current position. */
678 FRAME_PTR new_f
= SELECTED_FRAME ();
679 Lisp_Object bar_window
;
680 enum scroll_bar_part part
;
683 if (FRAME_TERMINAL (new_f
)->mouse_position_hook
)
684 (*FRAME_TERMINAL (new_f
)->mouse_position_hook
) (&new_f
, 1, &bar_window
,
685 &part
, &x
, &y
, &time
);
687 XSETFRAME (window
, new_f
);
690 window
= selected_window
;
697 tem
= Fcar (position
);
700 window
= Fcar (Fcdr (position
));
702 y
= Fcar (Fcdr (tem
));
707 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
708 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
709 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
718 /* Decode where to put the menu. */
726 else if (WINDOWP (window
))
728 CHECK_LIVE_WINDOW (window
);
729 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
731 xpos
= WINDOW_LEFT_EDGE_X (XWINDOW (window
));
732 ypos
= WINDOW_TOP_EDGE_Y (XWINDOW (window
));
735 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
736 but I don't want to make one now. */
737 CHECK_WINDOW (window
);
742 XSETFRAME (Vmenu_updating_frame
, f
);
745 Vmenu_updating_frame
= Qnil
;
746 #endif /* HAVE_MENUS */
751 /* Decode the menu items from what was specified. */
753 keymap
= get_keymap (menu
, 0, 0);
756 /* We were given a keymap. Extract menu info from the keymap. */
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu
, 1, NILP (position
));
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt
= Fkeymap_prompt (keymap
);
765 if (NILP (title
) && !NILP (prompt
))
768 /* Make that be the pane title of the first pane. */
769 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
770 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
774 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
776 /* We were given a list of keymaps. */
777 int nmaps
= XFASTINT (Flength (menu
));
779 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
784 /* The first keymap that has a prompt string
785 supplies the menu title. */
786 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
790 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
792 prompt
= Fkeymap_prompt (keymap
);
793 if (NILP (title
) && !NILP (prompt
))
797 /* Extract the detailed info to make one pane. */
798 keymap_panes (maps
, nmaps
, NILP (position
));
800 /* Make the title be the pane title of the first pane. */
801 if (!NILP (title
) && menu_items_n_panes
>= 0)
802 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
808 /* We were given an old-fashioned menu. */
810 CHECK_STRING (title
);
812 list_of_panes (Fcdr (menu
));
819 discard_menu_items ();
825 /* If resources from a previous popup menu still exist, does nothing
826 until the `menu_free_timer' has freed them (see w32fns.c). This
827 can occur if you press ESC or click outside a menu without selecting
830 if (current_popup_menu
)
832 discard_menu_items ();
837 /* Display them in a menu. */
840 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
841 keymaps
, title
, &error_name
);
844 discard_menu_items ();
846 #endif /* HAVE_MENUS */
850 if (error_name
) error (error_name
);
856 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 3, 0,
857 doc
: /* Pop up a dialog box and return user's selection.
858 POSITION specifies which frame to use.
859 This is normally a mouse button event or a window or frame.
860 If POSITION is t, it means to use the frame the mouse is on.
861 The dialog box appears in the middle of the specified frame.
863 CONTENTS specifies the alternatives to display in the dialog box.
864 It is a list of the form (TITLE ITEM1 ITEM2...).
865 Each ITEM is a cons cell (STRING . VALUE).
866 The return value is VALUE from the chosen item.
868 An ITEM may also be just a string--that makes a nonselectable item.
869 An ITEM may also be nil--that means to put all preceding items
870 on the left of the dialog box and all following items on the right.
871 \(By default, approximately half appear on each side.)
873 If HEADER is non-nil, the frame title for the box is "Information",
874 otherwise it is "Question". */)
875 (position
, contents
, header
)
876 Lisp_Object position
, contents
, header
;
883 /* Decode the first argument: find the window or frame to use. */
884 if (EQ (position
, Qt
)
885 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
886 || EQ (XCAR (position
), Qtool_bar
))))
888 #if 0 /* Using the frame the mouse is on may not be right. */
889 /* Use the mouse's current position. */
890 FRAME_PTR new_f
= SELECTED_FRAME ();
891 Lisp_Object bar_window
;
892 enum scroll_bar_part part
;
896 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
899 XSETFRAME (window
, new_f
);
901 window
= selected_window
;
903 window
= selected_window
;
905 else if (CONSP (position
))
908 tem
= Fcar (position
);
910 window
= Fcar (Fcdr (position
));
913 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
914 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
917 else if (WINDOWP (position
) || FRAMEP (position
))
922 /* Decode where to put the menu. */
926 else if (WINDOWP (window
))
928 CHECK_LIVE_WINDOW (window
);
929 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
932 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
933 but I don't want to make one now. */
934 CHECK_WINDOW (window
);
939 /* Handle simple Yes/No choices as MessageBox popups. */
940 if (is_simple_dialog (contents
))
941 return simple_dialog_show (f
, contents
, header
);
944 /* Display a menu with these alternatives
945 in the middle of frame F. */
946 Lisp_Object x
, y
, frame
, newpos
;
947 XSETFRAME (frame
, f
);
948 XSETINT (x
, x_pixel_width (f
) / 2);
949 XSETINT (y
, x_pixel_height (f
) / 2);
950 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
951 return Fx_popup_menu (newpos
,
952 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
955 #else /* HAVE_DIALOGS */
959 Lisp_Object selection
;
961 /* Decode the dialog items from what was specified. */
962 title
= Fcar (contents
);
963 CHECK_STRING (title
);
965 list_of_panes (Fcons (contents
, Qnil
));
967 /* Display them in a dialog box. */
969 selection
= w32_dialog_show (f
, 0, title
, header
, &error_name
);
972 discard_menu_items ();
974 if (error_name
) error (error_name
);
977 #endif /* HAVE_DIALOGS */
980 /* Activate the menu bar of frame F.
981 This is called from keyboard.c when it gets the
982 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
984 To activate the menu bar, we signal to the input thread that it can
985 return from the WM_INITMENU message, allowing the normal Windows
986 processing of the menus.
988 But first we recompute the menu bar contents (the whole tree).
990 This way we can safely execute Lisp code. */
993 x_activate_menubar (f
)
996 set_frame_menubar (f
, 0, 1);
998 /* Lock out further menubar changes while active. */
999 f
->output_data
.w32
->menubar_active
= 1;
1001 /* Signal input thread to return from WM_INITMENU. */
1002 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1005 /* This callback is called from the menu bar pulldown menu
1006 when the user makes a selection.
1007 Figure out what the user chose
1008 and put the appropriate events into the keyboard buffer. */
1011 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1013 Lisp_Object prefix
, entry
;
1015 Lisp_Object
*subprefix_stack
;
1016 int submenu_depth
= 0;
1022 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1023 vector
= f
->menu_bar_vector
;
1026 while (i
< f
->menu_bar_items_used
)
1028 if (EQ (AREF (vector
, i
), Qnil
))
1030 subprefix_stack
[submenu_depth
++] = prefix
;
1034 else if (EQ (AREF (vector
, i
), Qlambda
))
1036 prefix
= subprefix_stack
[--submenu_depth
];
1039 else if (EQ (AREF (vector
, i
), Qt
))
1041 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1042 i
+= MENU_ITEMS_PANE_LENGTH
;
1046 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1047 /* The EMACS_INT cast avoids a warning. There's no problem
1048 as long as pointers have enough bits to hold small integers. */
1049 if ((int) (EMACS_INT
) client_data
== i
)
1052 struct input_event buf
;
1056 XSETFRAME (frame
, f
);
1057 buf
.kind
= MENU_BAR_EVENT
;
1058 buf
.frame_or_window
= frame
;
1060 kbd_buffer_store_event (&buf
);
1062 for (j
= 0; j
< submenu_depth
; j
++)
1063 if (!NILP (subprefix_stack
[j
]))
1065 buf
.kind
= MENU_BAR_EVENT
;
1066 buf
.frame_or_window
= frame
;
1067 buf
.arg
= subprefix_stack
[j
];
1068 kbd_buffer_store_event (&buf
);
1073 buf
.kind
= MENU_BAR_EVENT
;
1074 buf
.frame_or_window
= frame
;
1076 kbd_buffer_store_event (&buf
);
1079 buf
.kind
= MENU_BAR_EVENT
;
1080 buf
.frame_or_window
= frame
;
1082 /* Free memory used by owner-drawn and help-echo strings. */
1083 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1084 kbd_buffer_store_event (&buf
);
1086 f
->output_data
.w32
->menubar_active
= 0;
1089 i
+= MENU_ITEMS_ITEM_LENGTH
;
1092 /* Free memory used by owner-drawn and help-echo strings. */
1093 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1094 f
->output_data
.w32
->menubar_active
= 0;
1097 /* Allocate a widget_value, blocking input. */
1100 xmalloc_widget_value ()
1102 widget_value
*value
;
1105 value
= malloc_widget_value ();
1111 /* This recursively calls free_widget_value on the tree of widgets.
1112 It must free all data that was malloc'ed for these widget_values.
1113 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1114 must be left alone. */
1117 free_menubar_widget_value_tree (wv
)
1122 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1124 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1126 free_menubar_widget_value_tree (wv
->contents
);
1127 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1131 free_menubar_widget_value_tree (wv
->next
);
1132 wv
->next
= (widget_value
*) 0xDEADBEEF;
1135 free_widget_value (wv
);
1139 /* Set up data i menu_items for a menu bar item
1140 whose event type is ITEM_KEY (with string ITEM_NAME)
1141 and whose contents come from the list of keymaps MAPS. */
1144 parse_single_submenu (item_key
, item_name
, maps
)
1145 Lisp_Object item_key
, item_name
, maps
;
1149 Lisp_Object
*mapvec
;
1151 int top_level_items
= 0;
1153 length
= Flength (maps
);
1154 len
= XINT (length
);
1156 /* Convert the list MAPS into a vector MAPVEC. */
1157 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1158 for (i
= 0; i
< len
; i
++)
1160 mapvec
[i
] = Fcar (maps
);
1164 /* Loop over the given keymaps, making a pane for each map.
1165 But don't make a pane that is empty--ignore that map instead. */
1166 for (i
= 0; i
< len
; i
++)
1168 if (SYMBOLP (mapvec
[i
])
1169 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1171 /* Here we have a command at top level in the menu bar
1172 as opposed to a submenu. */
1173 top_level_items
= 1;
1174 push_menu_pane (Qnil
, Qnil
);
1175 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1176 Qnil
, Qnil
, Qnil
, Qnil
);
1181 prompt
= Fkeymap_prompt (mapvec
[i
]);
1182 single_keymap_panes (mapvec
[i
],
1183 !NILP (prompt
) ? prompt
: item_name
,
1188 return top_level_items
;
1192 /* Create a tree of widget_value objects
1193 representing the panes and items
1194 in menu_items starting at index START, up to index END. */
1196 static widget_value
*
1197 digest_single_submenu (start
, end
, top_level_items
)
1198 int start
, end
, top_level_items
;
1200 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1202 int submenu_depth
= 0;
1203 widget_value
**submenu_stack
;
1206 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1207 wv
= xmalloc_widget_value ();
1211 wv
->button_type
= BUTTON_TYPE_NONE
;
1217 /* Loop over all panes and items made by the preceding call
1218 to parse_single_submenu and construct a tree of widget_value objects.
1219 Ignore the panes and items used by previous calls to
1220 digest_single_submenu, even though those are also in menu_items. */
1224 if (EQ (AREF (menu_items
, i
), Qnil
))
1226 submenu_stack
[submenu_depth
++] = save_wv
;
1231 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1234 save_wv
= submenu_stack
[--submenu_depth
];
1237 else if (EQ (AREF (menu_items
, i
), Qt
)
1238 && submenu_depth
!= 0)
1239 i
+= MENU_ITEMS_PANE_LENGTH
;
1240 /* Ignore a nil in the item list.
1241 It's meaningful only for dialog boxes. */
1242 else if (EQ (AREF (menu_items
, i
), Qquote
))
1244 else if (EQ (AREF (menu_items
, i
), Qt
))
1246 /* Create a new pane. */
1247 Lisp_Object pane_name
, prefix
;
1250 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1251 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1253 if (STRINGP (pane_name
))
1255 if (unicode_append_menu
)
1256 /* Encode as UTF-8 for now. */
1257 pane_name
= ENCODE_UTF_8 (pane_name
);
1258 else if (STRING_MULTIBYTE (pane_name
))
1259 pane_name
= ENCODE_SYSTEM (pane_name
);
1261 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1264 pane_string
= (NILP (pane_name
)
1265 ? "" : (char *) SDATA (pane_name
));
1266 /* If there is just one top-level pane, put all its items directly
1267 under the top-level menu. */
1268 if (menu_items_n_panes
== 1)
1271 /* If the pane has a meaningful name,
1272 make the pane a top-level menu item
1273 with its items as a submenu beneath it. */
1274 if (strcmp (pane_string
, ""))
1276 wv
= xmalloc_widget_value ();
1280 first_wv
->contents
= wv
;
1281 wv
->lname
= pane_name
;
1282 /* Set value to 1 so update_submenu_strings can handle '@' */
1283 wv
->value
= (char *) 1;
1285 wv
->button_type
= BUTTON_TYPE_NONE
;
1290 i
+= MENU_ITEMS_PANE_LENGTH
;
1294 /* Create a new item within current pane. */
1295 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1298 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1299 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1300 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1301 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1302 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1303 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1304 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1306 if (STRINGP (item_name
))
1308 if (unicode_append_menu
)
1309 item_name
= ENCODE_UTF_8 (item_name
);
1310 else if (STRING_MULTIBYTE (item_name
))
1311 item_name
= ENCODE_SYSTEM (item_name
);
1313 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1316 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1318 descrip
= ENCODE_SYSTEM (descrip
);
1319 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1322 wv
= xmalloc_widget_value ();
1326 save_wv
->contents
= wv
;
1328 wv
->lname
= item_name
;
1329 if (!NILP (descrip
))
1332 /* The EMACS_INT cast avoids a warning. There's no problem
1333 as long as pointers have enough bits to hold small integers. */
1334 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1335 wv
->enabled
= !NILP (enable
);
1338 wv
->button_type
= BUTTON_TYPE_NONE
;
1339 else if (EQ (type
, QCradio
))
1340 wv
->button_type
= BUTTON_TYPE_RADIO
;
1341 else if (EQ (type
, QCtoggle
))
1342 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1346 wv
->selected
= !NILP (selected
);
1347 if (!STRINGP (help
))
1354 i
+= MENU_ITEMS_ITEM_LENGTH
;
1358 /* If we have just one "menu item"
1359 that was originally a button, return it by itself. */
1360 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1362 wv
= first_wv
->contents
;
1363 free_widget_value (first_wv
);
1371 /* Walk through the widget_value tree starting at FIRST_WV and update
1372 the char * pointers from the corresponding lisp values.
1373 We do this after building the whole tree, since GC may happen while the
1374 tree is constructed, and small strings are relocated. So we must wait
1375 until no GC can happen before storing pointers into lisp values. */
1377 update_submenu_strings (first_wv
)
1378 widget_value
*first_wv
;
1382 for (wv
= first_wv
; wv
; wv
= wv
->next
)
1384 if (wv
->lname
&& ! NILP (wv
->lname
))
1386 wv
->name
= SDATA (wv
->lname
);
1388 /* Ignore the @ that means "separate pane".
1389 This is a kludge, but this isn't worth more time. */
1390 if (wv
->value
== (char *)1)
1392 if (wv
->name
[0] == '@')
1398 if (wv
->lkey
&& ! NILP (wv
->lkey
))
1399 wv
->key
= SDATA (wv
->lkey
);
1402 update_submenu_strings (wv
->contents
);
1407 /* Set the contents of the menubar widgets of frame F.
1408 The argument FIRST_TIME is currently ignored;
1409 it is set the first time this is called, from initialize_frame_menubar. */
1412 set_frame_menubar (f
, first_time
, deep_p
)
1417 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1419 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1421 int *submenu_start
, *submenu_end
;
1422 int *submenu_top_level_items
, *submenu_n_panes
;
1424 /* We must not change the menubar when actually in use. */
1425 if (f
->output_data
.w32
->menubar_active
)
1428 XSETFRAME (Vmenu_updating_frame
, f
);
1430 if (! menubar_widget
)
1432 else if (pending_menu_activation
&& !deep_p
)
1437 /* Make a widget-value tree representing the entire menu trees. */
1439 struct buffer
*prev
= current_buffer
;
1441 int specpdl_count
= SPECPDL_INDEX ();
1442 int previous_menu_items_used
= f
->menu_bar_items_used
;
1443 Lisp_Object
*previous_items
1444 = (Lisp_Object
*) alloca (previous_menu_items_used
1445 * sizeof (Lisp_Object
));
1447 /* If we are making a new widget, its contents are empty,
1448 do always reinitialize them. */
1449 if (! menubar_widget
)
1450 previous_menu_items_used
= 0;
1452 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1453 specbind (Qinhibit_quit
, Qt
);
1454 /* Don't let the debugger step into this code
1455 because it is not reentrant. */
1456 specbind (Qdebug_on_next_call
, Qnil
);
1458 record_unwind_save_match_data ();
1460 if (NILP (Voverriding_local_map_menu_flag
))
1462 specbind (Qoverriding_terminal_local_map
, Qnil
);
1463 specbind (Qoverriding_local_map
, Qnil
);
1466 set_buffer_internal_1 (XBUFFER (buffer
));
1468 /* Run the Lucid hook. */
1469 safe_run_hooks (Qactivate_menubar_hook
);
1470 /* If it has changed current-menubar from previous value,
1471 really recompute the menubar from the value. */
1472 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1473 call0 (Qrecompute_lucid_menubar
);
1474 safe_run_hooks (Qmenu_bar_update_hook
);
1475 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1477 items
= FRAME_MENU_BAR_ITEMS (f
);
1479 /* Save the frame's previous menu bar contents data. */
1480 if (previous_menu_items_used
)
1481 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1482 previous_menu_items_used
* sizeof (Lisp_Object
));
1484 /* Fill in menu_items with the current menu bar contents.
1485 This can evaluate Lisp code. */
1486 menu_items
= f
->menu_bar_vector
;
1487 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1488 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1489 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1490 submenu_n_panes
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int));
1491 submenu_top_level_items
1492 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1494 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1496 Lisp_Object key
, string
, maps
;
1500 key
= AREF (items
, i
);
1501 string
= AREF (items
, i
+ 1);
1502 maps
= AREF (items
, i
+ 2);
1506 submenu_start
[i
] = menu_items_used
;
1508 menu_items_n_panes
= 0;
1509 submenu_top_level_items
[i
]
1510 = parse_single_submenu (key
, string
, maps
);
1511 submenu_n_panes
[i
] = menu_items_n_panes
;
1513 submenu_end
[i
] = menu_items_used
;
1516 finish_menu_items ();
1518 /* Convert menu_items into widget_value trees
1519 to display the menu. This cannot evaluate Lisp code. */
1521 wv
= xmalloc_widget_value ();
1522 wv
->name
= "menubar";
1525 wv
->button_type
= BUTTON_TYPE_NONE
;
1529 for (i
= 0; i
< last_i
; i
+= 4)
1531 menu_items_n_panes
= submenu_n_panes
[i
];
1532 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1533 submenu_top_level_items
[i
]);
1537 first_wv
->contents
= wv
;
1538 /* Don't set wv->name here; GC during the loop might relocate it. */
1540 wv
->button_type
= BUTTON_TYPE_NONE
;
1544 set_buffer_internal_1 (prev
);
1545 unbind_to (specpdl_count
, Qnil
);
1547 /* If there has been no change in the Lisp-level contents
1548 of the menu bar, skip redisplaying it. Just exit. */
1550 for (i
= 0; i
< previous_menu_items_used
; i
++)
1551 if (menu_items_used
== i
1552 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1554 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1556 free_menubar_widget_value_tree (first_wv
);
1562 /* Now GC cannot happen during the lifetime of the widget_value,
1563 so it's safe to store data from a Lisp_String, as long as
1564 local copies are made when the actual menu is created.
1565 Windows takes care of this for normal string items, but
1566 not for owner-drawn items or additional item-info. */
1567 wv
= first_wv
->contents
;
1568 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1571 string
= AREF (items
, i
+ 1);
1574 wv
->name
= (char *) SDATA (string
);
1575 update_submenu_strings (wv
->contents
);
1579 f
->menu_bar_vector
= menu_items
;
1580 f
->menu_bar_items_used
= menu_items_used
;
1585 /* Make a widget-value tree containing
1586 just the top level menu bar strings. */
1588 wv
= xmalloc_widget_value ();
1589 wv
->name
= "menubar";
1592 wv
->button_type
= BUTTON_TYPE_NONE
;
1596 items
= FRAME_MENU_BAR_ITEMS (f
);
1597 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1601 string
= AREF (items
, i
+ 1);
1605 wv
= xmalloc_widget_value ();
1606 wv
->name
= (char *) SDATA (string
);
1609 wv
->button_type
= BUTTON_TYPE_NONE
;
1611 /* This prevents lwlib from assuming this
1612 menu item is really supposed to be empty. */
1613 /* The EMACS_INT cast avoids a warning.
1614 This value just has to be different from small integers. */
1615 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1620 first_wv
->contents
= wv
;
1624 /* Forget what we thought we knew about what is in the
1625 detailed contents of the menu bar menus.
1626 Changing the top level always destroys the contents. */
1627 f
->menu_bar_items_used
= 0;
1630 /* Create or update the menu bar widget. */
1636 /* Empty current menubar, rather than creating a fresh one. */
1637 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1642 menubar_widget
= CreateMenu ();
1644 fill_in_menu (menubar_widget
, first_wv
->contents
);
1646 free_menubar_widget_value_tree (first_wv
);
1649 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1651 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1652 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1653 /* Causes flicker when menu bar is updated
1654 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1656 /* Force the window size to be recomputed so that the frame's text
1657 area remains the same, if menubar has just been created. */
1658 if (old_widget
== NULL
)
1659 x_set_window_size (f
, 0, FRAME_COLS (f
), FRAME_LINES (f
));
1665 /* Called from Fx_create_frame to create the initial menubar of a frame
1666 before it is mapped, so that the window is mapped with the menubar already
1667 there instead of us tacking it on later and thrashing the window after it
1671 initialize_frame_menubar (f
)
1674 /* This function is called before the first chance to redisplay
1675 the frame. It has to be, so the frame will have the right size. */
1676 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1677 set_frame_menubar (f
, 1, 1);
1680 /* Get rid of the menu bar of frame F, and free its storage.
1681 This is used when deleting a frame, and when turning off the menu bar. */
1684 free_frame_menubar (f
)
1690 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1691 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1692 f
->output_data
.w32
->menubar_widget
= NULL
;
1700 /* w32_menu_show actually displays a menu using the panes and items in
1701 menu_items and returns the value selected from it; we assume input
1702 is blocked by the caller. */
1704 /* F is the frame the menu is for.
1705 X and Y are the frame-relative specified position,
1706 relative to the inside upper left corner of the frame F.
1707 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1708 KEYMAPS is 1 if this menu was specified with keymaps;
1709 in that case, we return a list containing the chosen item's value
1710 and perhaps also the pane's prefix.
1711 TITLE is the specified menu title.
1712 ERROR is a place to store an error message string in case of failure.
1713 (We return nil on failure, but the value doesn't actually matter.) */
1716 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1726 int menu_item_selection
;
1729 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1730 widget_value
**submenu_stack
1731 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1732 Lisp_Object
*subprefix_stack
1733 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1734 int submenu_depth
= 0;
1739 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1741 *error
= "Empty menu";
1745 /* Create a tree of widget_value objects
1746 representing the panes and their items. */
1747 wv
= xmalloc_widget_value ();
1751 wv
->button_type
= BUTTON_TYPE_NONE
;
1756 /* Loop over all panes and items, filling in the tree. */
1758 while (i
< menu_items_used
)
1760 if (EQ (AREF (menu_items
, i
), Qnil
))
1762 submenu_stack
[submenu_depth
++] = save_wv
;
1768 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1771 save_wv
= submenu_stack
[--submenu_depth
];
1775 else if (EQ (AREF (menu_items
, i
), Qt
)
1776 && submenu_depth
!= 0)
1777 i
+= MENU_ITEMS_PANE_LENGTH
;
1778 /* Ignore a nil in the item list.
1779 It's meaningful only for dialog boxes. */
1780 else if (EQ (AREF (menu_items
, i
), Qquote
))
1782 else if (EQ (AREF (menu_items
, i
), Qt
))
1784 /* Create a new pane. */
1785 Lisp_Object pane_name
, prefix
;
1787 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1788 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1790 if (STRINGP (pane_name
))
1792 if (unicode_append_menu
)
1793 pane_name
= ENCODE_UTF_8 (pane_name
);
1794 else if (STRING_MULTIBYTE (pane_name
))
1795 pane_name
= ENCODE_SYSTEM (pane_name
);
1797 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1800 pane_string
= (NILP (pane_name
)
1801 ? "" : (char *) SDATA (pane_name
));
1802 /* If there is just one top-level pane, put all its items directly
1803 under the top-level menu. */
1804 if (menu_items_n_panes
== 1)
1807 /* If the pane has a meaningful name,
1808 make the pane a top-level menu item
1809 with its items as a submenu beneath it. */
1810 if (!keymaps
&& strcmp (pane_string
, ""))
1812 wv
= xmalloc_widget_value ();
1816 first_wv
->contents
= wv
;
1817 wv
->name
= pane_string
;
1818 if (keymaps
&& !NILP (prefix
))
1822 wv
->button_type
= BUTTON_TYPE_NONE
;
1827 else if (first_pane
)
1833 i
+= MENU_ITEMS_PANE_LENGTH
;
1837 /* Create a new item within current pane. */
1838 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1840 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1841 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1842 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1843 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1844 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1845 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1846 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1848 if (STRINGP (item_name
))
1850 if (unicode_append_menu
)
1851 item_name
= ENCODE_UTF_8 (item_name
);
1852 else if (STRING_MULTIBYTE (item_name
))
1853 item_name
= ENCODE_SYSTEM (item_name
);
1855 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1858 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1860 descrip
= ENCODE_SYSTEM (descrip
);
1861 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1864 wv
= xmalloc_widget_value ();
1868 save_wv
->contents
= wv
;
1869 wv
->name
= (char *) SDATA (item_name
);
1870 if (!NILP (descrip
))
1871 wv
->key
= (char *) SDATA (descrip
);
1873 /* Use the contents index as call_data, since we are
1874 restricted to 16-bits. */
1875 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1876 wv
->enabled
= !NILP (enable
);
1879 wv
->button_type
= BUTTON_TYPE_NONE
;
1880 else if (EQ (type
, QCtoggle
))
1881 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1882 else if (EQ (type
, QCradio
))
1883 wv
->button_type
= BUTTON_TYPE_RADIO
;
1887 wv
->selected
= !NILP (selected
);
1888 if (!STRINGP (help
))
1895 i
+= MENU_ITEMS_ITEM_LENGTH
;
1899 /* Deal with the title, if it is non-nil. */
1902 widget_value
*wv_title
= xmalloc_widget_value ();
1903 widget_value
*wv_sep
= xmalloc_widget_value ();
1905 /* Maybe replace this separator with a bitmap or owner-draw item
1906 so that it looks better. Having two separators looks odd. */
1907 wv_sep
->name
= "--";
1908 wv_sep
->next
= first_wv
->contents
;
1909 wv_sep
->help
= Qnil
;
1911 if (unicode_append_menu
)
1912 title
= ENCODE_UTF_8 (title
);
1913 else if (STRING_MULTIBYTE (title
))
1914 title
= ENCODE_SYSTEM (title
);
1916 wv_title
->name
= (char *) SDATA (title
);
1917 wv_title
->enabled
= TRUE
;
1918 wv_title
->title
= TRUE
;
1919 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1920 wv_title
->help
= Qnil
;
1921 wv_title
->next
= wv_sep
;
1922 first_wv
->contents
= wv_title
;
1925 /* Actually create the menu. */
1926 current_popup_menu
= menu
= CreatePopupMenu ();
1927 fill_in_menu (menu
, first_wv
->contents
);
1929 /* Adjust coordinates to be root-window-relative. */
1932 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1934 /* No selection has been chosen yet. */
1935 menu_item_selection
= 0;
1937 /* Display the menu. */
1938 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1939 WM_EMACS_TRACKPOPUPMENU
,
1940 (WPARAM
)menu
, (LPARAM
)&pos
);
1942 /* Clean up extraneous mouse events which might have been generated
1944 discard_mouse_events ();
1946 /* Free the widget_value objects we used to specify the contents. */
1947 free_menubar_widget_value_tree (first_wv
);
1951 /* Free the owner-drawn and help-echo menu strings. */
1952 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1953 f
->output_data
.w32
->menubar_active
= 0;
1955 /* Find the selected item, and its pane, to return
1956 the proper value. */
1957 if (menu_item_selection
!= 0)
1959 Lisp_Object prefix
, entry
;
1961 prefix
= entry
= Qnil
;
1963 while (i
< menu_items_used
)
1965 if (EQ (AREF (menu_items
, i
), Qnil
))
1967 subprefix_stack
[submenu_depth
++] = prefix
;
1971 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1973 prefix
= subprefix_stack
[--submenu_depth
];
1976 else if (EQ (AREF (menu_items
, i
), Qt
))
1978 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1979 i
+= MENU_ITEMS_PANE_LENGTH
;
1981 /* Ignore a nil in the item list.
1982 It's meaningful only for dialog boxes. */
1983 else if (EQ (AREF (menu_items
, i
), Qquote
))
1987 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1988 if (menu_item_selection
== i
)
1994 entry
= Fcons (entry
, Qnil
);
1996 entry
= Fcons (prefix
, entry
);
1997 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1998 if (!NILP (subprefix_stack
[j
]))
1999 entry
= Fcons (subprefix_stack
[j
], entry
);
2003 i
+= MENU_ITEMS_ITEM_LENGTH
;
2007 else if (!for_click
)
2008 /* Make "Cancel" equivalent to C-g. */
2009 Fsignal (Qquit
, Qnil
);
2016 /* TODO: On Windows, there are two ways of defining a dialog.
2018 1. Create a predefined dialog resource and include it in nt/emacs.rc.
2019 Using this method, we could then set the titles and make unneeded
2020 buttons invisible before displaying the dialog. Everything would
2021 be a fixed size though, so there is a risk that text does not
2023 2. Create the dialog template in memory on the fly. This allows us
2024 to size the dialog and buttons dynamically, probably giving more
2025 natural looking results for dialogs with few buttons, and eliminating
2026 the problem of text overflowing the buttons. But the API for this is
2027 quite complex - structures have to be allocated in particular ways,
2028 text content is tacked onto the end of structures in variable length
2029 arrays with further structures tacked on after these, there are
2030 certain alignment requirements for all this, and we have to
2031 measure all the text and convert to "dialog coordinates" to figure
2032 out how big to make everything.
2034 For now, we'll just stick with menus for dialogs that are more
2035 complicated than simple yes/no type questions for which we can use
2036 the MessageBox function.
2039 static char * button_names
[] = {
2040 "button1", "button2", "button3", "button4", "button5",
2041 "button6", "button7", "button8", "button9", "button10" };
2044 w32_dialog_show (f
, keymaps
, title
, header
, error
)
2047 Lisp_Object title
, header
;
2050 int i
, nb_buttons
=0;
2051 char dialog_name
[6];
2052 int menu_item_selection
;
2054 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
2056 /* Number of elements seen so far, before boundary. */
2058 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2059 int boundary_seen
= 0;
2063 if (menu_items_n_panes
> 1)
2065 *error
= "Multiple panes in dialog box";
2069 /* Create a tree of widget_value objects
2070 representing the text label and buttons. */
2072 Lisp_Object pane_name
, prefix
;
2074 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
2075 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
2076 pane_string
= (NILP (pane_name
)
2077 ? "" : (char *) SDATA (pane_name
));
2078 prev_wv
= xmalloc_widget_value ();
2079 prev_wv
->value
= pane_string
;
2080 if (keymaps
&& !NILP (prefix
))
2082 prev_wv
->enabled
= 1;
2083 prev_wv
->name
= "message";
2084 prev_wv
->help
= Qnil
;
2087 /* Loop over all panes and items, filling in the tree. */
2088 i
= MENU_ITEMS_PANE_LENGTH
;
2089 while (i
< menu_items_used
)
2092 /* Create a new item within current pane. */
2093 Lisp_Object item_name
, enable
, descrip
, help
;
2095 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2096 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2097 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2098 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2100 if (NILP (item_name
))
2102 free_menubar_widget_value_tree (first_wv
);
2103 *error
= "Submenu in dialog items";
2106 if (EQ (item_name
, Qquote
))
2108 /* This is the boundary between left-side elts
2109 and right-side elts. Stop incrementing right_count. */
2114 if (nb_buttons
>= 9)
2116 free_menubar_widget_value_tree (first_wv
);
2117 *error
= "Too many dialog items";
2121 wv
= xmalloc_widget_value ();
2123 wv
->name
= (char *) button_names
[nb_buttons
];
2124 if (!NILP (descrip
))
2125 wv
->key
= (char *) SDATA (descrip
);
2126 wv
->value
= (char *) SDATA (item_name
);
2127 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2128 wv
->enabled
= !NILP (enable
);
2132 if (! boundary_seen
)
2136 i
+= MENU_ITEMS_ITEM_LENGTH
;
2139 /* If the boundary was not specified,
2140 by default put half on the left and half on the right. */
2141 if (! boundary_seen
)
2142 left_count
= nb_buttons
- nb_buttons
/ 2;
2144 wv
= xmalloc_widget_value ();
2145 wv
->name
= dialog_name
;
2148 /* Frame title: 'Q' = Question, 'I' = Information.
2149 Can also have 'E' = Error if, one day, we want
2150 a popup for errors. */
2152 dialog_name
[0] = 'Q';
2154 dialog_name
[0] = 'I';
2156 /* Dialog boxes use a really stupid name encoding
2157 which specifies how many buttons to use
2158 and how many buttons are on the right. */
2159 dialog_name
[1] = '0' + nb_buttons
;
2160 dialog_name
[2] = 'B';
2161 dialog_name
[3] = 'R';
2162 /* Number of buttons to put on the right. */
2163 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2165 wv
->contents
= first_wv
;
2169 /* Actually create the dialog. */
2170 dialog_id
= widget_id_tick
++;
2171 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2172 f
->output_data
.w32
->widget
, 1, 0,
2173 dialog_selection_callback
, 0);
2174 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2176 /* Free the widget_value objects we used to specify the contents. */
2177 free_menubar_widget_value_tree (first_wv
);
2179 /* No selection has been chosen yet. */
2180 menu_item_selection
= 0;
2182 /* Display the menu. */
2183 lw_pop_up_all_widgets (dialog_id
);
2185 /* Process events that apply to the menu. */
2186 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2188 lw_destroy_all_widgets (dialog_id
);
2190 /* Find the selected item, and its pane, to return
2191 the proper value. */
2192 if (menu_item_selection
!= 0)
2198 while (i
< menu_items_used
)
2202 if (EQ (AREF (menu_items
, i
), Qt
))
2204 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2205 i
+= MENU_ITEMS_PANE_LENGTH
;
2209 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2210 if (menu_item_selection
== i
)
2214 entry
= Fcons (entry
, Qnil
);
2216 entry
= Fcons (prefix
, entry
);
2220 i
+= MENU_ITEMS_ITEM_LENGTH
;
2225 /* Make "Cancel" equivalent to C-g. */
2226 Fsignal (Qquit
, Qnil
);
2230 #else /* !HAVE_DIALOGS */
2232 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
2233 simple dialogs. We could handle a few more, but I'm not aware of
2234 anywhere in Emacs that uses the other specific dialog choices that
2235 MessageBox provides. */
2237 static int is_simple_dialog (contents
)
2238 Lisp_Object contents
;
2240 Lisp_Object options
= XCDR (contents
);
2241 Lisp_Object name
, yes
, no
, other
;
2243 yes
= build_string ("Yes");
2244 no
= build_string ("No");
2246 if (!CONSP (options
))
2249 name
= XCAR (XCAR (options
));
2250 if (!CONSP (options
))
2253 if (!NILP (Fstring_equal (name
, yes
)))
2255 else if (!NILP (Fstring_equal (name
, no
)))
2260 options
= XCDR (options
);
2261 if (!CONSP (options
))
2264 name
= XCAR (XCAR (options
));
2265 if (NILP (Fstring_equal (name
, other
)))
2268 /* Check there are no more options. */
2269 options
= XCDR (options
);
2270 return !(CONSP (options
));
2273 static Lisp_Object
simple_dialog_show (f
, contents
, header
)
2275 Lisp_Object contents
, header
;
2280 Lisp_Object lispy_answer
= Qnil
, temp
= XCAR (contents
);
2283 text
= SDATA (temp
);
2290 type
= MB_ICONQUESTION
;
2294 title
= "Information";
2295 type
= MB_ICONINFORMATION
;
2299 /* Since we only handle Yes/No dialogs, and we already checked
2300 is_simple_dialog, we don't need to worry about checking contents
2301 to see what type of dialog to use. */
2302 answer
= MessageBox (FRAME_W32_WINDOW (f
), text
, title
, type
);
2304 if (answer
== IDYES
)
2305 lispy_answer
= build_string ("Yes");
2306 else if (answer
== IDNO
)
2307 lispy_answer
= build_string ("No");
2309 Fsignal (Qquit
, Qnil
);
2311 for (temp
= XCDR (contents
); CONSP (temp
); temp
= XCDR (temp
))
2313 Lisp_Object item
, name
, value
;
2318 value
= XCDR (item
);
2326 if (!NILP (Fstring_equal (name
, lispy_answer
)))
2331 Fsignal (Qquit
, Qnil
);
2334 #endif /* !HAVE_DIALOGS */
2337 /* Is this item a separator? */
2339 name_is_separator (name
)
2344 /* Check if name string consists of only dashes ('-'). */
2345 while (*name
== '-') name
++;
2346 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2347 or "--deep-shadow". We don't implement them yet, se we just treat
2348 them like normal separators. */
2349 return (*name
== '\0' || start
+ 2 == name
);
2353 /* Indicate boundary between left and right. */
2355 add_left_right_boundary (HMENU menu
)
2357 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2360 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2362 utf8to16 (unsigned char * src
, int len
, WCHAR
* dest
)
2369 *dest
= (WCHAR
) *src
;
2370 dest
++; src
++; len
--;
2372 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2373 else if (*src
< 0xC0)
2377 /* 2 char UTF-8 sequence. */
2378 else if (*src
< 0xE0)
2380 *dest
= (WCHAR
) (((*src
& 0x1f) << 6)
2381 | (*(src
+ 1) & 0x3f));
2382 src
+= 2; len
-= 2; dest
++;
2384 else if (*src
< 0xF0)
2386 *dest
= (WCHAR
) (((*src
& 0x0f) << 12)
2387 | ((*(src
+ 1) & 0x3f) << 6)
2388 | (*(src
+ 2) & 0x3f));
2389 src
+= 3; len
-= 3; dest
++;
2391 else /* Not encodable. Insert Unicode Substitution char. */
2393 *dest
= (WCHAR
) 0xfffd;
2394 src
++; len
--; dest
++;
2401 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2404 char *out_string
, *p
, *q
;
2406 size_t nlen
, orig_len
;
2408 if (name_is_separator (wv
->name
))
2410 fuFlags
= MF_SEPARATOR
;
2416 fuFlags
= MF_STRING
;
2418 fuFlags
= MF_STRING
| MF_GRAYED
;
2420 if (wv
->key
!= NULL
)
2422 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2423 strcpy (out_string
, wv
->name
);
2424 strcat (out_string
, "\t");
2425 strcat (out_string
, wv
->key
);
2428 out_string
= wv
->name
;
2430 /* Quote any special characters within the menu item's text and
2432 nlen
= orig_len
= strlen (out_string
);
2433 if (unicode_append_menu
)
2435 /* With UTF-8, & cannot be part of a multibyte character. */
2436 for (p
= out_string
; *p
; p
++)
2444 /* If encoded with the system codepage, use multibyte string
2445 functions in case of multibyte characters that contain '&'. */
2446 for (p
= out_string
; *p
; p
= _mbsinc (p
))
2448 if (_mbsnextc (p
) == '&')
2453 if (nlen
> orig_len
)
2456 out_string
= alloca (nlen
+ 1);
2460 if (unicode_append_menu
)
2468 if (_mbsnextc (p
) == '&')
2483 else if (wv
->title
|| wv
->call_data
== 0)
2485 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2486 we can't deallocate the memory otherwise. */
2487 if (get_menu_item_info
)
2489 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2490 strcpy (out_string
, wv
->name
);
2492 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2494 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2497 fuFlags
= MF_DISABLED
;
2500 /* Draw radio buttons and tickboxes. */
2501 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2502 wv
->button_type
== BUTTON_TYPE_RADIO
))
2503 fuFlags
|= MF_CHECKED
;
2505 fuFlags
|= MF_UNCHECKED
;
2508 if (unicode_append_menu
&& out_string
)
2510 /* Convert out_string from UTF-8 to UTF-16-LE. */
2511 int utf8_len
= strlen (out_string
);
2512 WCHAR
* utf16_string
;
2513 if (fuFlags
& MF_OWNERDRAW
)
2514 utf16_string
= local_alloc ((utf8_len
+ 1) * sizeof (WCHAR
));
2516 utf16_string
= alloca ((utf8_len
+ 1) * sizeof (WCHAR
));
2518 utf8to16 (out_string
, utf8_len
, utf16_string
);
2519 return_value
= unicode_append_menu (menu
, fuFlags
,
2520 item
!= NULL
? (UINT
) item
2521 : (UINT
) wv
->call_data
,
2525 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2526 apparently does exist at least in some cases and appears to be
2527 stubbed out to do nothing. out_string is UTF-8, but since
2528 our standard menus are in English and this is only going to
2529 happen the first time a menu is used, the encoding is
2530 of minor importance compared with menus not working at all. */
2532 AppendMenu (menu
, fuFlags
,
2533 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2535 /* Don't use unicode menus in future. */
2536 unicode_append_menu
= NULL
;
2539 if (unicode_append_menu
&& (fuFlags
& MF_OWNERDRAW
))
2540 local_free (out_string
);
2547 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2551 /* This must be done after the menu item is created. */
2552 if (!wv
->title
&& wv
->call_data
!= 0)
2554 if (set_menu_item_info
)
2557 bzero (&info
, sizeof (info
));
2558 info
.cbSize
= sizeof (info
);
2559 info
.fMask
= MIIM_DATA
;
2561 /* Set help string for menu item. Leave it as a Lisp_Object
2562 until it is ready to be displayed, since GC can happen while
2563 menus are active. */
2564 if (!NILP (wv
->help
))
2565 #ifdef USE_LISP_UNION_TYPE
2566 info
.dwItemData
= (DWORD
) (wv
->help
).i
;
2568 info
.dwItemData
= (DWORD
) (wv
->help
);
2570 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2572 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2573 RADIO items, but is not available on NT 3.51 and earlier. */
2574 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2575 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2576 info
.dwTypeData
= out_string
;
2577 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2580 set_menu_item_info (menu
,
2581 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2585 return return_value
;
2588 /* Construct native Windows menu(bar) based on widget_value tree. */
2590 fill_in_menu (HMENU menu
, widget_value
*wv
)
2592 int items_added
= 0;
2594 for ( ; wv
!= NULL
; wv
= wv
->next
)
2598 HMENU sub_menu
= CreatePopupMenu ();
2600 if (sub_menu
== NULL
)
2603 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2604 !add_menu_item (menu
, wv
, sub_menu
))
2606 DestroyMenu (sub_menu
);
2612 if (!add_menu_item (menu
, wv
, NULL
))
2619 /* Display help string for currently pointed to menu item. Not
2620 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2623 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2625 if (get_menu_item_info
)
2627 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2628 Lisp_Object frame
, help
;
2630 /* No help echo on owner-draw menu items, or when the keyboard is used
2631 to navigate the menus, since tooltips are distracting if they pop
2633 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
2634 || !(flags
& MF_MOUSESELECT
))
2640 bzero (&info
, sizeof (info
));
2641 info
.cbSize
= sizeof (info
);
2642 info
.fMask
= MIIM_DATA
;
2643 get_menu_item_info (menu
, item
, FALSE
, &info
);
2645 #ifdef USE_LISP_UNION_TYPE
2646 help
= info
.dwItemData
? (Lisp_Object
) ((EMACS_INT
) info
.dwItemData
)
2649 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2653 /* Store the help echo in the keyboard buffer as the X toolkit
2654 version does, rather than directly showing it. This seems to
2655 solve the GC problems that were present when we based the
2656 Windows code on the non-toolkit version. */
2659 XSETFRAME (frame
, f
);
2660 kbd_buffer_store_help_event (frame
, help
);
2663 /* X version has a loop through frames here, which doesn't
2664 appear to do anything, unless it has some side effect. */
2665 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2669 /* Free memory used by owner-drawn strings. */
2671 w32_free_submenu_strings (menu
)
2674 int i
, num
= GetMenuItemCount (menu
);
2675 for (i
= 0; i
< num
; i
++)
2678 bzero (&info
, sizeof (info
));
2679 info
.cbSize
= sizeof (info
);
2680 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2682 get_menu_item_info (menu
, i
, TRUE
, &info
);
2684 /* Owner-drawn names are held in dwItemData. */
2685 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2688 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2690 local_free (info
.dwItemData
);
2693 /* Recurse down submenus. */
2695 w32_free_submenu_strings (info
.hSubMenu
);
2700 w32_free_menu_strings (hwnd
)
2703 HMENU menu
= current_popup_menu
;
2705 if (get_menu_item_info
)
2707 /* If there is no popup menu active, free the strings from the frame's
2710 menu
= GetMenu (hwnd
);
2713 w32_free_submenu_strings (menu
);
2716 current_popup_menu
= NULL
;
2719 #endif /* HAVE_MENUS */
2721 /* The following is used by delayed window autoselection. */
2723 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p
, Smenu_or_popup_active_p
, 0, 0, 0,
2724 doc
: /* Return t if a menu or popup dialog is active on selected frame. */)
2729 f
= SELECTED_FRAME ();
2730 return (f
->output_data
.w32
->menubar_active
> 0) ? Qt
: Qnil
;
2733 #endif /* HAVE_MENUS */
2736 void syms_of_w32menu ()
2738 globals_of_w32menu ();
2739 staticpro (&menu_items
);
2742 current_popup_menu
= NULL
;
2744 DEFSYM (Qdebug_on_next_call
, "debug-on-next-call");
2746 defsubr (&Sx_popup_menu
);
2747 defsubr (&Smenu_or_popup_active_p
);
2749 defsubr (&Sx_popup_dialog
);
2754 globals_of_w32menu is used to initialize those global variables that
2755 must always be initialized on startup even when the global variable
2756 initialized is non zero (see the function main in emacs.c).
2757 globals_of_w32menu is called from syms_of_w32menu when the global
2758 variable initialized is 0 and directly from main when initialized
2761 void globals_of_w32menu ()
2763 /* See if Get/SetMenuItemInfo functions are available. */
2764 HMODULE user32
= GetModuleHandle ("user32.dll");
2765 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2766 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
2767 unicode_append_menu
= (AppendMenuW_Proc
) GetProcAddress (user32
, "AppendMenuW");
2770 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2771 (do not change this comment) */