1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
26 #include "termhooks.h"
31 #include "blockinput.h"
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
43 #include <sys/types.h>
46 #include "dispextern.h"
48 #undef HAVE_MULTILINGUAL_MENU
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
54 typedef void * XtPointer
;
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
66 typedef struct _widget_value
70 /* value (meaning depend on widget type) */
72 /* keyboard equivalent. no implications for XtTranslations */
74 /* Help string or nil if none.
75 GC finds this string through the frame's menu_bar_vector
76 or through menu_items. */
80 /* true if selected */
82 /* The type of a button. */
83 enum button_type button_type
;
84 /* true if menu title */
87 /* true if was edited (maintained by get_value) */
89 /* true if has changed (maintained by lw library) */
91 /* true if this widget itself has changed,
92 but not counting the other widgets found in the `next' field. */
93 change_type this_one_change
;
95 /* Contents of the sub-widgets, also selected slot for checkbox */
96 struct _widget_value
* contents
;
97 /* data passed to callback */
99 /* next one in the list */
100 struct _widget_value
* next
;
102 /* slot for the toolkit dependent part. Always initialize to NULL. */
104 /* tell us if we should free the toolkit data slot when freeing the
105 widget_value itself. */
106 Boolean free_toolkit_data
;
108 /* we resource the widget_value structures; this points to the next
109 one on the free list if this one has been deallocated.
111 struct _widget_value
*free_list
;
115 /* Local memory management */
116 #define local_heap (GetProcessHeap ())
117 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
118 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
120 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
121 #define free_widget_value(wv) (local_free ((wv)))
123 /******************************************************************/
130 static HMENU current_popup_menu
;
132 void syms_of_w32menu ();
133 void globals_of_w32menu ();
135 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
139 IN OUT LPMENUITEMINFOA
141 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
148 GetMenuItemInfoA_Proc get_menu_item_info
=NULL
;
149 SetMenuItemInfoA_Proc set_menu_item_info
=NULL
;
151 Lisp_Object Vmenu_updating_frame
;
153 Lisp_Object Qdebug_on_next_call
;
155 extern Lisp_Object Qmenu_bar
;
156 extern Lisp_Object Qmouse_click
, Qevent_kind
;
158 extern Lisp_Object QCtoggle
, QCradio
;
160 extern Lisp_Object Voverriding_local_map
;
161 extern Lisp_Object Voverriding_local_map_menu_flag
;
163 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
165 extern Lisp_Object Qmenu_bar_update_hook
;
167 void set_frame_menubar ();
169 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
170 Lisp_Object
, Lisp_Object
, Lisp_Object
,
171 Lisp_Object
, Lisp_Object
));
173 static Lisp_Object
w32_dialog_show ();
175 static Lisp_Object
w32_menu_show ();
177 static void keymap_panes ();
178 static void single_keymap_panes ();
179 static void single_menu_item ();
180 static void list_of_panes ();
181 static void list_of_items ();
182 void w32_free_menu_strings (HWND
);
184 /* This holds a Lisp vector that holds the results of decoding
185 the keymaps or alist-of-alists that specify a menu.
187 It describes the panes and items within the panes.
189 Each pane is described by 3 elements in the vector:
190 t, the pane name, the pane's prefix key.
191 Then follow the pane's items, with 5 elements per item:
192 the item string, the enable flag, the item's value,
193 the definition, and the equivalent keyboard key's description string.
195 In some cases, multiple levels of menus may be described.
196 A single vector slot containing nil indicates the start of a submenu.
197 A single vector slot containing lambda indicates the end of a submenu.
198 The submenu follows a menu item which is the way to reach the submenu.
200 A single vector slot containing quote indicates that the
201 following items should appear on the right of a dialog box.
203 Using a Lisp vector to hold this information while we decode it
204 takes care of protecting all the data from GC. */
206 #define MENU_ITEMS_PANE_NAME 1
207 #define MENU_ITEMS_PANE_PREFIX 2
208 #define MENU_ITEMS_PANE_LENGTH 3
212 MENU_ITEMS_ITEM_NAME
= 0,
213 MENU_ITEMS_ITEM_ENABLE
,
214 MENU_ITEMS_ITEM_VALUE
,
215 MENU_ITEMS_ITEM_EQUIV_KEY
,
216 MENU_ITEMS_ITEM_DEFINITION
,
217 MENU_ITEMS_ITEM_TYPE
,
218 MENU_ITEMS_ITEM_SELECTED
,
219 MENU_ITEMS_ITEM_HELP
,
220 MENU_ITEMS_ITEM_LENGTH
223 static Lisp_Object menu_items
;
225 /* Number of slots currently allocated in menu_items. */
226 static int menu_items_allocated
;
228 /* This is the index in menu_items of the first empty slot. */
229 static int menu_items_used
;
231 /* The number of panes currently recorded in menu_items,
232 excluding those within submenus. */
233 static int menu_items_n_panes
;
235 /* Current depth within submenus. */
236 static int menu_items_submenu_depth
;
238 /* Flag which when set indicates a dialog or menu has been posted by
239 Xt on behalf of one of the widget sets. */
240 static int popup_activated_flag
;
242 static int next_menubar_widget_id
;
244 /* This is set nonzero after the user activates the menu bar, and set
245 to zero again after the menu bars are redisplayed by prepare_menu_bar.
246 While it is nonzero, all calls to set_frame_menubar go deep.
248 I don't understand why this is needed, but it does seem to be
249 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
251 int pending_menu_activation
;
254 /* Return the frame whose ->output_data.w32->menubar_widget equals
257 static struct frame
*
258 menubar_id_to_frame (id
)
261 Lisp_Object tail
, frame
;
264 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
267 if (!GC_FRAMEP (frame
))
270 if (!FRAME_WINDOW_P (f
))
272 if (f
->output_data
.w32
->menubar_widget
== id
)
278 /* Initialize the menu_items structure if we haven't already done so.
279 Also mark it as currently empty. */
284 if (NILP (menu_items
))
286 menu_items_allocated
= 60;
287 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
291 menu_items_n_panes
= 0;
292 menu_items_submenu_depth
= 0;
295 /* Call at the end of generating the data in menu_items.
296 This fills in the number of items in the last pane. */
303 /* Call when finished using the data for the current menu
307 discard_menu_items ()
309 /* Free the structure if it is especially large.
310 Otherwise, hold on to it, to save time. */
311 if (menu_items_allocated
> 200)
314 menu_items_allocated
= 0;
318 /* Make the menu_items vector twice as large. */
324 int old_size
= menu_items_allocated
;
327 menu_items_allocated
*= 2;
328 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
329 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
330 old_size
* sizeof (Lisp_Object
));
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
);
342 menu_items_submenu_depth
++;
350 if (menu_items_used
+ 1 > menu_items_allocated
)
353 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
);
368 /* Start a new menu pane in menu_items.
369 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
372 push_menu_pane (name
, prefix_vec
)
373 Lisp_Object name
, prefix_vec
;
375 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
378 if (menu_items_submenu_depth
== 0)
379 menu_items_n_panes
++;
380 ASET (menu_items
, menu_items_used
++, Qt
);
381 ASET (menu_items
, menu_items_used
++, name
);
382 ASET (menu_items
, menu_items_used
++, prefix_vec
);
385 /* Push one menu item into the current pane. NAME is the string to
386 display. ENABLE if non-nil means this item can be selected. KEY
387 is the key generated by choosing this item, or nil if this item
388 doesn't really have a definition. DEF is the definition of this
389 item. EQUIV is the textual description of the keyboard equivalent
390 for this item (or nil if none). TYPE is the type of this menu
391 item, one of nil, `toggle' or `radio'. */
394 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
395 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
397 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
400 ASET (menu_items
, menu_items_used
++, name
);
401 ASET (menu_items
, menu_items_used
++, enable
);
402 ASET (menu_items
, menu_items_used
++, key
);
403 ASET (menu_items
, menu_items_used
++, equiv
);
404 ASET (menu_items
, menu_items_used
++, def
);
405 ASET (menu_items
, menu_items_used
++, type
);
406 ASET (menu_items
, menu_items_used
++, selected
);
407 ASET (menu_items
, menu_items_used
++, help
);
410 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
411 and generate menu panes for them in menu_items.
412 If NOTREAL is nonzero,
413 don't bother really computing whether an item is enabled. */
416 keymap_panes (keymaps
, nmaps
, notreal
)
417 Lisp_Object
*keymaps
;
425 /* Loop over the given keymaps, making a pane for each map.
426 But don't make a pane that is empty--ignore that map instead.
427 P is the number of panes we have made so far. */
428 for (mapno
= 0; mapno
< nmaps
; mapno
++)
429 single_keymap_panes (keymaps
[mapno
],
430 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
432 finish_menu_items ();
435 /* This is a recursive subroutine of keymap_panes.
436 It handles one keymap, KEYMAP.
437 The other arguments are passed along
438 or point to local variables of the previous function.
439 If NOTREAL is nonzero, only check for equivalent key bindings, don't
440 evaluate expressions in menu items and don't make any menu.
442 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
445 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
447 Lisp_Object pane_name
;
452 Lisp_Object pending_maps
= Qnil
;
453 Lisp_Object tail
, item
;
454 struct gcpro gcpro1
, gcpro2
;
459 push_menu_pane (pane_name
, prefix
);
461 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
463 GCPRO2 (keymap
, pending_maps
);
464 /* Look at each key binding, and if it is a menu item add it
468 single_menu_item (XCAR (item
), XCDR (item
),
469 &pending_maps
, notreal
, maxdepth
);
470 else if (VECTORP (item
))
472 /* Loop over the char values represented in the vector. */
473 int len
= ASIZE (item
);
475 for (c
= 0; c
< len
; c
++)
477 Lisp_Object character
;
478 XSETFASTINT (character
, c
);
479 single_menu_item (character
, AREF (item
, c
),
480 &pending_maps
, notreal
, maxdepth
);
486 /* Process now any submenus which want to be panes at this level. */
487 while (!NILP (pending_maps
))
489 Lisp_Object elt
, eltcdr
, string
;
490 elt
= Fcar (pending_maps
);
492 string
= XCAR (eltcdr
);
493 /* We no longer discard the @ from the beginning of the string here.
494 Instead, we do this in w32_menu_show. */
495 single_keymap_panes (Fcar (elt
), string
,
496 XCDR (eltcdr
), notreal
, maxdepth
- 1);
497 pending_maps
= Fcdr (pending_maps
);
501 /* This is a subroutine of single_keymap_panes that handles one
503 KEY is a key in a keymap and ITEM is its binding.
504 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
506 If NOTREAL is nonzero, only check for equivalent key bindings, don't
507 evaluate expressions in menu items and don't make any menu.
508 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
511 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
512 Lisp_Object key
, item
;
513 Lisp_Object
*pending_maps_ptr
;
514 int maxdepth
, notreal
;
516 Lisp_Object map
, item_string
, enabled
;
517 struct gcpro gcpro1
, gcpro2
;
520 /* Parse the menu item and leave the result in item_properties. */
522 res
= parse_menu_item (item
, notreal
, 0);
525 return; /* Not a menu item. */
527 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
531 /* We don't want to make a menu, just traverse the keymaps to
532 precompute equivalent key bindings. */
534 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
538 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
539 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
541 if (!NILP (map
) && SREF (item_string
, 0) == '@')
544 /* An enabled separate pane. Remember this to handle it later. */
545 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
550 push_menu_item (item_string
, enabled
, key
,
551 AREF (item_properties
, ITEM_PROPERTY_DEF
),
552 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
553 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
554 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
555 AREF (item_properties
, ITEM_PROPERTY_HELP
));
557 /* Display a submenu using the toolkit. */
558 if (! (NILP (map
) || NILP (enabled
)))
560 push_submenu_start ();
561 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
566 /* Push all the panes and items of a menu described by the
567 alist-of-alists MENU.
568 This handles old-fashioned calls to x-popup-menu. */
578 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
580 Lisp_Object elt
, pane_name
, pane_data
;
582 pane_name
= Fcar (elt
);
583 CHECK_STRING (pane_name
);
584 push_menu_pane (pane_name
, Qnil
);
585 pane_data
= Fcdr (elt
);
586 CHECK_CONS (pane_data
);
587 list_of_items (pane_data
);
590 finish_menu_items ();
593 /* Push the items in a single pane defined by the alist PANE. */
599 Lisp_Object tail
, item
, item1
;
601 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
605 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
606 else if (NILP (item
))
607 push_left_right_boundary ();
612 CHECK_STRING (item1
);
613 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
618 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
619 doc
: /* Pop up a deck-of-cards menu and return user's selection.
620 POSITION is a position specification. This is either a mouse button
621 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
622 are positions in pixels from the top left corner of WINDOW's frame
623 \(WINDOW may be a frame object instead of a window). This controls the
624 position of the center of the first line in the first pane of the
625 menu, not the top left of the menu as a whole. If POSITION is t, it
626 means to use the current mouse position.
628 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
629 The menu items come from key bindings that have a menu string as well as
630 a definition; actually, the \"definition\" in such a key binding looks like
631 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
632 the keymap as a top-level element.
634 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
635 Otherwise, REAL-DEFINITION should be a valid key binding definition.
637 You can also use a list of keymaps as MENU. Then each keymap makes a
638 separate pane. When MENU is a keymap or a list of keymaps, the return
639 value is a list of events.
641 Alternatively, you can specify a menu of multiple panes with a list of
642 the form (TITLE PANE1 PANE2...), where each pane is a list of
643 form (TITLE ITEM1 ITEM2...).
644 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
645 appear as an item--that makes a nonselectable line in the menu.
646 With this form of menu, the return value is VALUE from the chosen item.
648 If POSITION is nil, don't display the menu at all, just precalculate the
649 cached information about equivalent key sequences. */)
651 Lisp_Object position
, menu
;
653 Lisp_Object keymap
, tem
;
654 int xpos
= 0, ypos
= 0;
657 Lisp_Object selection
;
659 Lisp_Object x
, y
, window
;
665 if (! NILP (position
))
669 /* Decode the first argument: find the window and the coordinates. */
670 if (EQ (position
, Qt
)
671 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
672 || EQ (XCAR (position
), Qtool_bar
))))
674 /* Use the mouse's current position. */
675 FRAME_PTR new_f
= SELECTED_FRAME ();
676 Lisp_Object bar_window
;
677 enum scroll_bar_part part
;
680 if (mouse_position_hook
)
681 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
682 &part
, &x
, &y
, &time
);
684 XSETFRAME (window
, new_f
);
687 window
= selected_window
;
694 tem
= Fcar (position
);
697 window
= Fcar (Fcdr (position
));
699 y
= Fcar (Fcdr (tem
));
704 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
705 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
706 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
715 /* Decode where to put the menu. */
723 else if (WINDOWP (window
))
725 CHECK_LIVE_WINDOW (window
);
726 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
728 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
729 * XFASTINT (XWINDOW (window
)->left
));
730 ypos
= (FRAME_LINE_HEIGHT (f
)
731 * XFASTINT (XWINDOW (window
)->top
));
734 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
735 but I don't want to make one now. */
736 CHECK_WINDOW (window
);
741 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 exist yet, does nothing
824 until the `menu_free_timer' has freed them (see w32fns.c).
826 if (current_popup_menu
)
828 discard_menu_items ();
833 /* Display them in a menu. */
836 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
837 keymaps
, title
, &error_name
);
840 discard_menu_items ();
841 #endif /* HAVE_MENUS */
845 if (error_name
) error (error_name
);
851 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
852 doc
: /* Pop up a dialog box and return user's selection.
853 POSITION specifies which frame to use.
854 This is normally a mouse button event or a window or frame.
855 If POSITION is t, it means to use the frame the mouse is on.
856 The dialog box appears in the middle of the specified frame.
858 CONTENTS specifies the alternatives to display in the dialog box.
859 It is a list of the form (TITLE ITEM1 ITEM2...).
860 Each ITEM is a cons cell (STRING . VALUE).
861 The return value is VALUE from the chosen item.
863 An ITEM may also be just a string--that makes a nonselectable item.
864 An ITEM may also be nil--that means to put all preceding items
865 on the left of the dialog box and all following items on the right.
866 \(By default, approximately half appear on each side.) */)
868 Lisp_Object position
, contents
;
875 /* Decode the first argument: find the window or frame to use. */
876 if (EQ (position
, Qt
)
877 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
878 || EQ (XCAR (position
), Qtool_bar
))))
880 #if 0 /* Using the frame the mouse is on may not be right. */
881 /* Use the mouse's current position. */
882 FRAME_PTR new_f
= SELECTED_FRAME ();
883 Lisp_Object bar_window
;
884 enum scroll_bar_part part
;
888 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
891 XSETFRAME (window
, new_f
);
893 window
= selected_window
;
895 window
= selected_window
;
897 else if (CONSP (position
))
900 tem
= Fcar (position
);
902 window
= Fcar (Fcdr (position
));
905 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
906 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
909 else if (WINDOWP (position
) || FRAMEP (position
))
914 /* Decode where to put the menu. */
918 else if (WINDOWP (window
))
920 CHECK_LIVE_WINDOW (window
);
921 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
924 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
925 but I don't want to make one now. */
926 CHECK_WINDOW (window
);
929 /* Display a menu with these alternatives
930 in the middle of frame F. */
932 Lisp_Object x
, y
, frame
, newpos
;
933 XSETFRAME (frame
, f
);
934 XSETINT (x
, x_pixel_width (f
) / 2);
935 XSETINT (y
, x_pixel_height (f
) / 2);
936 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
938 return Fx_popup_menu (newpos
,
939 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
941 #else /* HAVE_DIALOGS */
945 Lisp_Object selection
;
947 /* Decode the dialog items from what was specified. */
948 title
= Fcar (contents
);
949 CHECK_STRING (title
);
951 list_of_panes (Fcons (contents
, Qnil
));
953 /* Display them in a dialog box. */
955 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
958 discard_menu_items ();
960 if (error_name
) error (error_name
);
963 #endif /* HAVE_DIALOGS */
966 /* Activate the menu bar of frame F.
967 This is called from keyboard.c when it gets the
968 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
970 To activate the menu bar, we signal to the input thread that it can
971 return from the WM_INITMENU message, allowing the normal Windows
972 processing of the menus.
974 But first we recompute the menu bar contents (the whole tree).
976 This way we can safely execute Lisp code. */
979 x_activate_menubar (f
)
982 set_frame_menubar (f
, 0, 1);
984 /* Lock out further menubar changes while active. */
985 f
->output_data
.w32
->menubar_active
= 1;
987 /* Signal input thread to return from WM_INITMENU. */
988 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
991 /* This callback is called from the menu bar pulldown menu
992 when the user makes a selection.
993 Figure out what the user chose
994 and put the appropriate events into the keyboard buffer. */
997 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
999 Lisp_Object prefix
, entry
;
1001 Lisp_Object
*subprefix_stack
;
1002 int submenu_depth
= 0;
1008 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1009 vector
= f
->menu_bar_vector
;
1012 while (i
< f
->menu_bar_items_used
)
1014 if (EQ (AREF (vector
, i
), Qnil
))
1016 subprefix_stack
[submenu_depth
++] = prefix
;
1020 else if (EQ (AREF (vector
, i
), Qlambda
))
1022 prefix
= subprefix_stack
[--submenu_depth
];
1025 else if (EQ (AREF (vector
, i
), Qt
))
1027 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1028 i
+= MENU_ITEMS_PANE_LENGTH
;
1032 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1033 /* The EMACS_INT cast avoids a warning. There's no problem
1034 as long as pointers have enough bits to hold small integers. */
1035 if ((int) (EMACS_INT
) client_data
== i
)
1038 struct input_event buf
;
1041 XSETFRAME (frame
, f
);
1042 buf
.kind
= MENU_BAR_EVENT
;
1043 buf
.frame_or_window
= frame
;
1045 kbd_buffer_store_event (&buf
);
1047 for (j
= 0; j
< submenu_depth
; j
++)
1048 if (!NILP (subprefix_stack
[j
]))
1050 buf
.kind
= MENU_BAR_EVENT
;
1051 buf
.frame_or_window
= frame
;
1052 buf
.arg
= subprefix_stack
[j
];
1053 kbd_buffer_store_event (&buf
);
1058 buf
.kind
= MENU_BAR_EVENT
;
1059 buf
.frame_or_window
= frame
;
1061 kbd_buffer_store_event (&buf
);
1064 buf
.kind
= MENU_BAR_EVENT
;
1065 buf
.frame_or_window
= frame
;
1067 kbd_buffer_store_event (&buf
);
1069 /* Free memory used by owner-drawn and help-echo strings. */
1070 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1071 f
->output_data
.w32
->menu_command_in_progress
= 0;
1072 f
->output_data
.w32
->menubar_active
= 0;
1075 i
+= MENU_ITEMS_ITEM_LENGTH
;
1078 /* Free memory used by owner-drawn and help-echo strings. */
1079 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1080 f
->output_data
.w32
->menu_command_in_progress
= 0;
1081 f
->output_data
.w32
->menubar_active
= 0;
1084 /* Allocate a widget_value, blocking input. */
1087 xmalloc_widget_value ()
1089 widget_value
*value
;
1092 value
= malloc_widget_value ();
1098 /* This recursively calls free_widget_value on the tree of widgets.
1099 It must free all data that was malloc'ed for these widget_values.
1100 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1101 must be left alone. */
1104 free_menubar_widget_value_tree (wv
)
1109 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1111 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1113 free_menubar_widget_value_tree (wv
->contents
);
1114 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1118 free_menubar_widget_value_tree (wv
->next
);
1119 wv
->next
= (widget_value
*) 0xDEADBEEF;
1122 free_widget_value (wv
);
1126 /* Set up data i menu_items for a menu bar item
1127 whose event type is ITEM_KEY (with string ITEM_NAME)
1128 and whose contents come from the list of keymaps MAPS. */
1131 parse_single_submenu (item_key
, item_name
, maps
)
1132 Lisp_Object item_key
, item_name
, maps
;
1136 Lisp_Object
*mapvec
;
1138 int top_level_items
= 0;
1140 length
= Flength (maps
);
1141 len
= XINT (length
);
1143 /* Convert the list MAPS into a vector MAPVEC. */
1144 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1145 for (i
= 0; i
< len
; i
++)
1147 mapvec
[i
] = Fcar (maps
);
1151 /* Loop over the given keymaps, making a pane for each map.
1152 But don't make a pane that is empty--ignore that map instead. */
1153 for (i
= 0; i
< len
; i
++)
1155 if (SYMBOLP (mapvec
[i
])
1156 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1158 /* Here we have a command at top level in the menu bar
1159 as opposed to a submenu. */
1160 top_level_items
= 1;
1161 push_menu_pane (Qnil
, Qnil
);
1162 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1163 Qnil
, Qnil
, Qnil
, Qnil
);
1166 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1169 return top_level_items
;
1173 /* Create a tree of widget_value objects
1174 representing the panes and items
1175 in menu_items starting at index START, up to index END. */
1177 static widget_value
*
1178 digest_single_submenu (start
, end
, top_level_items
)
1181 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1183 int submenu_depth
= 0;
1184 widget_value
**submenu_stack
;
1187 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1188 wv
= xmalloc_widget_value ();
1192 wv
->button_type
= BUTTON_TYPE_NONE
;
1198 /* Loop over all panes and items made during this call
1199 and construct a tree of widget_value objects.
1200 Ignore the panes and items made by previous calls to
1201 single_submenu, even though those are also in menu_items. */
1205 if (EQ (AREF (menu_items
, i
), Qnil
))
1207 submenu_stack
[submenu_depth
++] = save_wv
;
1212 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1215 save_wv
= submenu_stack
[--submenu_depth
];
1218 else if (EQ (AREF (menu_items
, i
), Qt
)
1219 && submenu_depth
!= 0)
1220 i
+= MENU_ITEMS_PANE_LENGTH
;
1221 /* Ignore a nil in the item list.
1222 It's meaningful only for dialog boxes. */
1223 else if (EQ (AREF (menu_items
, i
), Qquote
))
1225 else if (EQ (AREF (menu_items
, i
), Qt
))
1227 /* Create a new pane. */
1228 Lisp_Object pane_name
, prefix
;
1231 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1232 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1234 #ifndef HAVE_MULTILINGUAL_MENU
1235 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1237 pane_name
= ENCODE_SYSTEM (pane_name
);
1238 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1241 pane_string
= (NILP (pane_name
)
1242 ? "" : (char *) SDATA (pane_name
));
1243 /* If there is just one top-level pane, put all its items directly
1244 under the top-level menu. */
1245 if (menu_items_n_panes
== 1)
1248 /* If the pane has a meaningful name,
1249 make the pane a top-level menu item
1250 with its items as a submenu beneath it. */
1251 if (strcmp (pane_string
, ""))
1253 wv
= xmalloc_widget_value ();
1257 first_wv
->contents
= wv
;
1258 wv
->name
= pane_string
;
1259 /* Ignore the @ that means "separate pane".
1260 This is a kludge, but this isn't worth more time. */
1261 if (!NILP (prefix
) && wv
->name
[0] == '@')
1265 wv
->button_type
= BUTTON_TYPE_NONE
;
1270 i
+= MENU_ITEMS_PANE_LENGTH
;
1274 /* Create a new item within current pane. */
1275 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1278 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1279 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1280 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1281 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1282 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1283 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1284 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1286 #ifndef HAVE_MULTILINGUAL_MENU
1287 if (STRING_MULTIBYTE (item_name
))
1289 item_name
= ENCODE_SYSTEM (item_name
);
1290 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1293 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1295 descrip
= ENCODE_SYSTEM (descrip
);
1296 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1298 #endif /* not HAVE_MULTILINGUAL_MENU */
1300 wv
= xmalloc_widget_value ();
1304 save_wv
->contents
= wv
;
1306 wv
->name
= (char *) SDATA (item_name
);
1307 if (!NILP (descrip
))
1308 wv
->key
= (char *) SDATA (descrip
);
1310 /* The EMACS_INT cast avoids a warning. There's no problem
1311 as long as pointers have enough bits to hold small integers. */
1312 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1313 wv
->enabled
= !NILP (enable
);
1316 wv
->button_type
= BUTTON_TYPE_NONE
;
1317 else if (EQ (type
, QCradio
))
1318 wv
->button_type
= BUTTON_TYPE_RADIO
;
1319 else if (EQ (type
, QCtoggle
))
1320 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1324 wv
->selected
= !NILP (selected
);
1325 if (!STRINGP (help
))
1332 i
+= MENU_ITEMS_ITEM_LENGTH
;
1336 /* If we have just one "menu item"
1337 that was originally a button, return it by itself. */
1338 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1340 wv
= first_wv
->contents
;
1341 free_widget_value (first_wv
);
1348 /* Set the contents of the menubar widgets of frame F.
1349 The argument FIRST_TIME is currently ignored;
1350 it is set the first time this is called, from initialize_frame_menubar. */
1353 set_frame_menubar (f
, first_time
, deep_p
)
1358 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1360 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1362 int *submenu_start
, *submenu_end
;
1363 int *submenu_top_level_items
;
1365 /* We must not change the menubar when actually in use. */
1366 if (f
->output_data
.w32
->menubar_active
)
1369 XSETFRAME (Vmenu_updating_frame
, f
);
1371 if (! menubar_widget
)
1373 else if (pending_menu_activation
&& !deep_p
)
1378 /* Make a widget-value tree representing the entire menu trees. */
1380 struct buffer
*prev
= current_buffer
;
1382 int specpdl_count
= SPECPDL_INDEX ();
1383 int previous_menu_items_used
= f
->menu_bar_items_used
;
1384 Lisp_Object
*previous_items
1385 = (Lisp_Object
*) alloca (previous_menu_items_used
1386 * sizeof (Lisp_Object
));
1388 /* If we are making a new widget, its contents are empty,
1389 do always reinitialize them. */
1390 if (! menubar_widget
)
1391 previous_menu_items_used
= 0;
1393 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1394 specbind (Qinhibit_quit
, Qt
);
1395 /* Don't let the debugger step into this code
1396 because it is not reentrant. */
1397 specbind (Qdebug_on_next_call
, Qnil
);
1399 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1400 if (NILP (Voverriding_local_map_menu_flag
))
1402 specbind (Qoverriding_terminal_local_map
, Qnil
);
1403 specbind (Qoverriding_local_map
, Qnil
);
1406 set_buffer_internal_1 (XBUFFER (buffer
));
1408 /* Run the Lucid hook. */
1409 safe_run_hooks (Qactivate_menubar_hook
);
1410 /* If it has changed current-menubar from previous value,
1411 really recompute the menubar from the value. */
1412 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1413 call0 (Qrecompute_lucid_menubar
);
1414 safe_run_hooks (Qmenu_bar_update_hook
);
1415 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1417 items
= FRAME_MENU_BAR_ITEMS (f
);
1419 /* Save the frame's previous menu bar contents data. */
1420 if (previous_menu_items_used
)
1421 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1422 previous_menu_items_used
* sizeof (Lisp_Object
));
1424 /* Fill in menu_items with the current menu bar contents.
1425 This can evaluate Lisp code. */
1426 menu_items
= f
->menu_bar_vector
;
1427 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1428 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1429 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1430 submenu_top_level_items
1431 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1433 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1435 Lisp_Object key
, string
, maps
;
1439 key
= AREF (items
, i
);
1440 string
= AREF (items
, i
+ 1);
1441 maps
= AREF (items
, i
+ 2);
1445 submenu_start
[i
] = menu_items_used
;
1447 menu_items_n_panes
= 0;
1448 submenu_top_level_items
[i
]
1449 = parse_single_submenu (key
, string
, maps
);
1451 submenu_end
[i
] = menu_items_used
;
1454 finish_menu_items ();
1456 /* Convert menu_items into widget_value trees
1457 to display the menu. This cannot evaluate Lisp code. */
1459 wv
= xmalloc_widget_value ();
1460 wv
->name
= "menubar";
1463 wv
->button_type
= BUTTON_TYPE_NONE
;
1467 for (i
= 0; i
< last_i
; i
+= 4)
1469 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1470 submenu_top_level_items
[i
]);
1474 first_wv
->contents
= wv
;
1475 /* Don't set wv->name here; GC during the loop might relocate it. */
1477 wv
->button_type
= BUTTON_TYPE_NONE
;
1481 set_buffer_internal_1 (prev
);
1482 unbind_to (specpdl_count
, Qnil
);
1484 /* If there has been no change in the Lisp-level contents
1485 of the menu bar, skip redisplaying it. Just exit. */
1487 for (i
= 0; i
< previous_menu_items_used
; i
++)
1488 if (menu_items_used
== i
1489 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1491 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1493 free_menubar_widget_value_tree (first_wv
);
1499 /* Now GC cannot happen during the lifetime of the widget_value,
1500 so it's safe to store data from a Lisp_String, as long as
1501 local copies are made when the actual menu is created.
1502 Windows takes care of this for normal string items, but
1503 not for owner-drawn items or additional item-info. */
1504 wv
= first_wv
->contents
;
1505 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1508 string
= AREF (items
, i
+ 1);
1511 wv
->name
= (char *) SDATA (string
);
1515 f
->menu_bar_vector
= menu_items
;
1516 f
->menu_bar_items_used
= menu_items_used
;
1521 /* Make a widget-value tree containing
1522 just the top level menu bar strings. */
1524 wv
= xmalloc_widget_value ();
1525 wv
->name
= "menubar";
1528 wv
->button_type
= BUTTON_TYPE_NONE
;
1532 items
= FRAME_MENU_BAR_ITEMS (f
);
1533 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1537 string
= AREF (items
, i
+ 1);
1541 wv
= xmalloc_widget_value ();
1542 wv
->name
= (char *) SDATA (string
);
1545 wv
->button_type
= BUTTON_TYPE_NONE
;
1547 /* This prevents lwlib from assuming this
1548 menu item is really supposed to be empty. */
1549 /* The EMACS_INT cast avoids a warning.
1550 This value just has to be different from small integers. */
1551 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1556 first_wv
->contents
= wv
;
1560 /* Forget what we thought we knew about what is in the
1561 detailed contents of the menu bar menus.
1562 Changing the top level always destroys the contents. */
1563 f
->menu_bar_items_used
= 0;
1566 /* Create or update the menu bar widget. */
1572 /* Empty current menubar, rather than creating a fresh one. */
1573 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1578 menubar_widget
= CreateMenu ();
1580 fill_in_menu (menubar_widget
, first_wv
->contents
);
1582 free_menubar_widget_value_tree (first_wv
);
1585 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1587 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1588 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1589 /* Causes flicker when menu bar is updated
1590 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1592 /* Force the window size to be recomputed so that the frame's text
1593 area remains the same, if menubar has just been created. */
1594 if (old_widget
== NULL
)
1595 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1601 /* Called from Fx_create_frame to create the initial menubar of a frame
1602 before it is mapped, so that the window is mapped with the menubar already
1603 there instead of us tacking it on later and thrashing the window after it
1607 initialize_frame_menubar (f
)
1610 /* This function is called before the first chance to redisplay
1611 the frame. It has to be, so the frame will have the right size. */
1612 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1613 set_frame_menubar (f
, 1, 1);
1616 /* Get rid of the menu bar of frame F, and free its storage.
1617 This is used when deleting a frame, and when turning off the menu bar. */
1620 free_frame_menubar (f
)
1626 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1627 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1628 f
->output_data
.w32
->menubar_widget
= NULL
;
1636 /* w32_menu_show actually displays a menu using the panes and items in
1637 menu_items and returns the value selected from it; we assume input
1638 is blocked by the caller. */
1640 /* F is the frame the menu is for.
1641 X and Y are the frame-relative specified position,
1642 relative to the inside upper left corner of the frame F.
1643 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1644 KEYMAPS is 1 if this menu was specified with keymaps;
1645 in that case, we return a list containing the chosen item's value
1646 and perhaps also the pane's prefix.
1647 TITLE is the specified menu title.
1648 ERROR is a place to store an error message string in case of failure.
1649 (We return nil on failure, but the value doesn't actually matter.) */
1652 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1662 int menu_item_selection
;
1665 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1666 widget_value
**submenu_stack
1667 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1668 Lisp_Object
*subprefix_stack
1669 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1670 int submenu_depth
= 0;
1675 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1677 *error
= "Empty menu";
1681 /* Create a tree of widget_value objects
1682 representing the panes and their items. */
1683 wv
= xmalloc_widget_value ();
1687 wv
->button_type
= BUTTON_TYPE_NONE
;
1692 /* Loop over all panes and items, filling in the tree. */
1694 while (i
< menu_items_used
)
1696 if (EQ (AREF (menu_items
, i
), Qnil
))
1698 submenu_stack
[submenu_depth
++] = save_wv
;
1704 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1707 save_wv
= submenu_stack
[--submenu_depth
];
1711 else if (EQ (AREF (menu_items
, i
), Qt
)
1712 && submenu_depth
!= 0)
1713 i
+= MENU_ITEMS_PANE_LENGTH
;
1714 /* Ignore a nil in the item list.
1715 It's meaningful only for dialog boxes. */
1716 else if (EQ (AREF (menu_items
, i
), Qquote
))
1718 else if (EQ (AREF (menu_items
, i
), Qt
))
1720 /* Create a new pane. */
1721 Lisp_Object pane_name
, prefix
;
1723 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1724 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1725 #ifndef HAVE_MULTILINGUAL_MENU
1726 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1728 pane_name
= ENCODE_SYSTEM (pane_name
);
1729 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1732 pane_string
= (NILP (pane_name
)
1733 ? "" : (char *) SDATA (pane_name
));
1734 /* If there is just one top-level pane, put all its items directly
1735 under the top-level menu. */
1736 if (menu_items_n_panes
== 1)
1739 /* If the pane has a meaningful name,
1740 make the pane a top-level menu item
1741 with its items as a submenu beneath it. */
1742 if (!keymaps
&& strcmp (pane_string
, ""))
1744 wv
= xmalloc_widget_value ();
1748 first_wv
->contents
= wv
;
1749 wv
->name
= pane_string
;
1750 if (keymaps
&& !NILP (prefix
))
1754 wv
->button_type
= BUTTON_TYPE_NONE
;
1759 else if (first_pane
)
1765 i
+= MENU_ITEMS_PANE_LENGTH
;
1769 /* Create a new item within current pane. */
1770 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1772 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1773 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1774 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1775 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1776 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1777 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1778 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1780 #ifndef HAVE_MULTILINGUAL_MENU
1781 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1783 item_name
= ENCODE_SYSTEM (item_name
);
1784 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1786 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1788 descrip
= ENCODE_SYSTEM (descrip
);
1789 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1791 #endif /* not HAVE_MULTILINGUAL_MENU */
1793 wv
= xmalloc_widget_value ();
1797 save_wv
->contents
= wv
;
1798 wv
->name
= (char *) SDATA (item_name
);
1799 if (!NILP (descrip
))
1800 wv
->key
= (char *) SDATA (descrip
);
1802 /* Use the contents index as call_data, since we are
1803 restricted to 16-bits. */
1804 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1805 wv
->enabled
= !NILP (enable
);
1808 wv
->button_type
= BUTTON_TYPE_NONE
;
1809 else if (EQ (type
, QCtoggle
))
1810 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1811 else if (EQ (type
, QCradio
))
1812 wv
->button_type
= BUTTON_TYPE_RADIO
;
1816 wv
->selected
= !NILP (selected
);
1817 if (!STRINGP (help
))
1824 i
+= MENU_ITEMS_ITEM_LENGTH
;
1828 /* Deal with the title, if it is non-nil. */
1831 widget_value
*wv_title
= xmalloc_widget_value ();
1832 widget_value
*wv_sep
= xmalloc_widget_value ();
1834 /* Maybe replace this separator with a bitmap or owner-draw item
1835 so that it looks better. Having two separators looks odd. */
1836 wv_sep
->name
= "--";
1837 wv_sep
->next
= first_wv
->contents
;
1838 wv_sep
->help
= Qnil
;
1840 #ifndef HAVE_MULTILINGUAL_MENU
1841 if (STRING_MULTIBYTE (title
))
1842 title
= ENCODE_SYSTEM (title
);
1844 wv_title
->name
= (char *) SDATA (title
);
1845 wv_title
->enabled
= TRUE
;
1846 wv_title
->title
= TRUE
;
1847 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1848 wv_title
->help
= Qnil
;
1849 wv_title
->next
= wv_sep
;
1850 first_wv
->contents
= wv_title
;
1853 /* Actually create the menu. */
1854 current_popup_menu
= menu
= CreatePopupMenu ();
1855 fill_in_menu (menu
, first_wv
->contents
);
1857 /* Adjust coordinates to be root-window-relative. */
1860 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1862 /* No selection has been chosen yet. */
1863 menu_item_selection
= 0;
1865 /* Display the menu. */
1866 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1867 WM_EMACS_TRACKPOPUPMENU
,
1868 (WPARAM
)menu
, (LPARAM
)&pos
);
1870 /* Clean up extraneous mouse events which might have been generated
1872 discard_mouse_events ();
1874 /* Free the widget_value objects we used to specify the contents. */
1875 free_menubar_widget_value_tree (first_wv
);
1879 /* Find the selected item, and its pane, to return
1880 the proper value. */
1881 if (menu_item_selection
!= 0)
1883 Lisp_Object prefix
, entry
;
1885 prefix
= entry
= Qnil
;
1887 while (i
< menu_items_used
)
1889 if (EQ (AREF (menu_items
, i
), Qnil
))
1891 subprefix_stack
[submenu_depth
++] = prefix
;
1895 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1897 prefix
= subprefix_stack
[--submenu_depth
];
1900 else if (EQ (AREF (menu_items
, i
), Qt
))
1902 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1903 i
+= MENU_ITEMS_PANE_LENGTH
;
1905 /* Ignore a nil in the item list.
1906 It's meaningful only for dialog boxes. */
1907 else if (EQ (AREF (menu_items
, i
), Qquote
))
1911 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1912 if (menu_item_selection
== i
)
1918 entry
= Fcons (entry
, Qnil
);
1920 entry
= Fcons (prefix
, entry
);
1921 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1922 if (!NILP (subprefix_stack
[j
]))
1923 entry
= Fcons (subprefix_stack
[j
], entry
);
1927 i
+= MENU_ITEMS_ITEM_LENGTH
;
1937 static char * button_names
[] = {
1938 "button1", "button2", "button3", "button4", "button5",
1939 "button6", "button7", "button8", "button9", "button10" };
1942 w32_dialog_show (f
, keymaps
, title
, error
)
1948 int i
, nb_buttons
=0;
1949 char dialog_name
[6];
1950 int menu_item_selection
;
1952 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1954 /* Number of elements seen so far, before boundary. */
1956 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1957 int boundary_seen
= 0;
1961 if (menu_items_n_panes
> 1)
1963 *error
= "Multiple panes in dialog box";
1967 /* Create a tree of widget_value objects
1968 representing the text label and buttons. */
1970 Lisp_Object pane_name
, prefix
;
1972 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
1973 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
1974 pane_string
= (NILP (pane_name
)
1975 ? "" : (char *) SDATA (pane_name
));
1976 prev_wv
= xmalloc_widget_value ();
1977 prev_wv
->value
= pane_string
;
1978 if (keymaps
&& !NILP (prefix
))
1980 prev_wv
->enabled
= 1;
1981 prev_wv
->name
= "message";
1982 prev_wv
->help
= Qnil
;
1985 /* Loop over all panes and items, filling in the tree. */
1986 i
= MENU_ITEMS_PANE_LENGTH
;
1987 while (i
< menu_items_used
)
1990 /* Create a new item within current pane. */
1991 Lisp_Object item_name
, enable
, descrip
, help
;
1993 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1994 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1995 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1996 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1998 if (NILP (item_name
))
2000 free_menubar_widget_value_tree (first_wv
);
2001 *error
= "Submenu in dialog items";
2004 if (EQ (item_name
, Qquote
))
2006 /* This is the boundary between left-side elts
2007 and right-side elts. Stop incrementing right_count. */
2012 if (nb_buttons
>= 9)
2014 free_menubar_widget_value_tree (first_wv
);
2015 *error
= "Too many dialog items";
2019 wv
= xmalloc_widget_value ();
2021 wv
->name
= (char *) button_names
[nb_buttons
];
2022 if (!NILP (descrip
))
2023 wv
->key
= (char *) SDATA (descrip
);
2024 wv
->value
= (char *) SDATA (item_name
);
2025 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2026 wv
->enabled
= !NILP (enable
);
2030 if (! boundary_seen
)
2034 i
+= MENU_ITEMS_ITEM_LENGTH
;
2037 /* If the boundary was not specified,
2038 by default put half on the left and half on the right. */
2039 if (! boundary_seen
)
2040 left_count
= nb_buttons
- nb_buttons
/ 2;
2042 wv
= xmalloc_widget_value ();
2043 wv
->name
= dialog_name
;
2046 /* Dialog boxes use a really stupid name encoding
2047 which specifies how many buttons to use
2048 and how many buttons are on the right.
2049 The Q means something also. */
2050 dialog_name
[0] = 'Q';
2051 dialog_name
[1] = '0' + nb_buttons
;
2052 dialog_name
[2] = 'B';
2053 dialog_name
[3] = 'R';
2054 /* Number of buttons to put on the right. */
2055 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2057 wv
->contents
= first_wv
;
2061 /* Actually create the dialog. */
2062 dialog_id
= widget_id_tick
++;
2063 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2064 f
->output_data
.w32
->widget
, 1, 0,
2065 dialog_selection_callback
, 0);
2066 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2068 /* Free the widget_value objects we used to specify the contents. */
2069 free_menubar_widget_value_tree (first_wv
);
2071 /* No selection has been chosen yet. */
2072 menu_item_selection
= 0;
2074 /* Display the menu. */
2075 lw_pop_up_all_widgets (dialog_id
);
2076 popup_activated_flag
= 1;
2078 /* Process events that apply to the menu. */
2079 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2081 lw_destroy_all_widgets (dialog_id
);
2083 /* Find the selected item, and its pane, to return
2084 the proper value. */
2085 if (menu_item_selection
!= 0)
2091 while (i
< menu_items_used
)
2095 if (EQ (AREF (menu_items
, i
), Qt
))
2097 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2098 i
+= MENU_ITEMS_PANE_LENGTH
;
2102 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2103 if (menu_item_selection
== i
)
2107 entry
= Fcons (entry
, Qnil
);
2109 entry
= Fcons (prefix
, entry
);
2113 i
+= MENU_ITEMS_ITEM_LENGTH
;
2120 #endif /* HAVE_DIALOGS */
2123 /* Is this item a separator? */
2125 name_is_separator (name
)
2130 /* Check if name string consists of only dashes ('-'). */
2131 while (*name
== '-') name
++;
2132 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2133 or "--deep-shadow". We don't implement them yet, se we just treat
2134 them like normal separators. */
2135 return (*name
== '\0' || start
+ 2 == name
);
2139 /* Indicate boundary between left and right. */
2141 add_left_right_boundary (HMENU menu
)
2143 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2147 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2153 if (name_is_separator (wv
->name
))
2155 fuFlags
= MF_SEPARATOR
;
2161 fuFlags
= MF_STRING
;
2163 fuFlags
= MF_STRING
| MF_GRAYED
;
2165 if (wv
->key
!= NULL
)
2167 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2168 strcpy (out_string
, wv
->name
);
2169 strcat (out_string
, "\t");
2170 strcat (out_string
, wv
->key
);
2173 out_string
= wv
->name
;
2177 else if (wv
->title
|| wv
->call_data
== 0)
2179 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2180 we can't deallocate the memory otherwise. */
2181 if (get_menu_item_info
)
2183 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2184 strcpy (out_string
, wv
->name
);
2186 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2188 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2191 fuFlags
= MF_DISABLED
;
2194 /* Draw radio buttons and tickboxes. */
2195 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2196 wv
->button_type
== BUTTON_TYPE_RADIO
))
2197 fuFlags
|= MF_CHECKED
;
2199 fuFlags
|= MF_UNCHECKED
;
2205 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2208 /* This must be done after the menu item is created. */
2209 if (!wv
->title
&& wv
->call_data
!= 0)
2211 if (set_menu_item_info
)
2214 bzero (&info
, sizeof (info
));
2215 info
.cbSize
= sizeof (info
);
2216 info
.fMask
= MIIM_DATA
;
2218 /* Set help string for menu item. Leave it as a Lisp_Object
2219 until it is ready to be displayed, since GC can happen while
2220 menus are active. */
2222 info
.dwItemData
= (DWORD
) wv
->help
;
2224 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2226 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2227 RADIO items, but is not available on NT 3.51 and earlier. */
2228 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2229 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2230 info
.dwTypeData
= out_string
;
2231 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2234 set_menu_item_info (menu
,
2235 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2239 return return_value
;
2242 /* Construct native Windows menu(bar) based on widget_value tree. */
2244 fill_in_menu (HMENU menu
, widget_value
*wv
)
2246 int items_added
= 0;
2248 for ( ; wv
!= NULL
; wv
= wv
->next
)
2252 HMENU sub_menu
= CreatePopupMenu ();
2254 if (sub_menu
== NULL
)
2257 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2258 !add_menu_item (menu
, wv
, sub_menu
))
2260 DestroyMenu (sub_menu
);
2266 if (!add_menu_item (menu
, wv
, NULL
))
2276 /* popup_activated_flag not actually used on W32 */
2280 /* Display help string for currently pointed to menu item. Not
2281 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2284 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2286 if (get_menu_item_info
)
2288 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2289 Lisp_Object frame
, help
;
2291 // No help echo on owner-draw menu items.
2292 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
)
2298 bzero (&info
, sizeof (info
));
2299 info
.cbSize
= sizeof (info
);
2300 info
.fMask
= MIIM_DATA
;
2301 get_menu_item_info (menu
, item
, FALSE
, &info
);
2303 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2306 /* Store the help echo in the keyboard buffer as the X toolkit
2307 version does, rather than directly showing it. This seems to
2308 solve the GC problems that were present when we based the
2309 Windows code on the non-toolkit version. */
2312 XSETFRAME (frame
, f
);
2313 kbd_buffer_store_help_event (frame
, help
);
2316 /* X version has a loop through frames here, which doesn't
2317 appear to do anything, unless it has some side effect. */
2318 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2322 /* Free memory used by owner-drawn strings. */
2324 w32_free_submenu_strings (menu
)
2327 int i
, num
= GetMenuItemCount (menu
);
2328 for (i
= 0; i
< num
; i
++)
2331 bzero (&info
, sizeof (info
));
2332 info
.cbSize
= sizeof (info
);
2333 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2335 get_menu_item_info (menu
, i
, TRUE
, &info
);
2337 /* Owner-drawn names are held in dwItemData. */
2338 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2341 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2343 local_free (info
.dwItemData
);
2346 /* Recurse down submenus. */
2348 w32_free_submenu_strings (info
.hSubMenu
);
2353 w32_free_menu_strings (hwnd
)
2356 HMENU menu
= current_popup_menu
;
2358 if (get_menu_item_info
)
2360 /* If there is no popup menu active, free the strings from the frame's
2363 menu
= GetMenu (hwnd
);
2366 w32_free_submenu_strings (menu
);
2369 current_popup_menu
= NULL
;
2372 #endif /* HAVE_MENUS */
2374 void syms_of_w32menu ()
2376 globals_of_w32menu ();
2377 staticpro (&menu_items
);
2380 current_popup_menu
= NULL
;
2382 Qdebug_on_next_call
= intern ("debug-on-next-call");
2383 staticpro (&Qdebug_on_next_call
);
2385 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2386 doc
: /* Frame for which we are updating a menu.
2387 The enable predicate for a menu command should check this variable. */);
2388 Vmenu_updating_frame
= Qnil
;
2390 defsubr (&Sx_popup_menu
);
2392 defsubr (&Sx_popup_dialog
);
2397 globals_of_w32menu is used to initialize those global variables that
2398 must always be initialized on startup even when the global variable
2399 initialized is non zero (see the function main in emacs.c).
2400 globals_of_w32menu is called from syms_of_w32menu when the global
2401 variable initialized is 0 and directly from main when initialized
2404 void globals_of_w32menu ()
2406 /* See if Get/SetMenuItemInfo functions are available. */
2407 HMODULE user32
= GetModuleHandle ("user32.dll");
2408 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2409 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");