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 FARPROC get_menu_item_info
;
133 FARPROC set_menu_item_info
;
135 Lisp_Object Vmenu_updating_frame
;
137 Lisp_Object Qdebug_on_next_call
;
139 extern Lisp_Object Qmenu_bar
;
140 extern Lisp_Object Qmouse_click
, Qevent_kind
;
142 extern Lisp_Object QCtoggle
, QCradio
;
144 extern Lisp_Object Voverriding_local_map
;
145 extern Lisp_Object Voverriding_local_map_menu_flag
;
147 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
149 extern Lisp_Object Qmenu_bar_update_hook
;
151 void set_frame_menubar ();
153 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
154 Lisp_Object
, Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
));
157 static Lisp_Object
w32_dialog_show ();
159 static Lisp_Object
w32_menu_show ();
161 static void keymap_panes ();
162 static void single_keymap_panes ();
163 static void single_menu_item ();
164 static void list_of_panes ();
165 static void list_of_items ();
166 void w32_free_menu_strings (HWND
);
168 /* This holds a Lisp vector that holds the results of decoding
169 the keymaps or alist-of-alists that specify a menu.
171 It describes the panes and items within the panes.
173 Each pane is described by 3 elements in the vector:
174 t, the pane name, the pane's prefix key.
175 Then follow the pane's items, with 5 elements per item:
176 the item string, the enable flag, the item's value,
177 the definition, and the equivalent keyboard key's description string.
179 In some cases, multiple levels of menus may be described.
180 A single vector slot containing nil indicates the start of a submenu.
181 A single vector slot containing lambda indicates the end of a submenu.
182 The submenu follows a menu item which is the way to reach the submenu.
184 A single vector slot containing quote indicates that the
185 following items should appear on the right of a dialog box.
187 Using a Lisp vector to hold this information while we decode it
188 takes care of protecting all the data from GC. */
190 #define MENU_ITEMS_PANE_NAME 1
191 #define MENU_ITEMS_PANE_PREFIX 2
192 #define MENU_ITEMS_PANE_LENGTH 3
196 MENU_ITEMS_ITEM_NAME
= 0,
197 MENU_ITEMS_ITEM_ENABLE
,
198 MENU_ITEMS_ITEM_VALUE
,
199 MENU_ITEMS_ITEM_EQUIV_KEY
,
200 MENU_ITEMS_ITEM_DEFINITION
,
201 MENU_ITEMS_ITEM_TYPE
,
202 MENU_ITEMS_ITEM_SELECTED
,
203 MENU_ITEMS_ITEM_HELP
,
204 MENU_ITEMS_ITEM_LENGTH
207 static Lisp_Object menu_items
;
209 /* Number of slots currently allocated in menu_items. */
210 static int menu_items_allocated
;
212 /* This is the index in menu_items of the first empty slot. */
213 static int menu_items_used
;
215 /* The number of panes currently recorded in menu_items,
216 excluding those within submenus. */
217 static int menu_items_n_panes
;
219 /* Current depth within submenus. */
220 static int menu_items_submenu_depth
;
222 /* Flag which when set indicates a dialog or menu has been posted by
223 Xt on behalf of one of the widget sets. */
224 static int popup_activated_flag
;
226 static int next_menubar_widget_id
;
228 /* This is set nonzero after the user activates the menu bar, and set
229 to zero again after the menu bars are redisplayed by prepare_menu_bar.
230 While it is nonzero, all calls to set_frame_menubar go deep.
232 I don't understand why this is needed, but it does seem to be
233 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
235 int pending_menu_activation
;
238 /* Return the frame whose ->output_data.w32->menubar_widget equals
241 static struct frame
*
242 menubar_id_to_frame (id
)
245 Lisp_Object tail
, frame
;
248 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
251 if (!GC_FRAMEP (frame
))
254 if (!FRAME_WINDOW_P (f
))
256 if (f
->output_data
.w32
->menubar_widget
== id
)
262 /* Initialize the menu_items structure if we haven't already done so.
263 Also mark it as currently empty. */
268 if (NILP (menu_items
))
270 menu_items_allocated
= 60;
271 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
275 menu_items_n_panes
= 0;
276 menu_items_submenu_depth
= 0;
279 /* Call at the end of generating the data in menu_items.
280 This fills in the number of items in the last pane. */
287 /* Call when finished using the data for the current menu
291 discard_menu_items ()
293 /* Free the structure if it is especially large.
294 Otherwise, hold on to it, to save time. */
295 if (menu_items_allocated
> 200)
298 menu_items_allocated
= 0;
302 /* Make the menu_items vector twice as large. */
308 int old_size
= menu_items_allocated
;
311 menu_items_allocated
*= 2;
312 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
313 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
314 old_size
* sizeof (Lisp_Object
));
317 /* Begin a submenu. */
320 push_submenu_start ()
322 if (menu_items_used
+ 1 > menu_items_allocated
)
325 ASET (menu_items
, menu_items_used
++, Qnil
);
326 menu_items_submenu_depth
++;
334 if (menu_items_used
+ 1 > menu_items_allocated
)
337 ASET (menu_items
, menu_items_used
++, Qlambda
);
338 menu_items_submenu_depth
--;
341 /* Indicate boundary between left and right. */
344 push_left_right_boundary ()
346 if (menu_items_used
+ 1 > menu_items_allocated
)
349 ASET (menu_items
, menu_items_used
++, Qquote
);
352 /* Start a new menu pane in menu_items.
353 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
356 push_menu_pane (name
, prefix_vec
)
357 Lisp_Object name
, prefix_vec
;
359 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
362 if (menu_items_submenu_depth
== 0)
363 menu_items_n_panes
++;
364 ASET (menu_items
, menu_items_used
++, Qt
);
365 ASET (menu_items
, menu_items_used
++, name
);
366 ASET (menu_items
, menu_items_used
++, prefix_vec
);
369 /* Push one menu item into the current pane. NAME is the string to
370 display. ENABLE if non-nil means this item can be selected. KEY
371 is the key generated by choosing this item, or nil if this item
372 doesn't really have a definition. DEF is the definition of this
373 item. EQUIV is the textual description of the keyboard equivalent
374 for this item (or nil if none). TYPE is the type of this menu
375 item, one of nil, `toggle' or `radio'. */
378 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
379 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
381 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
384 ASET (menu_items
, menu_items_used
++, name
);
385 ASET (menu_items
, menu_items_used
++, enable
);
386 ASET (menu_items
, menu_items_used
++, key
);
387 ASET (menu_items
, menu_items_used
++, equiv
);
388 ASET (menu_items
, menu_items_used
++, def
);
389 ASET (menu_items
, menu_items_used
++, type
);
390 ASET (menu_items
, menu_items_used
++, selected
);
391 ASET (menu_items
, menu_items_used
++, help
);
394 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
395 and generate menu panes for them in menu_items.
396 If NOTREAL is nonzero,
397 don't bother really computing whether an item is enabled. */
400 keymap_panes (keymaps
, nmaps
, notreal
)
401 Lisp_Object
*keymaps
;
409 /* Loop over the given keymaps, making a pane for each map.
410 But don't make a pane that is empty--ignore that map instead.
411 P is the number of panes we have made so far. */
412 for (mapno
= 0; mapno
< nmaps
; mapno
++)
413 single_keymap_panes (keymaps
[mapno
],
414 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
416 finish_menu_items ();
419 /* This is a recursive subroutine of keymap_panes.
420 It handles one keymap, KEYMAP.
421 The other arguments are passed along
422 or point to local variables of the previous function.
423 If NOTREAL is nonzero, only check for equivalent key bindings, don't
424 evaluate expressions in menu items and don't make any menu.
426 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
429 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
431 Lisp_Object pane_name
;
436 Lisp_Object pending_maps
= Qnil
;
437 Lisp_Object tail
, item
;
438 struct gcpro gcpro1
, gcpro2
;
443 push_menu_pane (pane_name
, prefix
);
445 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
447 GCPRO2 (keymap
, pending_maps
);
448 /* Look at each key binding, and if it is a menu item add it
452 single_menu_item (XCAR (item
), XCDR (item
),
453 &pending_maps
, notreal
, maxdepth
);
454 else if (VECTORP (item
))
456 /* Loop over the char values represented in the vector. */
457 int len
= ASIZE (item
);
459 for (c
= 0; c
< len
; c
++)
461 Lisp_Object character
;
462 XSETFASTINT (character
, c
);
463 single_menu_item (character
, AREF (item
, c
),
464 &pending_maps
, notreal
, maxdepth
);
470 /* Process now any submenus which want to be panes at this level. */
471 while (!NILP (pending_maps
))
473 Lisp_Object elt
, eltcdr
, string
;
474 elt
= Fcar (pending_maps
);
476 string
= XCAR (eltcdr
);
477 /* We no longer discard the @ from the beginning of the string here.
478 Instead, we do this in w32_menu_show. */
479 single_keymap_panes (Fcar (elt
), string
,
480 XCDR (eltcdr
), notreal
, maxdepth
- 1);
481 pending_maps
= Fcdr (pending_maps
);
485 /* This is a subroutine of single_keymap_panes that handles one
487 KEY is a key in a keymap and ITEM is its binding.
488 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
490 If NOTREAL is nonzero, only check for equivalent key bindings, don't
491 evaluate expressions in menu items and don't make any menu.
492 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
495 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
496 Lisp_Object key
, item
;
497 Lisp_Object
*pending_maps_ptr
;
498 int maxdepth
, notreal
;
500 Lisp_Object map
, item_string
, enabled
;
501 struct gcpro gcpro1
, gcpro2
;
504 /* Parse the menu item and leave the result in item_properties. */
506 res
= parse_menu_item (item
, notreal
, 0);
509 return; /* Not a menu item. */
511 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
515 /* We don't want to make a menu, just traverse the keymaps to
516 precompute equivalent key bindings. */
518 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
522 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
523 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
525 if (!NILP (map
) && SREF (item_string
, 0) == '@')
528 /* An enabled separate pane. Remember this to handle it later. */
529 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
534 push_menu_item (item_string
, enabled
, key
,
535 AREF (item_properties
, ITEM_PROPERTY_DEF
),
536 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
537 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
538 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
539 AREF (item_properties
, ITEM_PROPERTY_HELP
));
541 /* Display a submenu using the toolkit. */
542 if (! (NILP (map
) || NILP (enabled
)))
544 push_submenu_start ();
545 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
550 /* Push all the panes and items of a menu described by the
551 alist-of-alists MENU.
552 This handles old-fashioned calls to x-popup-menu. */
562 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
564 Lisp_Object elt
, pane_name
, pane_data
;
566 pane_name
= Fcar (elt
);
567 CHECK_STRING (pane_name
);
568 push_menu_pane (pane_name
, Qnil
);
569 pane_data
= Fcdr (elt
);
570 CHECK_CONS (pane_data
);
571 list_of_items (pane_data
);
574 finish_menu_items ();
577 /* Push the items in a single pane defined by the alist PANE. */
583 Lisp_Object tail
, item
, item1
;
585 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
589 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
590 else if (NILP (item
))
591 push_left_right_boundary ();
596 CHECK_STRING (item1
);
597 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
602 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
603 doc
: /* Pop up a deck-of-cards menu and return user's selection.
604 POSITION is a position specification. This is either a mouse button
605 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
606 are positions in pixels from the top left corner of WINDOW's frame
607 \(WINDOW may be a frame object instead of a window). This controls the
608 position of the center of the first line in the first pane of the
609 menu, not the top left of the menu as a whole. If POSITION is t, it
610 means to use the current mouse position.
612 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
613 The menu items come from key bindings that have a menu string as well as
614 a definition; actually, the \"definition\" in such a key binding looks like
615 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
616 the keymap as a top-level element.
618 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
619 Otherwise, REAL-DEFINITION should be a valid key binding definition.
621 You can also use a list of keymaps as MENU. Then each keymap makes a
622 separate pane. When MENU is a keymap or a list of keymaps, the return
623 value is a list of events.
625 Alternatively, you can specify a menu of multiple panes with a list of
626 the form (TITLE PANE1 PANE2...), where each pane is a list of
627 form (TITLE ITEM1 ITEM2...).
628 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
629 appear as an item--that makes a nonselectable line in the menu.
630 With this form of menu, the return value is VALUE from the chosen item.
632 If POSITION is nil, don't display the menu at all, just precalculate the
633 cached information about equivalent key sequences. */)
635 Lisp_Object position
, menu
;
637 Lisp_Object keymap
, tem
;
638 int xpos
= 0, ypos
= 0;
641 Lisp_Object selection
;
643 Lisp_Object x
, y
, window
;
649 if (! NILP (position
))
653 /* Decode the first argument: find the window and the coordinates. */
654 if (EQ (position
, Qt
)
655 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
656 || EQ (XCAR (position
), Qtool_bar
))))
658 /* Use the mouse's current position. */
659 FRAME_PTR new_f
= SELECTED_FRAME ();
660 Lisp_Object bar_window
;
661 enum scroll_bar_part part
;
664 if (mouse_position_hook
)
665 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
666 &part
, &x
, &y
, &time
);
668 XSETFRAME (window
, new_f
);
671 window
= selected_window
;
678 tem
= Fcar (position
);
681 window
= Fcar (Fcdr (position
));
683 y
= Fcar (Fcdr (tem
));
688 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
689 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
690 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
699 /* Decode where to put the menu. */
707 else if (WINDOWP (window
))
709 CHECK_LIVE_WINDOW (window
);
710 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
712 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
713 * XFASTINT (XWINDOW (window
)->left
));
714 ypos
= (FRAME_LINE_HEIGHT (f
)
715 * XFASTINT (XWINDOW (window
)->top
));
718 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
719 but I don't want to make one now. */
720 CHECK_WINDOW (window
);
725 XSETFRAME (Vmenu_updating_frame
, f
);
727 Vmenu_updating_frame
= Qnil
;
728 #endif /* HAVE_MENUS */
733 /* Decode the menu items from what was specified. */
735 keymap
= get_keymap (menu
, 0, 0);
738 /* We were given a keymap. Extract menu info from the keymap. */
741 /* Extract the detailed info to make one pane. */
742 keymap_panes (&menu
, 1, NILP (position
));
744 /* Search for a string appearing directly as an element of the keymap.
745 That string is the title of the menu. */
746 prompt
= Fkeymap_prompt (keymap
);
747 if (NILP (title
) && !NILP (prompt
))
750 /* Make that be the pane title of the first pane. */
751 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
752 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
756 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
758 /* We were given a list of keymaps. */
759 int nmaps
= XFASTINT (Flength (menu
));
761 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
766 /* The first keymap that has a prompt string
767 supplies the menu title. */
768 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
772 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
774 prompt
= Fkeymap_prompt (keymap
);
775 if (NILP (title
) && !NILP (prompt
))
779 /* Extract the detailed info to make one pane. */
780 keymap_panes (maps
, nmaps
, NILP (position
));
782 /* Make the title be the pane title of the first pane. */
783 if (!NILP (title
) && menu_items_n_panes
>= 0)
784 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
790 /* We were given an old-fashioned menu. */
792 CHECK_STRING (title
);
794 list_of_panes (Fcdr (menu
));
801 discard_menu_items ();
807 /* If resources from a previous popup menu exist yet, does nothing
808 until the `menu_free_timer' has freed them (see w32fns.c).
810 if (current_popup_menu
)
812 discard_menu_items ();
817 /* Display them in a menu. */
820 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
821 keymaps
, title
, &error_name
);
824 discard_menu_items ();
825 #endif /* HAVE_MENUS */
829 if (error_name
) error (error_name
);
835 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
836 doc
: /* Pop up a dialog box and return user's selection.
837 POSITION specifies which frame to use.
838 This is normally a mouse button event or a window or frame.
839 If POSITION is t, it means to use the frame the mouse is on.
840 The dialog box appears in the middle of the specified frame.
842 CONTENTS specifies the alternatives to display in the dialog box.
843 It is a list of the form (TITLE ITEM1 ITEM2...).
844 Each ITEM is a cons cell (STRING . VALUE).
845 The return value is VALUE from the chosen item.
847 An ITEM may also be just a string--that makes a nonselectable item.
848 An ITEM may also be nil--that means to put all preceding items
849 on the left of the dialog box and all following items on the right.
850 \(By default, approximately half appear on each side.) */)
852 Lisp_Object position
, contents
;
859 /* Decode the first argument: find the window or frame to use. */
860 if (EQ (position
, Qt
)
861 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
862 || EQ (XCAR (position
), Qtool_bar
))))
864 #if 0 /* Using the frame the mouse is on may not be right. */
865 /* Use the mouse's current position. */
866 FRAME_PTR new_f
= SELECTED_FRAME ();
867 Lisp_Object bar_window
;
868 enum scroll_bar_part part
;
872 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
875 XSETFRAME (window
, new_f
);
877 window
= selected_window
;
879 window
= selected_window
;
881 else if (CONSP (position
))
884 tem
= Fcar (position
);
886 window
= Fcar (Fcdr (position
));
889 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
890 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
893 else if (WINDOWP (position
) || FRAMEP (position
))
898 /* Decode where to put the menu. */
902 else if (WINDOWP (window
))
904 CHECK_LIVE_WINDOW (window
);
905 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
908 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
909 but I don't want to make one now. */
910 CHECK_WINDOW (window
);
913 /* Display a menu with these alternatives
914 in the middle of frame F. */
916 Lisp_Object x
, y
, frame
, newpos
;
917 XSETFRAME (frame
, f
);
918 XSETINT (x
, x_pixel_width (f
) / 2);
919 XSETINT (y
, x_pixel_height (f
) / 2);
920 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
922 return Fx_popup_menu (newpos
,
923 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
925 #else /* HAVE_DIALOGS */
929 Lisp_Object selection
;
931 /* Decode the dialog items from what was specified. */
932 title
= Fcar (contents
);
933 CHECK_STRING (title
);
935 list_of_panes (Fcons (contents
, Qnil
));
937 /* Display them in a dialog box. */
939 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
942 discard_menu_items ();
944 if (error_name
) error (error_name
);
947 #endif /* HAVE_DIALOGS */
950 /* Activate the menu bar of frame F.
951 This is called from keyboard.c when it gets the
952 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
954 To activate the menu bar, we signal to the input thread that it can
955 return from the WM_INITMENU message, allowing the normal Windows
956 processing of the menus.
958 But first we recompute the menu bar contents (the whole tree).
960 This way we can safely execute Lisp code. */
963 x_activate_menubar (f
)
966 set_frame_menubar (f
, 0, 1);
968 /* Lock out further menubar changes while active. */
969 f
->output_data
.w32
->menubar_active
= 1;
971 /* Signal input thread to return from WM_INITMENU. */
972 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
975 /* This callback is called from the menu bar pulldown menu
976 when the user makes a selection.
977 Figure out what the user chose
978 and put the appropriate events into the keyboard buffer. */
981 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
983 Lisp_Object prefix
, entry
;
985 Lisp_Object
*subprefix_stack
;
986 int submenu_depth
= 0;
992 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
993 vector
= f
->menu_bar_vector
;
996 while (i
< f
->menu_bar_items_used
)
998 if (EQ (AREF (vector
, i
), Qnil
))
1000 subprefix_stack
[submenu_depth
++] = prefix
;
1004 else if (EQ (AREF (vector
, i
), Qlambda
))
1006 prefix
= subprefix_stack
[--submenu_depth
];
1009 else if (EQ (AREF (vector
, i
), Qt
))
1011 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1012 i
+= MENU_ITEMS_PANE_LENGTH
;
1016 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1017 /* The EMACS_INT cast avoids a warning. There's no problem
1018 as long as pointers have enough bits to hold small integers. */
1019 if ((int) (EMACS_INT
) client_data
== i
)
1022 struct input_event buf
;
1025 XSETFRAME (frame
, f
);
1026 buf
.kind
= MENU_BAR_EVENT
;
1027 buf
.frame_or_window
= frame
;
1029 kbd_buffer_store_event (&buf
);
1031 for (j
= 0; j
< submenu_depth
; j
++)
1032 if (!NILP (subprefix_stack
[j
]))
1034 buf
.kind
= MENU_BAR_EVENT
;
1035 buf
.frame_or_window
= frame
;
1036 buf
.arg
= subprefix_stack
[j
];
1037 kbd_buffer_store_event (&buf
);
1042 buf
.kind
= MENU_BAR_EVENT
;
1043 buf
.frame_or_window
= frame
;
1045 kbd_buffer_store_event (&buf
);
1048 buf
.kind
= MENU_BAR_EVENT
;
1049 buf
.frame_or_window
= frame
;
1051 kbd_buffer_store_event (&buf
);
1053 /* Free memory used by owner-drawn and help-echo strings. */
1054 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1055 f
->output_data
.w32
->menu_command_in_progress
= 0;
1056 f
->output_data
.w32
->menubar_active
= 0;
1059 i
+= MENU_ITEMS_ITEM_LENGTH
;
1062 /* Free memory used by owner-drawn and help-echo strings. */
1063 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1064 f
->output_data
.w32
->menu_command_in_progress
= 0;
1065 f
->output_data
.w32
->menubar_active
= 0;
1068 /* Allocate a widget_value, blocking input. */
1071 xmalloc_widget_value ()
1073 widget_value
*value
;
1076 value
= malloc_widget_value ();
1082 /* This recursively calls free_widget_value on the tree of widgets.
1083 It must free all data that was malloc'ed for these widget_values.
1084 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1085 must be left alone. */
1088 free_menubar_widget_value_tree (wv
)
1093 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1095 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1097 free_menubar_widget_value_tree (wv
->contents
);
1098 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1102 free_menubar_widget_value_tree (wv
->next
);
1103 wv
->next
= (widget_value
*) 0xDEADBEEF;
1106 free_widget_value (wv
);
1110 /* Set up data i menu_items for a menu bar item
1111 whose event type is ITEM_KEY (with string ITEM_NAME)
1112 and whose contents come from the list of keymaps MAPS. */
1115 parse_single_submenu (item_key
, item_name
, maps
)
1116 Lisp_Object item_key
, item_name
, maps
;
1120 Lisp_Object
*mapvec
;
1122 int top_level_items
= 0;
1124 length
= Flength (maps
);
1125 len
= XINT (length
);
1127 /* Convert the list MAPS into a vector MAPVEC. */
1128 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1129 for (i
= 0; i
< len
; i
++)
1131 mapvec
[i
] = Fcar (maps
);
1135 /* Loop over the given keymaps, making a pane for each map.
1136 But don't make a pane that is empty--ignore that map instead. */
1137 for (i
= 0; i
< len
; i
++)
1139 if (SYMBOLP (mapvec
[i
])
1140 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1142 /* Here we have a command at top level in the menu bar
1143 as opposed to a submenu. */
1144 top_level_items
= 1;
1145 push_menu_pane (Qnil
, Qnil
);
1146 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1147 Qnil
, Qnil
, Qnil
, Qnil
);
1150 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1153 return top_level_items
;
1157 /* Create a tree of widget_value objects
1158 representing the panes and items
1159 in menu_items starting at index START, up to index END. */
1161 static widget_value
*
1162 digest_single_submenu (start
, end
, top_level_items
)
1165 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1167 int submenu_depth
= 0;
1168 widget_value
**submenu_stack
;
1171 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1172 wv
= xmalloc_widget_value ();
1176 wv
->button_type
= BUTTON_TYPE_NONE
;
1182 /* Loop over all panes and items made during this call
1183 and construct a tree of widget_value objects.
1184 Ignore the panes and items made by previous calls to
1185 single_submenu, even though those are also in menu_items. */
1189 if (EQ (AREF (menu_items
, i
), Qnil
))
1191 submenu_stack
[submenu_depth
++] = save_wv
;
1196 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1199 save_wv
= submenu_stack
[--submenu_depth
];
1202 else if (EQ (AREF (menu_items
, i
), Qt
)
1203 && submenu_depth
!= 0)
1204 i
+= MENU_ITEMS_PANE_LENGTH
;
1205 /* Ignore a nil in the item list.
1206 It's meaningful only for dialog boxes. */
1207 else if (EQ (AREF (menu_items
, i
), Qquote
))
1209 else if (EQ (AREF (menu_items
, i
), Qt
))
1211 /* Create a new pane. */
1212 Lisp_Object pane_name
, prefix
;
1215 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1216 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1218 #ifndef HAVE_MULTILINGUAL_MENU
1219 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1221 pane_name
= ENCODE_SYSTEM (pane_name
);
1222 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1225 pane_string
= (NILP (pane_name
)
1226 ? "" : (char *) SDATA (pane_name
));
1227 /* If there is just one top-level pane, put all its items directly
1228 under the top-level menu. */
1229 if (menu_items_n_panes
== 1)
1232 /* If the pane has a meaningful name,
1233 make the pane a top-level menu item
1234 with its items as a submenu beneath it. */
1235 if (strcmp (pane_string
, ""))
1237 wv
= xmalloc_widget_value ();
1241 first_wv
->contents
= wv
;
1242 wv
->name
= pane_string
;
1243 /* Ignore the @ that means "separate pane".
1244 This is a kludge, but this isn't worth more time. */
1245 if (!NILP (prefix
) && wv
->name
[0] == '@')
1249 wv
->button_type
= BUTTON_TYPE_NONE
;
1254 i
+= MENU_ITEMS_PANE_LENGTH
;
1258 /* Create a new item within current pane. */
1259 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1262 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1263 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1264 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1265 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1266 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1267 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1268 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1270 #ifndef HAVE_MULTILINGUAL_MENU
1271 if (STRING_MULTIBYTE (item_name
))
1273 item_name
= ENCODE_SYSTEM (item_name
);
1274 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1277 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1279 descrip
= ENCODE_SYSTEM (descrip
);
1280 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1282 #endif /* not HAVE_MULTILINGUAL_MENU */
1284 wv
= xmalloc_widget_value ();
1288 save_wv
->contents
= wv
;
1290 wv
->name
= (char *) SDATA (item_name
);
1291 if (!NILP (descrip
))
1292 wv
->key
= (char *) SDATA (descrip
);
1294 /* The EMACS_INT cast avoids a warning. There's no problem
1295 as long as pointers have enough bits to hold small integers. */
1296 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1297 wv
->enabled
= !NILP (enable
);
1300 wv
->button_type
= BUTTON_TYPE_NONE
;
1301 else if (EQ (type
, QCradio
))
1302 wv
->button_type
= BUTTON_TYPE_RADIO
;
1303 else if (EQ (type
, QCtoggle
))
1304 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1308 wv
->selected
= !NILP (selected
);
1309 if (!STRINGP (help
))
1316 i
+= MENU_ITEMS_ITEM_LENGTH
;
1320 /* If we have just one "menu item"
1321 that was originally a button, return it by itself. */
1322 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1324 wv
= first_wv
->contents
;
1325 free_widget_value (first_wv
);
1332 /* Set the contents of the menubar widgets of frame F.
1333 The argument FIRST_TIME is currently ignored;
1334 it is set the first time this is called, from initialize_frame_menubar. */
1337 set_frame_menubar (f
, first_time
, deep_p
)
1342 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1344 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1346 int *submenu_start
, *submenu_end
;
1347 int *submenu_top_level_items
;
1349 /* We must not change the menubar when actually in use. */
1350 if (f
->output_data
.w32
->menubar_active
)
1353 XSETFRAME (Vmenu_updating_frame
, f
);
1355 if (! menubar_widget
)
1357 else if (pending_menu_activation
&& !deep_p
)
1362 /* Make a widget-value tree representing the entire menu trees. */
1364 struct buffer
*prev
= current_buffer
;
1366 int specpdl_count
= SPECPDL_INDEX ();
1367 int previous_menu_items_used
= f
->menu_bar_items_used
;
1368 Lisp_Object
*previous_items
1369 = (Lisp_Object
*) alloca (previous_menu_items_used
1370 * sizeof (Lisp_Object
));
1372 /* If we are making a new widget, its contents are empty,
1373 do always reinitialize them. */
1374 if (! menubar_widget
)
1375 previous_menu_items_used
= 0;
1377 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1378 specbind (Qinhibit_quit
, Qt
);
1379 /* Don't let the debugger step into this code
1380 because it is not reentrant. */
1381 specbind (Qdebug_on_next_call
, Qnil
);
1383 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1384 if (NILP (Voverriding_local_map_menu_flag
))
1386 specbind (Qoverriding_terminal_local_map
, Qnil
);
1387 specbind (Qoverriding_local_map
, Qnil
);
1390 set_buffer_internal_1 (XBUFFER (buffer
));
1392 /* Run the Lucid hook. */
1393 safe_run_hooks (Qactivate_menubar_hook
);
1394 /* If it has changed current-menubar from previous value,
1395 really recompute the menubar from the value. */
1396 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1397 call0 (Qrecompute_lucid_menubar
);
1398 safe_run_hooks (Qmenu_bar_update_hook
);
1399 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1401 items
= FRAME_MENU_BAR_ITEMS (f
);
1403 /* Save the frame's previous menu bar contents data. */
1404 if (previous_menu_items_used
)
1405 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1406 previous_menu_items_used
* sizeof (Lisp_Object
));
1408 /* Fill in menu_items with the current menu bar contents.
1409 This can evaluate Lisp code. */
1410 menu_items
= f
->menu_bar_vector
;
1411 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1412 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1413 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1414 submenu_top_level_items
1415 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1417 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1419 Lisp_Object key
, string
, maps
;
1423 key
= AREF (items
, i
);
1424 string
= AREF (items
, i
+ 1);
1425 maps
= AREF (items
, i
+ 2);
1429 submenu_start
[i
] = menu_items_used
;
1431 menu_items_n_panes
= 0;
1432 submenu_top_level_items
[i
]
1433 = parse_single_submenu (key
, string
, maps
);
1435 submenu_end
[i
] = menu_items_used
;
1438 finish_menu_items ();
1440 /* Convert menu_items into widget_value trees
1441 to display the menu. This cannot evaluate Lisp code. */
1443 wv
= xmalloc_widget_value ();
1444 wv
->name
= "menubar";
1447 wv
->button_type
= BUTTON_TYPE_NONE
;
1451 for (i
= 0; i
< last_i
; i
+= 4)
1453 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1454 submenu_top_level_items
[i
]);
1458 first_wv
->contents
= wv
;
1459 /* Don't set wv->name here; GC during the loop might relocate it. */
1461 wv
->button_type
= BUTTON_TYPE_NONE
;
1465 set_buffer_internal_1 (prev
);
1466 unbind_to (specpdl_count
, Qnil
);
1468 /* If there has been no change in the Lisp-level contents
1469 of the menu bar, skip redisplaying it. Just exit. */
1471 for (i
= 0; i
< previous_menu_items_used
; i
++)
1472 if (menu_items_used
== i
1473 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1475 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1477 free_menubar_widget_value_tree (first_wv
);
1483 /* Now GC cannot happen during the lifetime of the widget_value,
1484 so it's safe to store data from a Lisp_String, as long as
1485 local copies are made when the actual menu is created.
1486 Windows takes care of this for normal string items, but
1487 not for owner-drawn items or additional item-info. */
1488 wv
= first_wv
->contents
;
1489 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1492 string
= AREF (items
, i
+ 1);
1495 wv
->name
= (char *) SDATA (string
);
1499 f
->menu_bar_vector
= menu_items
;
1500 f
->menu_bar_items_used
= menu_items_used
;
1505 /* Make a widget-value tree containing
1506 just the top level menu bar strings. */
1508 wv
= xmalloc_widget_value ();
1509 wv
->name
= "menubar";
1512 wv
->button_type
= BUTTON_TYPE_NONE
;
1516 items
= FRAME_MENU_BAR_ITEMS (f
);
1517 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1521 string
= AREF (items
, i
+ 1);
1525 wv
= xmalloc_widget_value ();
1526 wv
->name
= (char *) SDATA (string
);
1529 wv
->button_type
= BUTTON_TYPE_NONE
;
1531 /* This prevents lwlib from assuming this
1532 menu item is really supposed to be empty. */
1533 /* The EMACS_INT cast avoids a warning.
1534 This value just has to be different from small integers. */
1535 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1540 first_wv
->contents
= wv
;
1544 /* Forget what we thought we knew about what is in the
1545 detailed contents of the menu bar menus.
1546 Changing the top level always destroys the contents. */
1547 f
->menu_bar_items_used
= 0;
1550 /* Create or update the menu bar widget. */
1556 /* Empty current menubar, rather than creating a fresh one. */
1557 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1562 menubar_widget
= CreateMenu ();
1564 fill_in_menu (menubar_widget
, first_wv
->contents
);
1566 free_menubar_widget_value_tree (first_wv
);
1569 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1571 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1572 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1573 /* Causes flicker when menu bar is updated
1574 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1576 /* Force the window size to be recomputed so that the frame's text
1577 area remains the same, if menubar has just been created. */
1578 if (old_widget
== NULL
)
1579 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1585 /* Called from Fx_create_frame to create the initial menubar of a frame
1586 before it is mapped, so that the window is mapped with the menubar already
1587 there instead of us tacking it on later and thrashing the window after it
1591 initialize_frame_menubar (f
)
1594 /* This function is called before the first chance to redisplay
1595 the frame. It has to be, so the frame will have the right size. */
1596 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1597 set_frame_menubar (f
, 1, 1);
1600 /* Get rid of the menu bar of frame F, and free its storage.
1601 This is used when deleting a frame, and when turning off the menu bar. */
1604 free_frame_menubar (f
)
1610 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1611 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1612 f
->output_data
.w32
->menubar_widget
= NULL
;
1620 /* w32_menu_show actually displays a menu using the panes and items in
1621 menu_items and returns the value selected from it; we assume input
1622 is blocked by the caller. */
1624 /* F is the frame the menu is for.
1625 X and Y are the frame-relative specified position,
1626 relative to the inside upper left corner of the frame F.
1627 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1628 KEYMAPS is 1 if this menu was specified with keymaps;
1629 in that case, we return a list containing the chosen item's value
1630 and perhaps also the pane's prefix.
1631 TITLE is the specified menu title.
1632 ERROR is a place to store an error message string in case of failure.
1633 (We return nil on failure, but the value doesn't actually matter.) */
1636 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1646 int menu_item_selection
;
1649 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1650 widget_value
**submenu_stack
1651 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1652 Lisp_Object
*subprefix_stack
1653 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1654 int submenu_depth
= 0;
1659 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1661 *error
= "Empty menu";
1665 /* Create a tree of widget_value objects
1666 representing the panes and their items. */
1667 wv
= xmalloc_widget_value ();
1671 wv
->button_type
= BUTTON_TYPE_NONE
;
1676 /* Loop over all panes and items, filling in the tree. */
1678 while (i
< menu_items_used
)
1680 if (EQ (AREF (menu_items
, i
), Qnil
))
1682 submenu_stack
[submenu_depth
++] = save_wv
;
1688 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1691 save_wv
= submenu_stack
[--submenu_depth
];
1695 else if (EQ (AREF (menu_items
, i
), Qt
)
1696 && submenu_depth
!= 0)
1697 i
+= MENU_ITEMS_PANE_LENGTH
;
1698 /* Ignore a nil in the item list.
1699 It's meaningful only for dialog boxes. */
1700 else if (EQ (AREF (menu_items
, i
), Qquote
))
1702 else if (EQ (AREF (menu_items
, i
), Qt
))
1704 /* Create a new pane. */
1705 Lisp_Object pane_name
, prefix
;
1707 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1708 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1709 #ifndef HAVE_MULTILINGUAL_MENU
1710 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1712 pane_name
= ENCODE_SYSTEM (pane_name
);
1713 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1716 pane_string
= (NILP (pane_name
)
1717 ? "" : (char *) SDATA (pane_name
));
1718 /* If there is just one top-level pane, put all its items directly
1719 under the top-level menu. */
1720 if (menu_items_n_panes
== 1)
1723 /* If the pane has a meaningful name,
1724 make the pane a top-level menu item
1725 with its items as a submenu beneath it. */
1726 if (!keymaps
&& strcmp (pane_string
, ""))
1728 wv
= xmalloc_widget_value ();
1732 first_wv
->contents
= wv
;
1733 wv
->name
= pane_string
;
1734 if (keymaps
&& !NILP (prefix
))
1738 wv
->button_type
= BUTTON_TYPE_NONE
;
1743 else if (first_pane
)
1749 i
+= MENU_ITEMS_PANE_LENGTH
;
1753 /* Create a new item within current pane. */
1754 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1756 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1757 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1758 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1759 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1760 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1761 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1762 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1764 #ifndef HAVE_MULTILINGUAL_MENU
1765 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1767 item_name
= ENCODE_SYSTEM (item_name
);
1768 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1770 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1772 descrip
= ENCODE_SYSTEM (descrip
);
1773 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1775 #endif /* not HAVE_MULTILINGUAL_MENU */
1777 wv
= xmalloc_widget_value ();
1781 save_wv
->contents
= wv
;
1782 wv
->name
= (char *) SDATA (item_name
);
1783 if (!NILP (descrip
))
1784 wv
->key
= (char *) SDATA (descrip
);
1786 /* Use the contents index as call_data, since we are
1787 restricted to 16-bits. */
1788 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1789 wv
->enabled
= !NILP (enable
);
1792 wv
->button_type
= BUTTON_TYPE_NONE
;
1793 else if (EQ (type
, QCtoggle
))
1794 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1795 else if (EQ (type
, QCradio
))
1796 wv
->button_type
= BUTTON_TYPE_RADIO
;
1800 wv
->selected
= !NILP (selected
);
1801 if (!STRINGP (help
))
1808 i
+= MENU_ITEMS_ITEM_LENGTH
;
1812 /* Deal with the title, if it is non-nil. */
1815 widget_value
*wv_title
= xmalloc_widget_value ();
1816 widget_value
*wv_sep
= xmalloc_widget_value ();
1818 /* Maybe replace this separator with a bitmap or owner-draw item
1819 so that it looks better. Having two separators looks odd. */
1820 wv_sep
->name
= "--";
1821 wv_sep
->next
= first_wv
->contents
;
1822 wv_sep
->help
= Qnil
;
1824 #ifndef HAVE_MULTILINGUAL_MENU
1825 if (STRING_MULTIBYTE (title
))
1826 title
= ENCODE_SYSTEM (title
);
1828 wv_title
->name
= (char *) SDATA (title
);
1829 wv_title
->enabled
= TRUE
;
1830 wv_title
->title
= TRUE
;
1831 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1832 wv_title
->help
= Qnil
;
1833 wv_title
->next
= wv_sep
;
1834 first_wv
->contents
= wv_title
;
1837 /* Actually create the menu. */
1838 current_popup_menu
= menu
= CreatePopupMenu ();
1839 fill_in_menu (menu
, first_wv
->contents
);
1841 /* Adjust coordinates to be root-window-relative. */
1844 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1846 /* No selection has been chosen yet. */
1847 menu_item_selection
= 0;
1849 /* Display the menu. */
1850 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1851 WM_EMACS_TRACKPOPUPMENU
,
1852 (WPARAM
)menu
, (LPARAM
)&pos
);
1854 /* Clean up extraneous mouse events which might have been generated
1856 discard_mouse_events ();
1858 /* Free the widget_value objects we used to specify the contents. */
1859 free_menubar_widget_value_tree (first_wv
);
1863 /* Find the selected item, and its pane, to return
1864 the proper value. */
1865 if (menu_item_selection
!= 0)
1867 Lisp_Object prefix
, entry
;
1869 prefix
= entry
= Qnil
;
1871 while (i
< menu_items_used
)
1873 if (EQ (AREF (menu_items
, i
), Qnil
))
1875 subprefix_stack
[submenu_depth
++] = prefix
;
1879 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1881 prefix
= subprefix_stack
[--submenu_depth
];
1884 else if (EQ (AREF (menu_items
, i
), Qt
))
1886 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1887 i
+= MENU_ITEMS_PANE_LENGTH
;
1889 /* Ignore a nil in the item list.
1890 It's meaningful only for dialog boxes. */
1891 else if (EQ (AREF (menu_items
, i
), Qquote
))
1895 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1896 if (menu_item_selection
== i
)
1902 entry
= Fcons (entry
, Qnil
);
1904 entry
= Fcons (prefix
, entry
);
1905 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1906 if (!NILP (subprefix_stack
[j
]))
1907 entry
= Fcons (subprefix_stack
[j
], entry
);
1911 i
+= MENU_ITEMS_ITEM_LENGTH
;
1921 static char * button_names
[] = {
1922 "button1", "button2", "button3", "button4", "button5",
1923 "button6", "button7", "button8", "button9", "button10" };
1926 w32_dialog_show (f
, keymaps
, title
, error
)
1932 int i
, nb_buttons
=0;
1933 char dialog_name
[6];
1934 int menu_item_selection
;
1936 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1938 /* Number of elements seen so far, before boundary. */
1940 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1941 int boundary_seen
= 0;
1945 if (menu_items_n_panes
> 1)
1947 *error
= "Multiple panes in dialog box";
1951 /* Create a tree of widget_value objects
1952 representing the text label and buttons. */
1954 Lisp_Object pane_name
, prefix
;
1956 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
1957 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
1958 pane_string
= (NILP (pane_name
)
1959 ? "" : (char *) SDATA (pane_name
));
1960 prev_wv
= xmalloc_widget_value ();
1961 prev_wv
->value
= pane_string
;
1962 if (keymaps
&& !NILP (prefix
))
1964 prev_wv
->enabled
= 1;
1965 prev_wv
->name
= "message";
1966 prev_wv
->help
= Qnil
;
1969 /* Loop over all panes and items, filling in the tree. */
1970 i
= MENU_ITEMS_PANE_LENGTH
;
1971 while (i
< menu_items_used
)
1974 /* Create a new item within current pane. */
1975 Lisp_Object item_name
, enable
, descrip
, help
;
1977 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1978 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1979 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1980 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1982 if (NILP (item_name
))
1984 free_menubar_widget_value_tree (first_wv
);
1985 *error
= "Submenu in dialog items";
1988 if (EQ (item_name
, Qquote
))
1990 /* This is the boundary between left-side elts
1991 and right-side elts. Stop incrementing right_count. */
1996 if (nb_buttons
>= 9)
1998 free_menubar_widget_value_tree (first_wv
);
1999 *error
= "Too many dialog items";
2003 wv
= xmalloc_widget_value ();
2005 wv
->name
= (char *) button_names
[nb_buttons
];
2006 if (!NILP (descrip
))
2007 wv
->key
= (char *) SDATA (descrip
);
2008 wv
->value
= (char *) SDATA (item_name
);
2009 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2010 wv
->enabled
= !NILP (enable
);
2014 if (! boundary_seen
)
2018 i
+= MENU_ITEMS_ITEM_LENGTH
;
2021 /* If the boundary was not specified,
2022 by default put half on the left and half on the right. */
2023 if (! boundary_seen
)
2024 left_count
= nb_buttons
- nb_buttons
/ 2;
2026 wv
= xmalloc_widget_value ();
2027 wv
->name
= dialog_name
;
2030 /* Dialog boxes use a really stupid name encoding
2031 which specifies how many buttons to use
2032 and how many buttons are on the right.
2033 The Q means something also. */
2034 dialog_name
[0] = 'Q';
2035 dialog_name
[1] = '0' + nb_buttons
;
2036 dialog_name
[2] = 'B';
2037 dialog_name
[3] = 'R';
2038 /* Number of buttons to put on the right. */
2039 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2041 wv
->contents
= first_wv
;
2045 /* Actually create the dialog. */
2046 dialog_id
= widget_id_tick
++;
2047 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2048 f
->output_data
.w32
->widget
, 1, 0,
2049 dialog_selection_callback
, 0);
2050 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2052 /* Free the widget_value objects we used to specify the contents. */
2053 free_menubar_widget_value_tree (first_wv
);
2055 /* No selection has been chosen yet. */
2056 menu_item_selection
= 0;
2058 /* Display the menu. */
2059 lw_pop_up_all_widgets (dialog_id
);
2060 popup_activated_flag
= 1;
2062 /* Process events that apply to the menu. */
2063 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2065 lw_destroy_all_widgets (dialog_id
);
2067 /* Find the selected item, and its pane, to return
2068 the proper value. */
2069 if (menu_item_selection
!= 0)
2075 while (i
< menu_items_used
)
2079 if (EQ (AREF (menu_items
, i
), Qt
))
2081 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2082 i
+= MENU_ITEMS_PANE_LENGTH
;
2086 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2087 if (menu_item_selection
== i
)
2091 entry
= Fcons (entry
, Qnil
);
2093 entry
= Fcons (prefix
, entry
);
2097 i
+= MENU_ITEMS_ITEM_LENGTH
;
2104 #endif /* HAVE_DIALOGS */
2107 /* Is this item a separator? */
2109 name_is_separator (name
)
2114 /* Check if name string consists of only dashes ('-'). */
2115 while (*name
== '-') name
++;
2116 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2117 or "--deep-shadow". We don't implement them yet, se we just treat
2118 them like normal separators. */
2119 return (*name
== '\0' || start
+ 2 == name
);
2123 /* Indicate boundary between left and right. */
2125 add_left_right_boundary (HMENU menu
)
2127 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2131 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2137 if (name_is_separator (wv
->name
))
2139 fuFlags
= MF_SEPARATOR
;
2145 fuFlags
= MF_STRING
;
2147 fuFlags
= MF_STRING
| MF_GRAYED
;
2149 if (wv
->key
!= NULL
)
2151 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2152 strcpy (out_string
, wv
->name
);
2153 strcat (out_string
, "\t");
2154 strcat (out_string
, wv
->key
);
2157 out_string
= wv
->name
;
2161 else if (wv
->title
|| wv
->call_data
== 0)
2163 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2164 we can't deallocate the memory otherwise. */
2165 if (get_menu_item_info
)
2167 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2168 strcpy (out_string
, wv
->name
);
2170 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2172 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2175 fuFlags
= MF_DISABLED
;
2178 /* Draw radio buttons and tickboxes. */
2179 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2180 wv
->button_type
== BUTTON_TYPE_RADIO
))
2181 fuFlags
|= MF_CHECKED
;
2183 fuFlags
|= MF_UNCHECKED
;
2189 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2192 /* This must be done after the menu item is created. */
2193 if (!wv
->title
&& wv
->call_data
!= 0)
2195 if (set_menu_item_info
)
2198 bzero (&info
, sizeof (info
));
2199 info
.cbSize
= sizeof (info
);
2200 info
.fMask
= MIIM_DATA
;
2202 /* Set help string for menu item. Leave it as a Lisp_Object
2203 until it is ready to be displayed, since GC can happen while
2204 menus are active. */
2206 info
.dwItemData
= (DWORD
) wv
->help
;
2208 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2210 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2211 RADIO items, but is not available on NT 3.51 and earlier. */
2212 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2213 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2214 info
.dwTypeData
= out_string
;
2215 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2218 set_menu_item_info (menu
,
2219 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2223 return return_value
;
2226 /* Construct native Windows menu(bar) based on widget_value tree. */
2228 fill_in_menu (HMENU menu
, widget_value
*wv
)
2230 int items_added
= 0;
2232 for ( ; wv
!= NULL
; wv
= wv
->next
)
2236 HMENU sub_menu
= CreatePopupMenu ();
2238 if (sub_menu
== NULL
)
2241 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2242 !add_menu_item (menu
, wv
, sub_menu
))
2244 DestroyMenu (sub_menu
);
2250 if (!add_menu_item (menu
, wv
, NULL
))
2260 /* popup_activated_flag not actually used on W32 */
2264 /* Display help string for currently pointed to menu item. Not
2265 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2268 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2270 if (get_menu_item_info
)
2272 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2273 Lisp_Object frame
, help
;
2275 // No help echo on owner-draw menu items.
2276 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
)
2282 bzero (&info
, sizeof (info
));
2283 info
.cbSize
= sizeof (info
);
2284 info
.fMask
= MIIM_DATA
;
2285 get_menu_item_info (menu
, item
, FALSE
, &info
);
2287 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2290 /* Store the help echo in the keyboard buffer as the X toolkit
2291 version does, rather than directly showing it. This seems to
2292 solve the GC problems that were present when we based the
2293 Windows code on the non-toolkit version. */
2296 XSETFRAME (frame
, f
);
2297 kbd_buffer_store_help_event (frame
, help
);
2300 /* X version has a loop through frames here, which doesn't
2301 appear to do anything, unless it has some side effect. */
2302 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2306 /* Free memory used by owner-drawn strings. */
2308 w32_free_submenu_strings (menu
)
2311 int i
, num
= GetMenuItemCount (menu
);
2312 for (i
= 0; i
< num
; i
++)
2315 bzero (&info
, sizeof (info
));
2316 info
.cbSize
= sizeof (info
);
2317 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2319 get_menu_item_info (menu
, i
, TRUE
, &info
);
2321 /* Owner-drawn names are held in dwItemData. */
2322 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2325 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2327 local_free (info
.dwItemData
);
2330 /* Recurse down submenus. */
2332 w32_free_submenu_strings (info
.hSubMenu
);
2337 w32_free_menu_strings (hwnd
)
2340 HMENU menu
= current_popup_menu
;
2342 if (get_menu_item_info
)
2344 /* If there is no popup menu active, free the strings from the frame's
2347 menu
= GetMenu (hwnd
);
2350 w32_free_submenu_strings (menu
);
2353 current_popup_menu
= NULL
;
2356 #endif /* HAVE_MENUS */
2361 /* See if Get/SetMenuItemInfo functions are available. */
2362 HMODULE user32
= GetModuleHandle ("user32.dll");
2363 get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2364 set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2366 staticpro (&menu_items
);
2369 current_popup_menu
= NULL
;
2371 Qdebug_on_next_call
= intern ("debug-on-next-call");
2372 staticpro (&Qdebug_on_next_call
);
2374 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2375 doc
: /* Frame for which we are updating a menu.
2376 The enable predicate for a menu command should check this variable. */);
2377 Vmenu_updating_frame
= Qnil
;
2379 defsubr (&Sx_popup_menu
);
2381 defsubr (&Sx_popup_dialog
);