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 /* LocalAlloc/Free is a reasonably good allocator. */
116 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
117 #define free_widget_value(wv) LocalFree (wv)
119 /******************************************************************/
126 static HMENU current_popup_menu
;
128 FARPROC get_menu_item_info
;
129 FARPROC set_menu_item_info
;
131 Lisp_Object Vmenu_updating_frame
;
133 Lisp_Object Qdebug_on_next_call
;
135 extern Lisp_Object Qmenu_bar
;
136 extern Lisp_Object Qmouse_click
, Qevent_kind
;
138 extern Lisp_Object QCtoggle
, QCradio
;
140 extern Lisp_Object Voverriding_local_map
;
141 extern Lisp_Object Voverriding_local_map_menu_flag
;
143 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
145 extern Lisp_Object Qmenu_bar_update_hook
;
147 void set_frame_menubar ();
149 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
150 Lisp_Object
, Lisp_Object
, Lisp_Object
,
151 Lisp_Object
, Lisp_Object
));
153 static Lisp_Object
w32_dialog_show ();
155 static Lisp_Object
w32_menu_show ();
157 static void keymap_panes ();
158 static void single_keymap_panes ();
159 static void single_menu_item ();
160 static void list_of_panes ();
161 static void list_of_items ();
163 /* This holds a Lisp vector that holds the results of decoding
164 the keymaps or alist-of-alists that specify a menu.
166 It describes the panes and items within the panes.
168 Each pane is described by 3 elements in the vector:
169 t, the pane name, the pane's prefix key.
170 Then follow the pane's items, with 5 elements per item:
171 the item string, the enable flag, the item's value,
172 the definition, and the equivalent keyboard key's description string.
174 In some cases, multiple levels of menus may be described.
175 A single vector slot containing nil indicates the start of a submenu.
176 A single vector slot containing lambda indicates the end of a submenu.
177 The submenu follows a menu item which is the way to reach the submenu.
179 A single vector slot containing quote indicates that the
180 following items should appear on the right of a dialog box.
182 Using a Lisp vector to hold this information while we decode it
183 takes care of protecting all the data from GC. */
185 #define MENU_ITEMS_PANE_NAME 1
186 #define MENU_ITEMS_PANE_PREFIX 2
187 #define MENU_ITEMS_PANE_LENGTH 3
191 MENU_ITEMS_ITEM_NAME
= 0,
192 MENU_ITEMS_ITEM_ENABLE
,
193 MENU_ITEMS_ITEM_VALUE
,
194 MENU_ITEMS_ITEM_EQUIV_KEY
,
195 MENU_ITEMS_ITEM_DEFINITION
,
196 MENU_ITEMS_ITEM_TYPE
,
197 MENU_ITEMS_ITEM_SELECTED
,
198 MENU_ITEMS_ITEM_HELP
,
199 MENU_ITEMS_ITEM_LENGTH
202 static Lisp_Object menu_items
;
204 /* Number of slots currently allocated in menu_items. */
205 static int menu_items_allocated
;
207 /* This is the index in menu_items of the first empty slot. */
208 static int menu_items_used
;
210 /* The number of panes currently recorded in menu_items,
211 excluding those within submenus. */
212 static int menu_items_n_panes
;
214 /* Current depth within submenus. */
215 static int menu_items_submenu_depth
;
217 /* Flag which when set indicates a dialog or menu has been posted by
218 Xt on behalf of one of the widget sets. */
219 static int popup_activated_flag
;
221 static int next_menubar_widget_id
;
223 /* This is set nonzero after the user activates the menu bar, and set
224 to zero again after the menu bars are redisplayed by prepare_menu_bar.
225 While it is nonzero, all calls to set_frame_menubar go deep.
227 I don't understand why this is needed, but it does seem to be
228 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
230 int pending_menu_activation
;
233 /* Return the frame whose ->output_data.w32->menubar_widget equals
236 static struct frame
*
237 menubar_id_to_frame (id
)
240 Lisp_Object tail
, frame
;
243 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
246 if (!GC_FRAMEP (frame
))
249 if (!FRAME_WINDOW_P (f
))
251 if (f
->output_data
.w32
->menubar_widget
== id
)
257 /* Initialize the menu_items structure if we haven't already done so.
258 Also mark it as currently empty. */
263 if (NILP (menu_items
))
265 menu_items_allocated
= 60;
266 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
270 menu_items_n_panes
= 0;
271 menu_items_submenu_depth
= 0;
274 /* Call at the end of generating the data in menu_items.
275 This fills in the number of items in the last pane. */
282 /* Call when finished using the data for the current menu
286 discard_menu_items ()
288 /* Free the structure if it is especially large.
289 Otherwise, hold on to it, to save time. */
290 if (menu_items_allocated
> 200)
293 menu_items_allocated
= 0;
297 /* Make the menu_items vector twice as large. */
303 int old_size
= menu_items_allocated
;
306 menu_items_allocated
*= 2;
307 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
308 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
309 old_size
* sizeof (Lisp_Object
));
312 /* Begin a submenu. */
315 push_submenu_start ()
317 if (menu_items_used
+ 1 > menu_items_allocated
)
320 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
321 menu_items_submenu_depth
++;
329 if (menu_items_used
+ 1 > menu_items_allocated
)
332 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
333 menu_items_submenu_depth
--;
336 /* Indicate boundary between left and right. */
339 push_left_right_boundary ()
341 if (menu_items_used
+ 1 > menu_items_allocated
)
344 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
347 /* Start a new menu pane in menu_items.
348 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
351 push_menu_pane (name
, prefix_vec
)
352 Lisp_Object name
, prefix_vec
;
354 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
357 if (menu_items_submenu_depth
== 0)
358 menu_items_n_panes
++;
359 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
360 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
361 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
364 /* Push one menu item into the current pane. NAME is the string to
365 display. ENABLE if non-nil means this item can be selected. KEY
366 is the key generated by choosing this item, or nil if this item
367 doesn't really have a definition. DEF is the definition of this
368 item. EQUIV is the textual description of the keyboard equivalent
369 for this item (or nil if none). TYPE is the type of this menu
370 item, one of nil, `toggle' or `radio'. */
373 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
374 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
376 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
379 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
380 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
381 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
382 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
383 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
384 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
385 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
386 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
389 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
390 and generate menu panes for them in menu_items.
391 If NOTREAL is nonzero,
392 don't bother really computing whether an item is enabled. */
395 keymap_panes (keymaps
, nmaps
, notreal
)
396 Lisp_Object
*keymaps
;
404 /* Loop over the given keymaps, making a pane for each map.
405 But don't make a pane that is empty--ignore that map instead.
406 P is the number of panes we have made so far. */
407 for (mapno
= 0; mapno
< nmaps
; mapno
++)
408 single_keymap_panes (keymaps
[mapno
],
409 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
411 finish_menu_items ();
414 /* This is a recursive subroutine of keymap_panes.
415 It handles one keymap, KEYMAP.
416 The other arguments are passed along
417 or point to local variables of the previous function.
418 If NOTREAL is nonzero, only check for equivalent key bindings, don't
419 evaluate expressions in menu items and don't make any menu.
421 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
424 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
426 Lisp_Object pane_name
;
431 Lisp_Object pending_maps
= Qnil
;
432 Lisp_Object tail
, item
;
433 struct gcpro gcpro1
, gcpro2
;
438 push_menu_pane (pane_name
, prefix
);
440 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
442 GCPRO2 (keymap
, pending_maps
);
443 /* Look at each key binding, and if it is a menu item add it
447 single_menu_item (XCAR (item
), XCDR (item
),
448 &pending_maps
, notreal
, maxdepth
);
449 else if (VECTORP (item
))
451 /* Loop over the char values represented in the vector. */
452 int len
= XVECTOR (item
)->size
;
454 for (c
= 0; c
< len
; c
++)
456 Lisp_Object character
;
457 XSETFASTINT (character
, c
);
458 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
459 &pending_maps
, notreal
, maxdepth
);
465 /* Process now any submenus which want to be panes at this level. */
466 while (!NILP (pending_maps
))
468 Lisp_Object elt
, eltcdr
, string
;
469 elt
= Fcar (pending_maps
);
471 string
= XCAR (eltcdr
);
472 /* We no longer discard the @ from the beginning of the string here.
473 Instead, we do this in w32_menu_show. */
474 single_keymap_panes (Fcar (elt
), string
,
475 XCDR (eltcdr
), notreal
, maxdepth
- 1);
476 pending_maps
= Fcdr (pending_maps
);
480 /* This is a subroutine of single_keymap_panes that handles one
482 KEY is a key in a keymap and ITEM is its binding.
483 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
485 If NOTREAL is nonzero, only check for equivalent key bindings, don't
486 evaluate expressions in menu items and don't make any menu.
487 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
490 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
491 Lisp_Object key
, item
;
492 Lisp_Object
*pending_maps_ptr
;
493 int maxdepth
, notreal
;
495 Lisp_Object map
, item_string
, enabled
;
496 struct gcpro gcpro1
, gcpro2
;
499 /* Parse the menu item and leave the result in item_properties. */
501 res
= parse_menu_item (item
, notreal
, 0);
504 return; /* Not a menu item. */
506 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
510 /* We don't want to make a menu, just traverse the keymaps to
511 precompute equivalent key bindings. */
513 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
517 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
518 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
520 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
523 /* An enabled separate pane. Remember this to handle it later. */
524 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
529 push_menu_item (item_string
, enabled
, key
,
530 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
531 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
532 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
533 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
534 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
536 /* Display a submenu using the toolkit. */
537 if (! (NILP (map
) || NILP (enabled
)))
539 push_submenu_start ();
540 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
545 /* Push all the panes and items of a menu described by the
546 alist-of-alists MENU.
547 This handles old-fashioned calls to x-popup-menu. */
557 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
559 Lisp_Object elt
, pane_name
, pane_data
;
561 pane_name
= Fcar (elt
);
562 CHECK_STRING (pane_name
);
563 push_menu_pane (pane_name
, Qnil
);
564 pane_data
= Fcdr (elt
);
565 CHECK_CONS (pane_data
);
566 list_of_items (pane_data
);
569 finish_menu_items ();
572 /* Push the items in a single pane defined by the alist PANE. */
578 Lisp_Object tail
, item
, item1
;
580 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
584 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
585 else if (NILP (item
))
586 push_left_right_boundary ();
591 CHECK_STRING (item1
);
592 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
597 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
598 doc
: /* Pop up a deck-of-cards menu and return user's selection.
599 POSITION is a position specification. This is either a mouse button
600 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
601 are positions in pixels from the top left corner of WINDOW's frame
602 \(WINDOW may be a frame object instead of a window). This controls the
603 position of the center of the first line in the first pane of the
604 menu, not the top left of the menu as a whole. If POSITION is t, it
605 means to use the current mouse position.
607 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
608 The menu items come from key bindings that have a menu string as well as
609 a definition; actually, the \"definition\" in such a key binding looks like
610 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
611 the keymap as a top-level element.
613 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
614 Otherwise, REAL-DEFINITION should be a valid key binding definition.
616 You can also use a list of keymaps as MENU. Then each keymap makes a
617 separate pane. When MENU is a keymap or a list of keymaps, the return
618 value is a list of events.
620 Alternatively, you can specify a menu of multiple panes with a list of
621 the form (TITLE PANE1 PANE2...), where each pane is a list of
622 form (TITLE ITEM1 ITEM2...).
623 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
624 appear as an item--that makes a nonselectable line in the menu.
625 With this form of menu, the return value is VALUE from the chosen item.
627 If POSITION is nil, don't display the menu at all, just precalculate the
628 cached information about equivalent key sequences. */)
630 Lisp_Object position
, menu
;
632 Lisp_Object keymap
, tem
;
633 int xpos
= 0, ypos
= 0;
636 Lisp_Object selection
;
638 Lisp_Object x
, y
, window
;
644 if (! NILP (position
))
648 /* Decode the first argument: find the window and the coordinates. */
649 if (EQ (position
, Qt
)
650 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
651 || EQ (XCAR (position
), Qtool_bar
))))
653 /* Use the mouse's current position. */
654 FRAME_PTR new_f
= SELECTED_FRAME ();
655 Lisp_Object bar_window
;
656 enum scroll_bar_part part
;
659 if (mouse_position_hook
)
660 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
661 &part
, &x
, &y
, &time
);
663 XSETFRAME (window
, new_f
);
666 window
= selected_window
;
673 tem
= Fcar (position
);
676 window
= Fcar (Fcdr (position
));
678 y
= Fcar (Fcdr (tem
));
683 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
684 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
685 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
694 /* Decode where to put the menu. */
702 else if (WINDOWP (window
))
704 CHECK_LIVE_WINDOW (window
);
705 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
707 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
708 * XFASTINT (XWINDOW (window
)->left
));
709 ypos
= (FRAME_LINE_HEIGHT (f
)
710 * XFASTINT (XWINDOW (window
)->top
));
713 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
714 but I don't want to make one now. */
715 CHECK_WINDOW (window
);
720 XSETFRAME (Vmenu_updating_frame
, f
);
722 Vmenu_updating_frame
= Qnil
;
723 #endif /* HAVE_MENUS */
728 /* Decode the menu items from what was specified. */
730 keymap
= get_keymap (menu
, 0, 0);
733 /* We were given a keymap. Extract menu info from the keymap. */
736 /* Extract the detailed info to make one pane. */
737 keymap_panes (&menu
, 1, NILP (position
));
739 /* Search for a string appearing directly as an element of the keymap.
740 That string is the title of the menu. */
741 prompt
= Fkeymap_prompt (keymap
);
742 if (NILP (title
) && !NILP (prompt
))
745 /* Make that be the pane title of the first pane. */
746 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
747 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
751 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
753 /* We were given a list of keymaps. */
754 int nmaps
= XFASTINT (Flength (menu
));
756 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
761 /* The first keymap that has a prompt string
762 supplies the menu title. */
763 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
767 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
769 prompt
= Fkeymap_prompt (keymap
);
770 if (NILP (title
) && !NILP (prompt
))
774 /* Extract the detailed info to make one pane. */
775 keymap_panes (maps
, nmaps
, NILP (position
));
777 /* Make the title be the pane title of the first pane. */
778 if (!NILP (title
) && menu_items_n_panes
>= 0)
779 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
785 /* We were given an old-fashioned menu. */
787 CHECK_STRING (title
);
789 list_of_panes (Fcdr (menu
));
796 discard_menu_items ();
802 /* Display them in a menu. */
805 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
806 keymaps
, title
, &error_name
);
809 discard_menu_items ();
812 #endif /* HAVE_MENUS */
814 if (error_name
) error (error_name
);
820 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
821 doc
: /* Pop up a dialog box and return user's selection.
822 POSITION specifies which frame to use.
823 This is normally a mouse button event or a window or frame.
824 If POSITION is t, it means to use the frame the mouse is on.
825 The dialog box appears in the middle of the specified frame.
827 CONTENTS specifies the alternatives to display in the dialog box.
828 It is a list of the form (TITLE ITEM1 ITEM2...).
829 Each ITEM is a cons cell (STRING . VALUE).
830 The return value is VALUE from the chosen item.
832 An ITEM may also be just a string--that makes a nonselectable item.
833 An ITEM may also be nil--that means to put all preceding items
834 on the left of the dialog box and all following items on the right.
835 \(By default, approximately half appear on each side.) */)
837 Lisp_Object position
, contents
;
844 /* Decode the first argument: find the window or frame to use. */
845 if (EQ (position
, Qt
)
846 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
847 || EQ (XCAR (position
), Qtool_bar
))))
849 #if 0 /* Using the frame the mouse is on may not be right. */
850 /* Use the mouse's current position. */
851 FRAME_PTR new_f
= SELECTED_FRAME ();
852 Lisp_Object bar_window
;
853 enum scroll_bar_part part
;
857 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
860 XSETFRAME (window
, new_f
);
862 window
= selected_window
;
864 window
= selected_window
;
866 else if (CONSP (position
))
869 tem
= Fcar (position
);
871 window
= Fcar (Fcdr (position
));
874 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
875 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
878 else if (WINDOWP (position
) || FRAMEP (position
))
883 /* Decode where to put the menu. */
887 else if (WINDOWP (window
))
889 CHECK_LIVE_WINDOW (window
);
890 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
893 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
894 but I don't want to make one now. */
895 CHECK_WINDOW (window
);
898 /* Display a menu with these alternatives
899 in the middle of frame F. */
901 Lisp_Object x
, y
, frame
, newpos
;
902 XSETFRAME (frame
, f
);
903 XSETINT (x
, x_pixel_width (f
) / 2);
904 XSETINT (y
, x_pixel_height (f
) / 2);
905 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
907 return Fx_popup_menu (newpos
,
908 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
910 #else /* HAVE_DIALOGS */
914 Lisp_Object selection
;
916 /* Decode the dialog items from what was specified. */
917 title
= Fcar (contents
);
918 CHECK_STRING (title
);
920 list_of_panes (Fcons (contents
, Qnil
));
922 /* Display them in a dialog box. */
924 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
927 discard_menu_items ();
929 if (error_name
) error (error_name
);
932 #endif /* HAVE_DIALOGS */
935 /* Activate the menu bar of frame F.
936 This is called from keyboard.c when it gets the
937 menu_bar_activate_event out of the Emacs event queue.
939 To activate the menu bar, we signal to the input thread that it can
940 return from the WM_INITMENU message, allowing the normal Windows
941 processing of the menus.
943 But first we recompute the menu bar contents (the whole tree).
945 This way we can safely execute Lisp code. */
948 x_activate_menubar (f
)
951 set_frame_menubar (f
, 0, 1);
953 /* Lock out further menubar changes while active. */
954 f
->output_data
.w32
->menubar_active
= 1;
956 /* Signal input thread to return from WM_INITMENU. */
957 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
960 /* This callback is called from the menu bar pulldown menu
961 when the user makes a selection.
962 Figure out what the user chose
963 and put the appropriate events into the keyboard buffer. */
966 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
968 Lisp_Object prefix
, entry
;
970 Lisp_Object
*subprefix_stack
;
971 int submenu_depth
= 0;
977 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
978 vector
= f
->menu_bar_vector
;
981 while (i
< f
->menu_bar_items_used
)
983 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
985 subprefix_stack
[submenu_depth
++] = prefix
;
989 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
991 prefix
= subprefix_stack
[--submenu_depth
];
994 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
996 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
997 i
+= MENU_ITEMS_PANE_LENGTH
;
1001 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1002 /* The EMACS_INT cast avoids a warning. There's no problem
1003 as long as pointers have enough bits to hold small integers. */
1004 if ((int) (EMACS_INT
) client_data
== i
)
1007 struct input_event buf
;
1010 XSETFRAME (frame
, f
);
1011 buf
.kind
= MENU_BAR_EVENT
;
1012 buf
.frame_or_window
= frame
;
1014 kbd_buffer_store_event (&buf
);
1016 for (j
= 0; j
< submenu_depth
; j
++)
1017 if (!NILP (subprefix_stack
[j
]))
1019 buf
.kind
= MENU_BAR_EVENT
;
1020 buf
.frame_or_window
= frame
;
1021 buf
.arg
= subprefix_stack
[j
];
1022 kbd_buffer_store_event (&buf
);
1027 buf
.kind
= MENU_BAR_EVENT
;
1028 buf
.frame_or_window
= frame
;
1030 kbd_buffer_store_event (&buf
);
1033 buf
.kind
= MENU_BAR_EVENT
;
1034 buf
.frame_or_window
= frame
;
1036 kbd_buffer_store_event (&buf
);
1040 i
+= MENU_ITEMS_ITEM_LENGTH
;
1045 /* Allocate a widget_value, blocking input. */
1048 xmalloc_widget_value ()
1050 widget_value
*value
;
1053 value
= malloc_widget_value ();
1059 /* This recursively calls free_widget_value on the tree of widgets.
1060 It must free all data that was malloc'ed for these widget_values.
1061 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1062 must be left alone. */
1065 free_menubar_widget_value_tree (wv
)
1070 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1072 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1074 free_menubar_widget_value_tree (wv
->contents
);
1075 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1079 free_menubar_widget_value_tree (wv
->next
);
1080 wv
->next
= (widget_value
*) 0xDEADBEEF;
1083 free_widget_value (wv
);
1087 /* Return a tree of widget_value structures for a menu bar item
1088 whose event type is ITEM_KEY (with string ITEM_NAME)
1089 and whose contents come from the list of keymaps MAPS. */
1091 static widget_value
*
1092 single_submenu (item_key
, item_name
, maps
)
1093 Lisp_Object item_key
, item_name
, maps
;
1095 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1097 int submenu_depth
= 0;
1100 Lisp_Object
*mapvec
;
1101 widget_value
**submenu_stack
;
1102 int previous_items
= menu_items_used
;
1103 int top_level_items
= 0;
1105 length
= Flength (maps
);
1106 len
= XINT (length
);
1108 /* Convert the list MAPS into a vector MAPVEC. */
1109 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1110 for (i
= 0; i
< len
; i
++)
1112 mapvec
[i
] = Fcar (maps
);
1116 menu_items_n_panes
= 0;
1118 /* Loop over the given keymaps, making a pane for each map.
1119 But don't make a pane that is empty--ignore that map instead. */
1120 for (i
= 0; i
< len
; i
++)
1122 if (SYMBOLP (mapvec
[i
])
1123 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1125 /* Here we have a command at top level in the menu bar
1126 as opposed to a submenu. */
1127 top_level_items
= 1;
1128 push_menu_pane (Qnil
, Qnil
);
1129 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1130 Qnil
, Qnil
, Qnil
, Qnil
);
1133 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1136 /* Create a tree of widget_value objects
1137 representing the panes and their items. */
1140 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1141 wv
= xmalloc_widget_value ();
1145 wv
->button_type
= BUTTON_TYPE_NONE
;
1151 /* Loop over all panes and items made during this call
1152 and construct a tree of widget_value objects.
1153 Ignore the panes and items made by previous calls to
1154 single_submenu, even though those are also in menu_items. */
1156 while (i
< menu_items_used
)
1158 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1160 submenu_stack
[submenu_depth
++] = save_wv
;
1165 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1168 save_wv
= submenu_stack
[--submenu_depth
];
1171 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1172 && submenu_depth
!= 0)
1173 i
+= MENU_ITEMS_PANE_LENGTH
;
1174 /* Ignore a nil in the item list.
1175 It's meaningful only for dialog boxes. */
1176 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1178 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1180 /* Create a new pane. */
1181 Lisp_Object pane_name
, prefix
;
1184 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1185 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1187 #ifndef HAVE_MULTILINGUAL_MENU
1188 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1190 pane_name
= ENCODE_SYSTEM (pane_name
);
1191 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1194 pane_string
= (NILP (pane_name
)
1195 ? "" : (char *) XSTRING (pane_name
)->data
);
1196 /* If there is just one top-level pane, put all its items directly
1197 under the top-level menu. */
1198 if (menu_items_n_panes
== 1)
1201 /* If the pane has a meaningful name,
1202 make the pane a top-level menu item
1203 with its items as a submenu beneath it. */
1204 if (strcmp (pane_string
, ""))
1206 wv
= xmalloc_widget_value ();
1210 first_wv
->contents
= wv
;
1211 wv
->name
= pane_string
;
1212 /* Ignore the @ that means "separate pane".
1213 This is a kludge, but this isn't worth more time. */
1214 if (!NILP (prefix
) && wv
->name
[0] == '@')
1218 wv
->button_type
= BUTTON_TYPE_NONE
;
1223 i
+= MENU_ITEMS_PANE_LENGTH
;
1227 /* Create a new item within current pane. */
1228 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1231 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1232 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1233 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1234 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1235 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1236 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1237 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1239 #ifndef HAVE_MULTILINGUAL_MENU
1240 if (STRING_MULTIBYTE (item_name
))
1242 item_name
= ENCODE_SYSTEM (item_name
);
1243 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1246 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1248 descrip
= ENCODE_SYSTEM (descrip
);
1249 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1251 #endif /* not HAVE_MULTILINGUAL_MENU */
1253 wv
= xmalloc_widget_value ();
1257 save_wv
->contents
= wv
;
1259 wv
->name
= (char *) XSTRING (item_name
)->data
;
1260 if (!NILP (descrip
))
1261 wv
->key
= (char *) XSTRING (descrip
)->data
;
1263 /* The EMACS_INT cast avoids a warning. There's no problem
1264 as long as pointers have enough bits to hold small integers. */
1265 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1266 wv
->enabled
= !NILP (enable
);
1269 wv
->button_type
= BUTTON_TYPE_NONE
;
1270 else if (EQ (type
, QCradio
))
1271 wv
->button_type
= BUTTON_TYPE_RADIO
;
1272 else if (EQ (type
, QCtoggle
))
1273 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1277 wv
->selected
= !NILP (selected
);
1278 if (!STRINGP (help
))
1285 i
+= MENU_ITEMS_ITEM_LENGTH
;
1289 /* If we have just one "menu item"
1290 that was originally a button, return it by itself. */
1291 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1293 wv
= first_wv
->contents
;
1294 free_widget_value (first_wv
);
1301 /* Set the contents of the menubar widgets of frame F.
1302 The argument FIRST_TIME is currently ignored;
1303 it is set the first time this is called, from initialize_frame_menubar. */
1306 set_frame_menubar (f
, first_time
, deep_p
)
1311 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1313 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1316 /* We must not change the menubar when actually in use. */
1317 if (f
->output_data
.w32
->menubar_active
)
1320 XSETFRAME (Vmenu_updating_frame
, f
);
1322 if (! menubar_widget
)
1324 else if (pending_menu_activation
&& !deep_p
)
1327 wv
= xmalloc_widget_value ();
1328 wv
->name
= "menubar";
1331 wv
->button_type
= BUTTON_TYPE_NONE
;
1337 /* Make a widget-value tree representing the entire menu trees. */
1339 struct buffer
*prev
= current_buffer
;
1341 int specpdl_count
= specpdl_ptr
- specpdl
;
1342 int previous_menu_items_used
= f
->menu_bar_items_used
;
1343 Lisp_Object
*previous_items
1344 = (Lisp_Object
*) alloca (previous_menu_items_used
1345 * sizeof (Lisp_Object
));
1347 /* If we are making a new widget, its contents are empty,
1348 do always reinitialize them. */
1349 if (! menubar_widget
)
1350 previous_menu_items_used
= 0;
1352 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1353 specbind (Qinhibit_quit
, Qt
);
1354 /* Don't let the debugger step into this code
1355 because it is not reentrant. */
1356 specbind (Qdebug_on_next_call
, Qnil
);
1358 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1359 if (NILP (Voverriding_local_map_menu_flag
))
1361 specbind (Qoverriding_terminal_local_map
, Qnil
);
1362 specbind (Qoverriding_local_map
, Qnil
);
1365 set_buffer_internal_1 (XBUFFER (buffer
));
1367 /* Run the Lucid hook. */
1368 safe_run_hooks (Qactivate_menubar_hook
);
1369 /* If it has changed current-menubar from previous value,
1370 really recompute the menubar from the value. */
1371 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1372 call0 (Qrecompute_lucid_menubar
);
1373 safe_run_hooks (Qmenu_bar_update_hook
);
1374 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1376 items
= FRAME_MENU_BAR_ITEMS (f
);
1378 inhibit_garbage_collection ();
1380 /* Save the frame's previous menu bar contents data. */
1381 if (previous_menu_items_used
)
1382 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1383 previous_menu_items_used
* sizeof (Lisp_Object
));
1385 /* Fill in the current menu bar contents. */
1386 menu_items
= f
->menu_bar_vector
;
1387 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1389 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1391 Lisp_Object key
, string
, maps
;
1393 key
= XVECTOR (items
)->contents
[i
];
1394 string
= XVECTOR (items
)->contents
[i
+ 1];
1395 maps
= XVECTOR (items
)->contents
[i
+ 2];
1399 wv
= single_submenu (key
, string
, maps
);
1403 first_wv
->contents
= wv
;
1404 /* Don't set wv->name here; GC during the loop might relocate it. */
1406 wv
->button_type
= BUTTON_TYPE_NONE
;
1410 finish_menu_items ();
1412 set_buffer_internal_1 (prev
);
1413 unbind_to (specpdl_count
, Qnil
);
1415 /* If there has been no change in the Lisp-level contents
1416 of the menu bar, skip redisplaying it. Just exit. */
1418 for (i
= 0; i
< previous_menu_items_used
; i
++)
1419 if (menu_items_used
== i
1420 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1422 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1424 free_menubar_widget_value_tree (first_wv
);
1430 /* Now GC cannot happen during the lifetime of the widget_value,
1431 so it's safe to store data from a Lisp_String, as long as
1432 local copies are made when the actual menu is created.
1433 Windows takes care of this for normal string items, but
1434 not for owner-drawn items or additional item-info. */
1435 wv
= first_wv
->contents
;
1436 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1439 string
= XVECTOR (items
)->contents
[i
+ 1];
1442 wv
->name
= (char *) XSTRING (string
)->data
;
1446 f
->menu_bar_vector
= menu_items
;
1447 f
->menu_bar_items_used
= menu_items_used
;
1452 /* Make a widget-value tree containing
1453 just the top level menu bar strings. */
1455 items
= FRAME_MENU_BAR_ITEMS (f
);
1456 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1460 string
= XVECTOR (items
)->contents
[i
+ 1];
1464 wv
= xmalloc_widget_value ();
1465 wv
->name
= (char *) XSTRING (string
)->data
;
1468 wv
->button_type
= BUTTON_TYPE_NONE
;
1470 /* This prevents lwlib from assuming this
1471 menu item is really supposed to be empty. */
1472 /* The EMACS_INT cast avoids a warning.
1473 This value just has to be different from small integers. */
1474 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1479 first_wv
->contents
= wv
;
1483 /* Forget what we thought we knew about what is in the
1484 detailed contents of the menu bar menus.
1485 Changing the top level always destroys the contents. */
1486 f
->menu_bar_items_used
= 0;
1489 /* Create or update the menu bar widget. */
1495 /* Empty current menubar, rather than creating a fresh one. */
1496 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1501 menubar_widget
= CreateMenu ();
1503 fill_in_menu (menubar_widget
, first_wv
->contents
);
1505 free_menubar_widget_value_tree (first_wv
);
1508 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1510 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1511 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1512 /* Causes flicker when menu bar is updated
1513 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1515 /* Force the window size to be recomputed so that the frame's text
1516 area remains the same, if menubar has just been created. */
1517 if (old_widget
== NULL
)
1518 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1524 /* Called from Fx_create_frame to create the initial menubar of a frame
1525 before it is mapped, so that the window is mapped with the menubar already
1526 there instead of us tacking it on later and thrashing the window after it
1530 initialize_frame_menubar (f
)
1533 /* This function is called before the first chance to redisplay
1534 the frame. It has to be, so the frame will have the right size. */
1535 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1536 set_frame_menubar (f
, 1, 1);
1539 /* Get rid of the menu bar of frame F, and free its storage.
1540 This is used when deleting a frame, and when turning off the menu bar. */
1543 free_frame_menubar (f
)
1549 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1550 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1551 f
->output_data
.w32
->menubar_widget
= NULL
;
1559 /* w32_menu_show actually displays a menu using the panes and items in
1560 menu_items and returns the value selected from it; we assume input
1561 is blocked by the caller. */
1563 /* F is the frame the menu is for.
1564 X and Y are the frame-relative specified position,
1565 relative to the inside upper left corner of the frame F.
1566 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1567 KEYMAPS is 1 if this menu was specified with keymaps;
1568 in that case, we return a list containing the chosen item's value
1569 and perhaps also the pane's prefix.
1570 TITLE is the specified menu title.
1571 ERROR is a place to store an error message string in case of failure.
1572 (We return nil on failure, but the value doesn't actually matter.) */
1575 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1585 int menu_item_selection
;
1588 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1589 widget_value
**submenu_stack
1590 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1591 Lisp_Object
*subprefix_stack
1592 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1593 int submenu_depth
= 0;
1598 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1600 *error
= "Empty menu";
1604 /* Create a tree of widget_value objects
1605 representing the panes and their items. */
1606 wv
= xmalloc_widget_value ();
1610 wv
->button_type
= BUTTON_TYPE_NONE
;
1615 /* Loop over all panes and items, filling in the tree. */
1617 while (i
< menu_items_used
)
1619 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1621 submenu_stack
[submenu_depth
++] = save_wv
;
1627 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1630 save_wv
= submenu_stack
[--submenu_depth
];
1634 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1635 && submenu_depth
!= 0)
1636 i
+= MENU_ITEMS_PANE_LENGTH
;
1637 /* Ignore a nil in the item list.
1638 It's meaningful only for dialog boxes. */
1639 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1641 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1643 /* Create a new pane. */
1644 Lisp_Object pane_name
, prefix
;
1646 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1647 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1648 #ifndef HAVE_MULTILINGUAL_MENU
1649 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1651 pane_name
= ENCODE_SYSTEM (pane_name
);
1652 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1655 pane_string
= (NILP (pane_name
)
1656 ? "" : (char *) XSTRING (pane_name
)->data
);
1657 /* If there is just one top-level pane, put all its items directly
1658 under the top-level menu. */
1659 if (menu_items_n_panes
== 1)
1662 /* If the pane has a meaningful name,
1663 make the pane a top-level menu item
1664 with its items as a submenu beneath it. */
1665 if (!keymaps
&& strcmp (pane_string
, ""))
1667 wv
= xmalloc_widget_value ();
1671 first_wv
->contents
= wv
;
1672 wv
->name
= pane_string
;
1673 if (keymaps
&& !NILP (prefix
))
1677 wv
->button_type
= BUTTON_TYPE_NONE
;
1682 else if (first_pane
)
1688 i
+= MENU_ITEMS_PANE_LENGTH
;
1692 /* Create a new item within current pane. */
1693 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1695 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1696 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1697 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1698 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1699 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1700 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1701 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1703 #ifndef HAVE_MULTILINGUAL_MENU
1704 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1706 item_name
= ENCODE_SYSTEM (item_name
);
1707 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1709 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1711 descrip
= ENCODE_SYSTEM (descrip
);
1712 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1714 #endif /* not HAVE_MULTILINGUAL_MENU */
1716 wv
= xmalloc_widget_value ();
1720 save_wv
->contents
= wv
;
1721 wv
->name
= (char *) XSTRING (item_name
)->data
;
1722 if (!NILP (descrip
))
1723 wv
->key
= (char *) XSTRING (descrip
)->data
;
1725 /* Use the contents index as call_data, since we are
1726 restricted to 16-bits. */
1727 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1728 wv
->enabled
= !NILP (enable
);
1731 wv
->button_type
= BUTTON_TYPE_NONE
;
1732 else if (EQ (type
, QCtoggle
))
1733 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1734 else if (EQ (type
, QCradio
))
1735 wv
->button_type
= BUTTON_TYPE_RADIO
;
1739 wv
->selected
= !NILP (selected
);
1740 if (!STRINGP (help
))
1747 i
+= MENU_ITEMS_ITEM_LENGTH
;
1751 /* Deal with the title, if it is non-nil. */
1754 widget_value
*wv_title
= xmalloc_widget_value ();
1755 widget_value
*wv_sep
= xmalloc_widget_value ();
1757 /* Maybe replace this separator with a bitmap or owner-draw item
1758 so that it looks better. Having two separators looks odd. */
1759 wv_sep
->name
= "--";
1760 wv_sep
->next
= first_wv
->contents
;
1761 wv_sep
->help
= Qnil
;
1763 #ifndef HAVE_MULTILINGUAL_MENU
1764 if (STRING_MULTIBYTE (title
))
1765 title
= ENCODE_SYSTEM (title
);
1767 wv_title
->name
= (char *) XSTRING (title
)->data
;
1768 wv_title
->enabled
= TRUE
;
1769 wv_title
->title
= TRUE
;
1770 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1771 wv_title
->help
= Qnil
;
1772 wv_title
->next
= wv_sep
;
1773 first_wv
->contents
= wv_title
;
1776 /* Actually create the menu. */
1777 current_popup_menu
= menu
= CreatePopupMenu ();
1778 fill_in_menu (menu
, first_wv
->contents
);
1780 /* Adjust coordinates to be root-window-relative. */
1783 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1785 /* No selection has been chosen yet. */
1786 menu_item_selection
= 0;
1788 /* Display the menu. */
1789 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1790 WM_EMACS_TRACKPOPUPMENU
,
1791 (WPARAM
)menu
, (LPARAM
)&pos
);
1793 /* Clean up extraneous mouse events which might have been generated
1795 discard_mouse_events ();
1797 /* Free the widget_value objects we used to specify the contents. */
1798 free_menubar_widget_value_tree (first_wv
);
1802 /* Find the selected item, and its pane, to return
1803 the proper value. */
1804 if (menu_item_selection
!= 0)
1806 Lisp_Object prefix
, entry
;
1808 prefix
= entry
= Qnil
;
1810 while (i
< menu_items_used
)
1812 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1814 subprefix_stack
[submenu_depth
++] = prefix
;
1818 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1820 prefix
= subprefix_stack
[--submenu_depth
];
1823 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1826 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1827 i
+= MENU_ITEMS_PANE_LENGTH
;
1829 /* Ignore a nil in the item list.
1830 It's meaningful only for dialog boxes. */
1831 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1836 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1837 if (menu_item_selection
== i
)
1843 entry
= Fcons (entry
, Qnil
);
1845 entry
= Fcons (prefix
, entry
);
1846 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1847 if (!NILP (subprefix_stack
[j
]))
1848 entry
= Fcons (subprefix_stack
[j
], entry
);
1852 i
+= MENU_ITEMS_ITEM_LENGTH
;
1862 static char * button_names
[] = {
1863 "button1", "button2", "button3", "button4", "button5",
1864 "button6", "button7", "button8", "button9", "button10" };
1867 w32_dialog_show (f
, keymaps
, title
, error
)
1873 int i
, nb_buttons
=0;
1874 char dialog_name
[6];
1875 int menu_item_selection
;
1877 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1879 /* Number of elements seen so far, before boundary. */
1881 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1882 int boundary_seen
= 0;
1886 if (menu_items_n_panes
> 1)
1888 *error
= "Multiple panes in dialog box";
1892 /* Create a tree of widget_value objects
1893 representing the text label and buttons. */
1895 Lisp_Object pane_name
, prefix
;
1897 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1898 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1899 pane_string
= (NILP (pane_name
)
1900 ? "" : (char *) XSTRING (pane_name
)->data
);
1901 prev_wv
= xmalloc_widget_value ();
1902 prev_wv
->value
= pane_string
;
1903 if (keymaps
&& !NILP (prefix
))
1905 prev_wv
->enabled
= 1;
1906 prev_wv
->name
= "message";
1907 prev_wv
->help
= Qnil
;
1910 /* Loop over all panes and items, filling in the tree. */
1911 i
= MENU_ITEMS_PANE_LENGTH
;
1912 while (i
< menu_items_used
)
1915 /* Create a new item within current pane. */
1916 Lisp_Object item_name
, enable
, descrip
, help
;
1918 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1919 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1921 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1922 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1924 if (NILP (item_name
))
1926 free_menubar_widget_value_tree (first_wv
);
1927 *error
= "Submenu in dialog items";
1930 if (EQ (item_name
, Qquote
))
1932 /* This is the boundary between left-side elts
1933 and right-side elts. Stop incrementing right_count. */
1938 if (nb_buttons
>= 9)
1940 free_menubar_widget_value_tree (first_wv
);
1941 *error
= "Too many dialog items";
1945 wv
= xmalloc_widget_value ();
1947 wv
->name
= (char *) button_names
[nb_buttons
];
1948 if (!NILP (descrip
))
1949 wv
->key
= (char *) XSTRING (descrip
)->data
;
1950 wv
->value
= (char *) XSTRING (item_name
)->data
;
1951 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1952 wv
->enabled
= !NILP (enable
);
1956 if (! boundary_seen
)
1960 i
+= MENU_ITEMS_ITEM_LENGTH
;
1963 /* If the boundary was not specified,
1964 by default put half on the left and half on the right. */
1965 if (! boundary_seen
)
1966 left_count
= nb_buttons
- nb_buttons
/ 2;
1968 wv
= xmalloc_widget_value ();
1969 wv
->name
= dialog_name
;
1972 /* Dialog boxes use a really stupid name encoding
1973 which specifies how many buttons to use
1974 and how many buttons are on the right.
1975 The Q means something also. */
1976 dialog_name
[0] = 'Q';
1977 dialog_name
[1] = '0' + nb_buttons
;
1978 dialog_name
[2] = 'B';
1979 dialog_name
[3] = 'R';
1980 /* Number of buttons to put on the right. */
1981 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1983 wv
->contents
= first_wv
;
1987 /* Actually create the dialog. */
1988 dialog_id
= widget_id_tick
++;
1989 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1990 f
->output_data
.w32
->widget
, 1, 0,
1991 dialog_selection_callback
, 0);
1992 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
1994 /* Free the widget_value objects we used to specify the contents. */
1995 free_menubar_widget_value_tree (first_wv
);
1997 /* No selection has been chosen yet. */
1998 menu_item_selection
= 0;
2000 /* Display the menu. */
2001 lw_pop_up_all_widgets (dialog_id
);
2002 popup_activated_flag
= 1;
2004 /* Process events that apply to the menu. */
2005 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2007 lw_destroy_all_widgets (dialog_id
);
2009 /* Find the selected item, and its pane, to return
2010 the proper value. */
2011 if (menu_item_selection
!= 0)
2017 while (i
< menu_items_used
)
2021 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2024 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2025 i
+= MENU_ITEMS_PANE_LENGTH
;
2030 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2031 if (menu_item_selection
== i
)
2035 entry
= Fcons (entry
, Qnil
);
2037 entry
= Fcons (prefix
, entry
);
2041 i
+= MENU_ITEMS_ITEM_LENGTH
;
2048 #endif /* HAVE_DIALOGS */
2051 /* Is this item a separator? */
2053 name_is_separator (name
)
2058 /* Check if name string consists of only dashes ('-'). */
2059 while (*name
== '-') name
++;
2060 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2061 or "--deep-shadow". We don't implement them yet, se we just treat
2062 them like normal separators. */
2063 return (*name
== '\0' || start
+ 2 == name
);
2067 /* Indicate boundary between left and right. */
2069 add_left_right_boundary (HMENU menu
)
2071 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2075 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2081 if (name_is_separator (wv
->name
))
2083 fuFlags
= MF_SEPARATOR
;
2089 fuFlags
= MF_STRING
;
2091 fuFlags
= MF_STRING
| MF_GRAYED
;
2093 if (wv
->key
!= NULL
)
2095 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2096 strcpy (out_string
, wv
->name
);
2097 strcat (out_string
, "\t");
2098 strcat (out_string
, wv
->key
);
2101 out_string
= wv
->name
;
2105 else if (wv
->title
|| wv
->call_data
== 0)
2107 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2108 we can't deallocate the memory otherwise. */
2109 if (get_menu_item_info
)
2111 out_string
= (char *) LocalAlloc (LPTR
, strlen (wv
->name
) + 1);
2113 DebPrint ("Menu: allocing %ld for owner-draw", info
.dwItemData
);
2115 strcpy (out_string
, wv
->name
);
2116 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2119 fuFlags
= MF_DISABLED
;
2122 /* Draw radio buttons and tickboxes. */
2123 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2124 wv
->button_type
== BUTTON_TYPE_RADIO
))
2125 fuFlags
|= MF_CHECKED
;
2127 fuFlags
|= MF_UNCHECKED
;
2133 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2136 /* This must be done after the menu item is created. */
2137 if (!wv
->title
&& wv
->call_data
!= 0)
2139 if (set_menu_item_info
)
2142 bzero (&info
, sizeof (info
));
2143 info
.cbSize
= sizeof (info
);
2144 info
.fMask
= MIIM_DATA
;
2146 /* Set help string for menu item. Leave it as a Lisp_Object
2147 until it is ready to be displayed, since GC can happen while
2148 menus are active. */
2150 info
.dwItemData
= (DWORD
) wv
->help
;
2152 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2154 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2155 RADIO items, but is not available on NT 3.51 and earlier. */
2156 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2157 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2158 info
.dwTypeData
= out_string
;
2159 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2162 set_menu_item_info (menu
,
2163 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2167 return return_value
;
2170 /* Construct native Windows menu(bar) based on widget_value tree. */
2172 fill_in_menu (HMENU menu
, widget_value
*wv
)
2174 int items_added
= 0;
2176 for ( ; wv
!= NULL
; wv
= wv
->next
)
2180 HMENU sub_menu
= CreatePopupMenu ();
2182 if (sub_menu
== NULL
)
2185 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2186 !add_menu_item (menu
, wv
, sub_menu
))
2188 DestroyMenu (sub_menu
);
2194 if (!add_menu_item (menu
, wv
, NULL
))
2204 /* popup_activated_flag not actually used on W32 */
2208 /* Display help string for currently pointed to menu item. Not
2209 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2212 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2214 if (get_menu_item_info
)
2216 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2217 Lisp_Object frame
, help
;
2219 // No help echo on owner-draw menu items.
2220 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
)
2226 bzero (&info
, sizeof (info
));
2227 info
.cbSize
= sizeof (info
);
2228 info
.fMask
= MIIM_DATA
;
2229 get_menu_item_info (menu
, item
, FALSE
, &info
);
2231 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2234 /* Store the help echo in the keyboard buffer as the X toolkit
2235 version does, rather than directly showing it. This seems to
2236 solve the GC problems that were present when we based the
2237 Windows code on the non-toolkit version. */
2240 XSETFRAME (frame
, f
);
2241 kbd_buffer_store_help_event (frame
, help
);
2244 /* X version has a loop through frames here, which doesn't
2245 appear to do anything, unless it has some side effect. */
2246 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2250 /* Free memory used by owner-drawn strings. */
2252 w32_free_submenu_strings (menu
)
2255 int i
, num
= GetMenuItemCount (menu
);
2256 for (i
= 0; i
< num
; i
++)
2259 bzero (&info
, sizeof (info
));
2260 info
.cbSize
= sizeof (info
);
2261 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2263 get_menu_item_info (menu
, i
, TRUE
, &info
);
2265 /* Owner-drawn names are held in dwItemData. */
2266 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2269 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2271 LocalFree (info
.dwItemData
);
2274 /* Recurse down submenus. */
2276 w32_free_submenu_strings (info
.hSubMenu
);
2281 w32_free_menu_strings (hwnd
)
2284 HMENU menu
= current_popup_menu
;
2286 if (get_menu_item_info
)
2288 /* If there is no popup menu active, free the strings from the frame's
2291 menu
= GetMenu (hwnd
);
2294 w32_free_submenu_strings (menu
);
2297 current_popup_menu
= NULL
;
2300 #endif /* HAVE_MENUS */
2305 /* See if Get/SetMenuItemInfo functions are available. */
2306 HMODULE user32
= GetModuleHandle ("user32.dll");
2307 get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2308 set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2310 staticpro (&menu_items
);
2313 current_popup_menu
= NULL
;
2315 Qdebug_on_next_call
= intern ("debug-on-next-call");
2316 staticpro (&Qdebug_on_next_call
);
2318 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2319 doc
: /* Frame for which we are updating a menu.
2320 The enable predicate for a menu command should check this variable. */);
2321 Vmenu_updating_frame
= Qnil
;
2323 defsubr (&Sx_popup_menu
);
2325 defsubr (&Sx_popup_dialog
);