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 typedef struct _widget_value
68 /* value (meaning depend on widget type) */
70 /* keyboard equivalent. no implications for XtTranslations */
72 /* Help string or null if none. */
76 /* true if selected */
78 /* The type of a button. */
79 enum button_type button_type
;
80 /* true if menu title */
83 /* true if was edited (maintained by get_value) */
85 /* true if has changed (maintained by lw library) */
87 /* true if this widget itself has changed,
88 but not counting the other widgets found in the `next' field. */
89 change_type this_one_change
;
91 /* Contents of the sub-widgets, also selected slot for checkbox */
92 struct _widget_value
* contents
;
93 /* data passed to callback */
95 /* next one in the list */
96 struct _widget_value
* next
;
98 /* slot for the toolkit dependent part. Always initialize to NULL. */
100 /* tell us if we should free the toolkit data slot when freeing the
101 widget_value itself. */
102 Boolean free_toolkit_data
;
104 /* we resource the widget_value structures; this points to the next
105 one on the free list if this one has been deallocated.
107 struct _widget_value
*free_list
;
111 /* LocalAlloc/Free is a reasonably good allocator. */
112 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
113 #define free_widget_value(wv) LocalFree (wv)
115 /******************************************************************/
122 Lisp_Object Vmenu_updating_frame
;
124 Lisp_Object Qdebug_on_next_call
;
126 extern Lisp_Object Qmenu_bar
;
127 extern Lisp_Object Qmouse_click
, Qevent_kind
;
129 extern Lisp_Object QCtoggle
, QCradio
;
131 extern Lisp_Object Voverriding_local_map
;
132 extern Lisp_Object Voverriding_local_map_menu_flag
;
134 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
136 extern Lisp_Object Qmenu_bar_update_hook
;
138 void set_frame_menubar ();
140 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
141 Lisp_Object
, Lisp_Object
, Lisp_Object
,
142 Lisp_Object
, Lisp_Object
));
143 static Lisp_Object
w32_dialog_show ();
144 static Lisp_Object
w32_menu_show ();
146 static void keymap_panes ();
147 static void single_keymap_panes ();
148 static void single_menu_item ();
149 static void list_of_panes ();
150 static void list_of_items ();
152 /* This holds a Lisp vector that holds the results of decoding
153 the keymaps or alist-of-alists that specify a menu.
155 It describes the panes and items within the panes.
157 Each pane is described by 3 elements in the vector:
158 t, the pane name, the pane's prefix key.
159 Then follow the pane's items, with 5 elements per item:
160 the item string, the enable flag, the item's value,
161 the definition, and the equivalent keyboard key's description string.
163 In some cases, multiple levels of menus may be described.
164 A single vector slot containing nil indicates the start of a submenu.
165 A single vector slot containing lambda indicates the end of a submenu.
166 The submenu follows a menu item which is the way to reach the submenu.
168 A single vector slot containing quote indicates that the
169 following items should appear on the right of a dialog box.
171 Using a Lisp vector to hold this information while we decode it
172 takes care of protecting all the data from GC. */
174 #define MENU_ITEMS_PANE_NAME 1
175 #define MENU_ITEMS_PANE_PREFIX 2
176 #define MENU_ITEMS_PANE_LENGTH 3
180 MENU_ITEMS_ITEM_NAME
= 0,
181 MENU_ITEMS_ITEM_ENABLE
,
182 MENU_ITEMS_ITEM_VALUE
,
183 MENU_ITEMS_ITEM_EQUIV_KEY
,
184 MENU_ITEMS_ITEM_DEFINITION
,
185 MENU_ITEMS_ITEM_TYPE
,
186 MENU_ITEMS_ITEM_SELECTED
,
187 MENU_ITEMS_ITEM_HELP
,
188 MENU_ITEMS_ITEM_LENGTH
191 static Lisp_Object menu_items
;
193 /* Number of slots currently allocated in menu_items. */
194 static int menu_items_allocated
;
196 /* This is the index in menu_items of the first empty slot. */
197 static int menu_items_used
;
199 /* The number of panes currently recorded in menu_items,
200 excluding those within submenus. */
201 static int menu_items_n_panes
;
203 /* Current depth within submenus. */
204 static int menu_items_submenu_depth
;
206 /* Flag which when set indicates a dialog or menu has been posted by
207 Xt on behalf of one of the widget sets. */
208 static int popup_activated_flag
;
210 static int next_menubar_widget_id
;
212 /* This is set nonzero after the user activates the menu bar, and set
213 to zero again after the menu bars are redisplayed by prepare_menu_bar.
214 While it is nonzero, all calls to set_frame_menubar go deep.
216 I don't understand why this is needed, but it does seem to be
217 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
219 int pending_menu_activation
;
222 /* Return the frame whose ->output_data.w32->menubar_widget equals
225 static struct frame
*
226 menubar_id_to_frame (id
)
229 Lisp_Object tail
, frame
;
232 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
235 if (!GC_FRAMEP (frame
))
238 if (!FRAME_WINDOW_P (f
))
240 if (f
->output_data
.w32
->menubar_widget
== id
)
246 /* Initialize the menu_items structure if we haven't already done so.
247 Also mark it as currently empty. */
252 if (NILP (menu_items
))
254 menu_items_allocated
= 60;
255 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
259 menu_items_n_panes
= 0;
260 menu_items_submenu_depth
= 0;
263 /* Call at the end of generating the data in menu_items.
264 This fills in the number of items in the last pane. */
271 /* Call when finished using the data for the current menu
275 discard_menu_items ()
277 /* Free the structure if it is especially large.
278 Otherwise, hold on to it, to save time. */
279 if (menu_items_allocated
> 200)
282 menu_items_allocated
= 0;
286 /* Make the menu_items vector twice as large. */
292 int old_size
= menu_items_allocated
;
295 menu_items_allocated
*= 2;
296 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
297 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
298 old_size
* sizeof (Lisp_Object
));
301 /* Begin a submenu. */
304 push_submenu_start ()
306 if (menu_items_used
+ 1 > menu_items_allocated
)
309 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
310 menu_items_submenu_depth
++;
318 if (menu_items_used
+ 1 > menu_items_allocated
)
321 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
322 menu_items_submenu_depth
--;
325 /* Indicate boundary between left and right. */
328 push_left_right_boundary ()
330 if (menu_items_used
+ 1 > menu_items_allocated
)
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
336 /* Start a new menu pane in menu_items..
337 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
340 push_menu_pane (name
, prefix_vec
)
341 Lisp_Object name
, prefix_vec
;
343 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
346 if (menu_items_submenu_depth
== 0)
347 menu_items_n_panes
++;
348 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
349 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
353 /* Push one menu item into the current pane. NAME is the string to
354 display. ENABLE if non-nil means this item can be selected. KEY
355 is the key generated by choosing this item, or nil if this item
356 doesn't really have a definition. DEF is the definition of this
357 item. EQUIV is the textual description of the keyboard equivalent
358 for this item (or nil if none). TYPE is the type of this menu
359 item, one of nil, `toggle' or `radio'. */
362 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
363 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
365 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
368 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
369 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
378 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
379 and generate menu panes for them in menu_items.
380 If NOTREAL is nonzero,
381 don't bother really computing whether an item is enabled. */
384 keymap_panes (keymaps
, nmaps
, notreal
)
385 Lisp_Object
*keymaps
;
393 /* Loop over the given keymaps, making a pane for each map.
394 But don't make a pane that is empty--ignore that map instead.
395 P is the number of panes we have made so far. */
396 for (mapno
= 0; mapno
< nmaps
; mapno
++)
397 single_keymap_panes (keymaps
[mapno
],
398 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
400 finish_menu_items ();
403 /* This is a recursive subroutine of keymap_panes.
404 It handles one keymap, KEYMAP.
405 The other arguments are passed along
406 or point to local variables of the previous function.
407 If NOTREAL is nonzero, only check for equivalent key bindings, don't
408 evaluate expressions in menu items and don't make any menu.
410 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
413 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
415 Lisp_Object pane_name
;
420 Lisp_Object pending_maps
= Qnil
;
421 Lisp_Object tail
, item
;
422 struct gcpro gcpro1
, gcpro2
;
427 push_menu_pane (pane_name
, prefix
);
429 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
431 GCPRO2 (keymap
, pending_maps
);
432 /* Look at each key binding, and if it is a menu item add it
436 single_menu_item (XCAR (item
), XCDR (item
),
437 &pending_maps
, notreal
, maxdepth
);
438 else if (VECTORP (item
))
440 /* Loop over the char values represented in the vector. */
441 int len
= XVECTOR (item
)->size
;
443 for (c
= 0; c
< len
; c
++)
445 Lisp_Object character
;
446 XSETFASTINT (character
, c
);
447 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
448 &pending_maps
, notreal
, maxdepth
);
454 /* Process now any submenus which want to be panes at this level. */
455 while (!NILP (pending_maps
))
457 Lisp_Object elt
, eltcdr
, string
;
458 elt
= Fcar (pending_maps
);
460 string
= XCAR (eltcdr
);
461 /* We no longer discard the @ from the beginning of the string here.
462 Instead, we do this in w32_menu_show. */
463 single_keymap_panes (Fcar (elt
), string
,
464 XCDR (eltcdr
), notreal
, maxdepth
- 1);
465 pending_maps
= Fcdr (pending_maps
);
469 /* This is a subroutine of single_keymap_panes that handles one
471 KEY is a key in a keymap and ITEM is its binding.
472 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
474 If NOTREAL is nonzero, only check for equivalent key bindings, don't
475 evaluate expressions in menu items and don't make any menu.
476 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
479 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
480 Lisp_Object key
, item
;
481 Lisp_Object
*pending_maps_ptr
;
482 int maxdepth
, notreal
;
484 Lisp_Object map
, item_string
, enabled
;
485 struct gcpro gcpro1
, gcpro2
;
488 /* Parse the menu item and leave the result in item_properties. */
490 res
= parse_menu_item (item
, notreal
, 0);
493 return; /* Not a menu item. */
495 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
499 /* We don't want to make a menu, just traverse the keymaps to
500 precompute equivalent key bindings. */
502 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
506 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
507 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
509 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
512 /* An enabled separate pane. Remember this to handle it later. */
513 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
518 push_menu_item (item_string
, enabled
, key
,
519 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
520 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
521 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
522 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
523 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
525 /* Display a submenu using the toolkit. */
526 if (! (NILP (map
) || NILP (enabled
)))
528 push_submenu_start ();
529 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
534 /* Push all the panes and items of a menu described by the
535 alist-of-alists MENU.
536 This handles old-fashioned calls to x-popup-menu. */
546 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
548 Lisp_Object elt
, pane_name
, pane_data
;
550 pane_name
= Fcar (elt
);
551 CHECK_STRING (pane_name
, 0);
552 push_menu_pane (pane_name
, Qnil
);
553 pane_data
= Fcdr (elt
);
554 CHECK_CONS (pane_data
, 0);
555 list_of_items (pane_data
);
558 finish_menu_items ();
561 /* Push the items in a single pane defined by the alist PANE. */
567 Lisp_Object tail
, item
, item1
;
569 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
573 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
574 else if (NILP (item
))
575 push_left_right_boundary ();
578 CHECK_CONS (item
, 0);
580 CHECK_STRING (item1
, 1);
581 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
586 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
587 "Pop up a deck-of-cards menu and return user's selection.\n\
588 POSITION is a position specification. This is either a mouse button event\n\
589 or a list ((XOFFSET YOFFSET) WINDOW)\n\
590 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
591 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
592 This controls the position of the center of the first line\n\
593 in the first pane of the menu, not the top left of the menu as a whole.\n\
594 If POSITION is t, it means to use the current mouse position.\n\
596 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
597 The menu items come from key bindings that have a menu string as well as\n\
598 a definition; actually, the \"definition\" in such a key binding looks like\n\
599 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
600 the keymap as a top-level element.\n\n\
601 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
602 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
604 You can also use a list of keymaps as MENU.\n\
605 Then each keymap makes a separate pane.\n\
606 When MENU is a keymap or a list of keymaps, the return value\n\
607 is a list of events.\n\n\
609 Alternatively, you can specify a menu of multiple panes\n\
610 with a list of the form (TITLE PANE1 PANE2...),\n\
611 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
612 Each ITEM is normally a cons cell (STRING . VALUE);\n\
613 but a string can appear as an item--that makes a nonselectable line\n\
615 With this form of menu, the return value is VALUE from the chosen item.\n\
617 If POSITION is nil, don't display the menu at all, just precalculate the\n\
618 cached information about equivalent key sequences.")
620 Lisp_Object position
, menu
;
622 Lisp_Object keymap
, tem
;
626 Lisp_Object selection
;
628 Lisp_Object x
, y
, window
;
634 if (! NILP (position
))
638 /* Decode the first argument: find the window and the coordinates. */
639 if (EQ (position
, Qt
)
640 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
641 || EQ (XCAR (position
), Qtool_bar
))))
643 /* Use the mouse's current position. */
644 FRAME_PTR new_f
= SELECTED_FRAME ();
645 Lisp_Object bar_window
;
646 enum scroll_bar_part part
;
649 if (mouse_position_hook
)
650 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
651 &part
, &x
, &y
, &time
);
653 XSETFRAME (window
, new_f
);
656 window
= selected_window
;
663 tem
= Fcar (position
);
666 window
= Fcar (Fcdr (position
));
668 y
= Fcar (Fcdr (tem
));
673 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
674 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
675 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
684 /* Decode where to put the menu. */
692 else if (WINDOWP (window
))
694 CHECK_LIVE_WINDOW (window
, 0);
695 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
697 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
698 * XFASTINT (XWINDOW (window
)->left
));
699 ypos
= (FRAME_LINE_HEIGHT (f
)
700 * XFASTINT (XWINDOW (window
)->top
));
703 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
704 but I don't want to make one now. */
705 CHECK_WINDOW (window
, 0);
710 XSETFRAME (Vmenu_updating_frame
, f
);
712 Vmenu_updating_frame
= Qnil
;
713 #endif /* HAVE_MENUS */
718 /* Decode the menu items from what was specified. */
720 keymap
= get_keymap (menu
, 0, 0);
723 /* We were given a keymap. Extract menu info from the keymap. */
726 /* Extract the detailed info to make one pane. */
727 keymap_panes (&menu
, 1, NILP (position
));
729 /* Search for a string appearing directly as an element of the keymap.
730 That string is the title of the menu. */
731 prompt
= Fkeymap_prompt (keymap
);
732 if (NILP (title
) && !NILP (prompt
))
735 /* Make that be the pane title of the first pane. */
736 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
737 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
741 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
743 /* We were given a list of keymaps. */
744 int nmaps
= XFASTINT (Flength (menu
));
746 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
751 /* The first keymap that has a prompt string
752 supplies the menu title. */
753 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
757 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
759 prompt
= Fkeymap_prompt (keymap
);
760 if (NILP (title
) && !NILP (prompt
))
764 /* Extract the detailed info to make one pane. */
765 keymap_panes (maps
, nmaps
, NILP (position
));
767 /* Make the title be the pane title of the first pane. */
768 if (!NILP (title
) && menu_items_n_panes
>= 0)
769 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
775 /* We were given an old-fashioned menu. */
777 CHECK_STRING (title
, 1);
779 list_of_panes (Fcdr (menu
));
786 discard_menu_items ();
792 /* Display them in a menu. */
795 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
796 keymaps
, title
, &error_name
);
799 discard_menu_items ();
802 #endif /* HAVE_MENUS */
804 if (error_name
) error (error_name
);
810 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
811 "Pop up a dialog box and return user's selection.\n\
812 POSITION specifies which frame to use.\n\
813 This is normally a mouse button event or a window or frame.\n\
814 If POSITION is t, it means to use the frame the mouse is on.\n\
815 The dialog box appears in the middle of the specified frame.\n\
817 CONTENTS specifies the alternatives to display in the dialog box.\n\
818 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
819 Each ITEM is a cons cell (STRING . VALUE).\n\
820 The return value is VALUE from the chosen item.\n\n\
821 An ITEM may also be just a string--that makes a nonselectable item.\n\
822 An ITEM may also be nil--that means to put all preceding items\n\
823 on the left of the dialog box and all following items on the right.\n\
824 \(By default, approximately half appear on each side.)")
826 Lisp_Object position
, contents
;
833 /* Decode the first argument: find the window or frame to use. */
834 if (EQ (position
, Qt
)
835 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
836 || EQ (XCAR (position
), Qtool_bar
))))
838 #if 0 /* Using the frame the mouse is on may not be right. */
839 /* Use the mouse's current position. */
840 FRAME_PTR new_f
= SELECTED_FRAME ();
841 Lisp_Object bar_window
;
842 enum scroll_bar_part part
;
846 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
849 XSETFRAME (window
, new_f
);
851 window
= selected_window
;
853 window
= selected_window
;
855 else if (CONSP (position
))
858 tem
= Fcar (position
);
860 window
= Fcar (Fcdr (position
));
863 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
864 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
867 else if (WINDOWP (position
) || FRAMEP (position
))
872 /* Decode where to put the menu. */
876 else if (WINDOWP (window
))
878 CHECK_LIVE_WINDOW (window
, 0);
879 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
882 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
883 but I don't want to make one now. */
884 CHECK_WINDOW (window
, 0);
887 /* Display a menu with these alternatives
888 in the middle of frame F. */
890 Lisp_Object x
, y
, frame
, newpos
;
891 XSETFRAME (frame
, f
);
892 XSETINT (x
, x_pixel_width (f
) / 2);
893 XSETINT (y
, x_pixel_height (f
) / 2);
894 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
896 return Fx_popup_menu (newpos
,
897 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
899 #else /* HAVE_DIALOGS */
903 Lisp_Object selection
;
905 /* Decode the dialog items from what was specified. */
906 title
= Fcar (contents
);
907 CHECK_STRING (title
, 1);
909 list_of_panes (Fcons (contents
, Qnil
));
911 /* Display them in a dialog box. */
913 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
916 discard_menu_items ();
918 if (error_name
) error (error_name
);
921 #endif /* HAVE_DIALOGS */
924 /* Activate the menu bar of frame F.
925 This is called from keyboard.c when it gets the
926 menu_bar_activate_event out of the Emacs event queue.
928 To activate the menu bar, we signal to the input thread that it can
929 return from the WM_INITMENU message, allowing the normal Windows
930 processing of the menus.
932 But first we recompute the menu bar contents (the whole tree).
934 This way we can safely execute Lisp code. */
937 x_activate_menubar (f
)
940 set_frame_menubar (f
, 0, 1);
942 /* Lock out further menubar changes while active. */
943 f
->output_data
.w32
->menubar_active
= 1;
945 /* Signal input thread to return from WM_INITMENU. */
946 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
949 /* This callback is called from the menu bar pulldown menu
950 when the user makes a selection.
951 Figure out what the user chose
952 and put the appropriate events into the keyboard buffer. */
955 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
957 Lisp_Object prefix
, entry
;
959 Lisp_Object
*subprefix_stack
;
960 int submenu_depth
= 0;
966 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
967 vector
= f
->menu_bar_vector
;
970 while (i
< f
->menu_bar_items_used
)
972 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
974 subprefix_stack
[submenu_depth
++] = prefix
;
978 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
980 prefix
= subprefix_stack
[--submenu_depth
];
983 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
985 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
986 i
+= MENU_ITEMS_PANE_LENGTH
;
990 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
991 /* The EMACS_INT cast avoids a warning. There's no problem
992 as long as pointers have enough bits to hold small integers. */
993 if ((int) (EMACS_INT
) client_data
== i
)
996 struct input_event buf
;
999 XSETFRAME (frame
, f
);
1000 buf
.kind
= MENU_BAR_EVENT
;
1001 buf
.frame_or_window
= frame
;
1003 kbd_buffer_store_event (&buf
);
1005 for (j
= 0; j
< submenu_depth
; j
++)
1006 if (!NILP (subprefix_stack
[j
]))
1008 buf
.kind
= MENU_BAR_EVENT
;
1009 buf
.frame_or_window
= frame
;
1010 buf
.arg
= subprefix_stack
[j
];
1011 kbd_buffer_store_event (&buf
);
1016 buf
.kind
= MENU_BAR_EVENT
;
1017 buf
.frame_or_window
= frame
;
1019 kbd_buffer_store_event (&buf
);
1022 buf
.kind
= MENU_BAR_EVENT
;
1023 buf
.frame_or_window
= frame
;
1025 kbd_buffer_store_event (&buf
);
1029 i
+= MENU_ITEMS_ITEM_LENGTH
;
1034 /* Allocate a widget_value, blocking input. */
1037 xmalloc_widget_value ()
1039 widget_value
*value
;
1042 value
= malloc_widget_value ();
1048 /* This recursively calls free_widget_value on the tree of widgets.
1049 It must free all data that was malloc'ed for these widget_values.
1050 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1051 must be left alone. */
1054 free_menubar_widget_value_tree (wv
)
1059 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1061 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1063 free_menubar_widget_value_tree (wv
->contents
);
1064 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1068 free_menubar_widget_value_tree (wv
->next
);
1069 wv
->next
= (widget_value
*) 0xDEADBEEF;
1072 free_widget_value (wv
);
1076 /* Return a tree of widget_value structures for a menu bar item
1077 whose event type is ITEM_KEY (with string ITEM_NAME)
1078 and whose contents come from the list of keymaps MAPS. */
1080 static widget_value
*
1081 single_submenu (item_key
, item_name
, maps
)
1082 Lisp_Object item_key
, item_name
, maps
;
1084 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1086 int submenu_depth
= 0;
1089 Lisp_Object
*mapvec
;
1090 widget_value
**submenu_stack
;
1091 int previous_items
= menu_items_used
;
1092 int top_level_items
= 0;
1094 length
= Flength (maps
);
1095 len
= XINT (length
);
1097 /* Convert the list MAPS into a vector MAPVEC. */
1098 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1099 for (i
= 0; i
< len
; i
++)
1101 mapvec
[i
] = Fcar (maps
);
1105 menu_items_n_panes
= 0;
1107 /* Loop over the given keymaps, making a pane for each map.
1108 But don't make a pane that is empty--ignore that map instead. */
1109 for (i
= 0; i
< len
; i
++)
1111 if (SYMBOLP (mapvec
[i
])
1112 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1114 /* Here we have a command at top level in the menu bar
1115 as opposed to a submenu. */
1116 top_level_items
= 1;
1117 push_menu_pane (Qnil
, Qnil
);
1118 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1119 Qnil
, Qnil
, Qnil
, Qnil
);
1122 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1125 /* Create a tree of widget_value objects
1126 representing the panes and their items. */
1129 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1130 wv
= xmalloc_widget_value ();
1134 wv
->button_type
= BUTTON_TYPE_NONE
;
1139 /* Loop over all panes and items made during this call
1140 and construct a tree of widget_value objects.
1141 Ignore the panes and items made by previous calls to
1142 single_submenu, even though those are also in menu_items. */
1144 while (i
< menu_items_used
)
1146 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1148 submenu_stack
[submenu_depth
++] = save_wv
;
1153 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1156 save_wv
= submenu_stack
[--submenu_depth
];
1159 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1160 && submenu_depth
!= 0)
1161 i
+= MENU_ITEMS_PANE_LENGTH
;
1162 /* Ignore a nil in the item list.
1163 It's meaningful only for dialog boxes. */
1164 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1166 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1168 /* Create a new pane. */
1169 Lisp_Object pane_name
, prefix
;
1171 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1172 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1173 #ifndef HAVE_MULTILINGUAL_MENU
1174 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1175 pane_name
= ENCODE_SYSTEM (pane_name
);
1177 pane_string
= (NILP (pane_name
)
1178 ? "" : (char *) XSTRING (pane_name
)->data
);
1179 /* If there is just one top-level pane, put all its items directly
1180 under the top-level menu. */
1181 if (menu_items_n_panes
== 1)
1184 /* If the pane has a meaningful name,
1185 make the pane a top-level menu item
1186 with its items as a submenu beneath it. */
1187 if (strcmp (pane_string
, ""))
1189 wv
= xmalloc_widget_value ();
1193 first_wv
->contents
= wv
;
1194 wv
->name
= pane_string
;
1195 /* Ignore the @ that means "separate pane".
1196 This is a kludge, but this isn't worth more time. */
1197 if (!NILP (prefix
) && wv
->name
[0] == '@')
1201 wv
->button_type
= BUTTON_TYPE_NONE
;
1205 i
+= MENU_ITEMS_PANE_LENGTH
;
1209 /* Create a new item within current pane. */
1210 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1213 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1214 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1216 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1217 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1218 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1219 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1220 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1222 #ifndef HAVE_MULTILINGUAL_MENU
1223 if (STRING_MULTIBYTE (item_name
))
1224 item_name
= ENCODE_SYSTEM (item_name
);
1225 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1226 descrip
= ENCODE_SYSTEM (descrip
);
1229 wv
= xmalloc_widget_value ();
1233 save_wv
->contents
= wv
;
1235 wv
->name
= (char *) XSTRING (item_name
)->data
;
1236 if (!NILP (descrip
))
1237 wv
->key
= (char *) XSTRING (descrip
)->data
;
1239 /* The EMACS_INT cast avoids a warning. There's no problem
1240 as long as pointers have enough bits to hold small integers. */
1241 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1242 wv
->enabled
= !NILP (enable
);
1245 wv
->button_type
= BUTTON_TYPE_NONE
;
1246 else if (EQ (type
, QCradio
))
1247 wv
->button_type
= BUTTON_TYPE_RADIO
;
1248 else if (EQ (type
, QCtoggle
))
1249 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1253 wv
->selected
= !NILP (selected
);
1255 wv
->help
= (char *) XSTRING (help
)->data
;
1261 i
+= MENU_ITEMS_ITEM_LENGTH
;
1265 /* If we have just one "menu item"
1266 that was originally a button, return it by itself. */
1267 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1269 wv
= first_wv
->contents
;
1270 free_widget_value (first_wv
);
1277 /* Set the contents of the menubar widgets of frame F.
1278 The argument FIRST_TIME is currently ignored;
1279 it is set the first time this is called, from initialize_frame_menubar. */
1282 set_frame_menubar (f
, first_time
, deep_p
)
1287 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1289 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1292 /* We must not change the menubar when actually in use. */
1293 if (f
->output_data
.w32
->menubar_active
)
1296 XSETFRAME (Vmenu_updating_frame
, f
);
1298 if (! menubar_widget
)
1300 else if (pending_menu_activation
&& !deep_p
)
1303 wv
= xmalloc_widget_value ();
1304 wv
->name
= "menubar";
1307 wv
->button_type
= BUTTON_TYPE_NONE
;
1312 /* Make a widget-value tree representing the entire menu trees. */
1314 struct buffer
*prev
= current_buffer
;
1316 int specpdl_count
= specpdl_ptr
- specpdl
;
1317 int previous_menu_items_used
= f
->menu_bar_items_used
;
1318 Lisp_Object
*previous_items
1319 = (Lisp_Object
*) alloca (previous_menu_items_used
1320 * sizeof (Lisp_Object
));
1322 /* If we are making a new widget, its contents are empty,
1323 do always reinitialize them. */
1324 if (! menubar_widget
)
1325 previous_menu_items_used
= 0;
1327 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1328 specbind (Qinhibit_quit
, Qt
);
1329 /* Don't let the debugger step into this code
1330 because it is not reentrant. */
1331 specbind (Qdebug_on_next_call
, Qnil
);
1333 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1334 if (NILP (Voverriding_local_map_menu_flag
))
1336 specbind (Qoverriding_terminal_local_map
, Qnil
);
1337 specbind (Qoverriding_local_map
, Qnil
);
1340 set_buffer_internal_1 (XBUFFER (buffer
));
1342 /* Run the Lucid hook. */
1343 safe_run_hooks (Qactivate_menubar_hook
);
1344 /* If it has changed current-menubar from previous value,
1345 really recompute the menubar from the value. */
1346 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1347 call0 (Qrecompute_lucid_menubar
);
1348 safe_run_hooks (Qmenu_bar_update_hook
);
1349 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1351 items
= FRAME_MENU_BAR_ITEMS (f
);
1353 inhibit_garbage_collection ();
1355 /* Save the frame's previous menu bar contents data. */
1356 if (previous_menu_items_used
)
1357 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1358 previous_menu_items_used
* sizeof (Lisp_Object
));
1360 /* Fill in the current menu bar contents. */
1361 menu_items
= f
->menu_bar_vector
;
1362 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1364 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1366 Lisp_Object key
, string
, maps
;
1368 key
= XVECTOR (items
)->contents
[i
];
1369 string
= XVECTOR (items
)->contents
[i
+ 1];
1370 maps
= XVECTOR (items
)->contents
[i
+ 2];
1374 wv
= single_submenu (key
, string
, maps
);
1378 first_wv
->contents
= wv
;
1379 /* Don't set wv->name here; GC during the loop might relocate it. */
1381 wv
->button_type
= BUTTON_TYPE_NONE
;
1385 finish_menu_items ();
1387 set_buffer_internal_1 (prev
);
1388 unbind_to (specpdl_count
, Qnil
);
1390 /* If there has been no change in the Lisp-level contents
1391 of the menu bar, skip redisplaying it. Just exit. */
1393 for (i
= 0; i
< previous_menu_items_used
; i
++)
1394 if (menu_items_used
== i
1395 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1397 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1399 free_menubar_widget_value_tree (first_wv
);
1405 /* Now GC cannot happen during the lifetime of the widget_value,
1406 so it's safe to store data from a Lisp_String. */
1407 wv
= first_wv
->contents
;
1408 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1411 string
= XVECTOR (items
)->contents
[i
+ 1];
1414 wv
->name
= (char *) XSTRING (string
)->data
;
1418 f
->menu_bar_vector
= menu_items
;
1419 f
->menu_bar_items_used
= menu_items_used
;
1424 /* Make a widget-value tree containing
1425 just the top level menu bar strings. */
1427 items
= FRAME_MENU_BAR_ITEMS (f
);
1428 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1432 string
= XVECTOR (items
)->contents
[i
+ 1];
1436 wv
= xmalloc_widget_value ();
1437 wv
->name
= (char *) XSTRING (string
)->data
;
1440 wv
->button_type
= BUTTON_TYPE_NONE
;
1441 /* This prevents lwlib from assuming this
1442 menu item is really supposed to be empty. */
1443 /* The EMACS_INT cast avoids a warning.
1444 This value just has to be different from small integers. */
1445 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1450 first_wv
->contents
= wv
;
1454 /* Forget what we thought we knew about what is in the
1455 detailed contents of the menu bar menus.
1456 Changing the top level always destroys the contents. */
1457 f
->menu_bar_items_used
= 0;
1460 /* Create or update the menu bar widget. */
1466 /* Empty current menubar, rather than creating a fresh one. */
1467 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1472 menubar_widget
= CreateMenu ();
1474 fill_in_menu (menubar_widget
, first_wv
->contents
);
1476 free_menubar_widget_value_tree (first_wv
);
1479 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1481 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1482 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1483 /* Causes flicker when menu bar is updated
1484 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1486 /* Force the window size to be recomputed so that the frame's text
1487 area remains the same, if menubar has just been created. */
1488 if (old_widget
== NULL
)
1489 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1495 /* Called from Fx_create_frame to create the initial menubar of a frame
1496 before it is mapped, so that the window is mapped with the menubar already
1497 there instead of us tacking it on later and thrashing the window after it
1501 initialize_frame_menubar (f
)
1504 /* This function is called before the first chance to redisplay
1505 the frame. It has to be, so the frame will have the right size. */
1506 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1507 set_frame_menubar (f
, 1, 1);
1510 /* Get rid of the menu bar of frame F, and free its storage.
1511 This is used when deleting a frame, and when turning off the menu bar. */
1514 free_frame_menubar (f
)
1520 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1521 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1522 f
->output_data
.w32
->menubar_widget
= NULL
;
1530 /* w32_menu_show actually displays a menu using the panes and items in
1531 menu_items and returns the value selected from it; we assume input
1532 is blocked by the caller. */
1534 /* F is the frame the menu is for.
1535 X and Y are the frame-relative specified position,
1536 relative to the inside upper left corner of the frame F.
1537 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1538 KEYMAPS is 1 if this menu was specified with keymaps;
1539 in that case, we return a list containing the chosen item's value
1540 and perhaps also the pane's prefix.
1541 TITLE is the specified menu title.
1542 ERROR is a place to store an error message string in case of failure.
1543 (We return nil on failure, but the value doesn't actually matter.) */
1546 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1556 int menu_item_selection
;
1559 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1560 widget_value
**submenu_stack
1561 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1562 Lisp_Object
*subprefix_stack
1563 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1564 int submenu_depth
= 0;
1569 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1571 *error
= "Empty menu";
1575 /* Create a tree of widget_value objects
1576 representing the panes and their items. */
1577 wv
= xmalloc_widget_value ();
1581 wv
->button_type
= BUTTON_TYPE_NONE
;
1585 /* Loop over all panes and items, filling in the tree. */
1587 while (i
< menu_items_used
)
1589 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1591 submenu_stack
[submenu_depth
++] = save_wv
;
1597 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1600 save_wv
= submenu_stack
[--submenu_depth
];
1604 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1605 && submenu_depth
!= 0)
1606 i
+= MENU_ITEMS_PANE_LENGTH
;
1607 /* Ignore a nil in the item list.
1608 It's meaningful only for dialog boxes. */
1609 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1611 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1613 /* Create a new pane. */
1614 Lisp_Object pane_name
, prefix
;
1616 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1617 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1618 #ifndef HAVE_MULTILINGUAL_MENU
1619 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1620 pane_name
= ENCODE_SYSTEM (pane_name
);
1622 pane_string
= (NILP (pane_name
)
1623 ? "" : (char *) XSTRING (pane_name
)->data
);
1624 /* If there is just one top-level pane, put all its items directly
1625 under the top-level menu. */
1626 if (menu_items_n_panes
== 1)
1629 /* If the pane has a meaningful name,
1630 make the pane a top-level menu item
1631 with its items as a submenu beneath it. */
1632 if (!keymaps
&& strcmp (pane_string
, ""))
1634 wv
= xmalloc_widget_value ();
1638 first_wv
->contents
= wv
;
1639 wv
->name
= pane_string
;
1640 if (keymaps
&& !NILP (prefix
))
1644 wv
->button_type
= BUTTON_TYPE_NONE
;
1648 else if (first_pane
)
1654 i
+= MENU_ITEMS_PANE_LENGTH
;
1658 /* Create a new item within current pane. */
1659 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1661 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1662 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1664 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1665 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1666 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1667 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1668 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1670 #ifndef HAVE_MULTILINGUAL_MENU
1671 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1672 item_name
= ENCODE_SYSTEM (item_name
);
1673 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1674 descrip
= ENCODE_SYSTEM (descrip
);
1677 wv
= xmalloc_widget_value ();
1681 save_wv
->contents
= wv
;
1682 wv
->name
= (char *) XSTRING (item_name
)->data
;
1683 if (!NILP (descrip
))
1684 wv
->key
= (char *) XSTRING (descrip
)->data
;
1686 /* Use the contents index as call_data, since we are
1687 restricted to 16-bits.. */
1688 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1689 wv
->enabled
= !NILP (enable
);
1692 wv
->button_type
= BUTTON_TYPE_NONE
;
1693 else if (EQ (type
, QCtoggle
))
1694 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1695 else if (EQ (type
, QCradio
))
1696 wv
->button_type
= BUTTON_TYPE_RADIO
;
1700 wv
->selected
= !NILP (selected
);
1703 wv
->help
= (char *) XSTRING (help
)->data
;
1709 i
+= MENU_ITEMS_ITEM_LENGTH
;
1713 /* Deal with the title, if it is non-nil. */
1716 widget_value
*wv_title
= xmalloc_widget_value ();
1717 widget_value
*wv_sep
= xmalloc_widget_value ();
1719 /* Maybe replace this separator with a bitmap or owner-draw item
1720 so that it looks better. Having two separators looks odd. */
1721 wv_sep
->name
= "--";
1722 wv_sep
->next
= first_wv
->contents
;
1724 #ifndef HAVE_MULTILINGUAL_MENU
1725 if (STRING_MULTIBYTE (title
))
1726 title
= ENCODE_SYSTEM (title
);
1728 wv_title
->name
= (char *) XSTRING (title
)->data
;
1729 wv_title
->enabled
= TRUE
;
1730 wv_title
->title
= TRUE
;
1731 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1732 wv_title
->next
= wv_sep
;
1733 first_wv
->contents
= wv_title
;
1736 /* Actually create the menu. */
1737 menu
= CreatePopupMenu ();
1738 fill_in_menu (menu
, first_wv
->contents
);
1740 /* Adjust coordinates to be root-window-relative. */
1743 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1745 /* No selection has been chosen yet. */
1746 menu_item_selection
= 0;
1748 /* Display the menu. */
1749 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1750 WM_EMACS_TRACKPOPUPMENU
,
1751 (WPARAM
)menu
, (LPARAM
)&pos
);
1753 /* Clean up extraneous mouse events which might have been generated
1755 discard_mouse_events ();
1757 /* Free the widget_value objects we used to specify the contents. */
1758 free_menubar_widget_value_tree (first_wv
);
1762 /* Find the selected item, and its pane, to return
1763 the proper value. */
1764 if (menu_item_selection
!= 0)
1766 Lisp_Object prefix
, entry
;
1768 prefix
= entry
= Qnil
;
1770 while (i
< menu_items_used
)
1772 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1774 subprefix_stack
[submenu_depth
++] = prefix
;
1778 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1780 prefix
= subprefix_stack
[--submenu_depth
];
1783 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1786 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1787 i
+= MENU_ITEMS_PANE_LENGTH
;
1789 /* Ignore a nil in the item list.
1790 It's meaningful only for dialog boxes. */
1791 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1796 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1797 if (menu_item_selection
== i
)
1803 entry
= Fcons (entry
, Qnil
);
1805 entry
= Fcons (prefix
, entry
);
1806 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1807 if (!NILP (subprefix_stack
[j
]))
1808 entry
= Fcons (subprefix_stack
[j
], entry
);
1812 i
+= MENU_ITEMS_ITEM_LENGTH
;
1821 static char * button_names
[] = {
1822 "button1", "button2", "button3", "button4", "button5",
1823 "button6", "button7", "button8", "button9", "button10" };
1826 w32_dialog_show (f
, keymaps
, title
, error
)
1832 int i
, nb_buttons
=0;
1833 char dialog_name
[6];
1834 int menu_item_selection
;
1836 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1838 /* Number of elements seen so far, before boundary. */
1840 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1841 int boundary_seen
= 0;
1845 if (menu_items_n_panes
> 1)
1847 *error
= "Multiple panes in dialog box";
1851 /* Create a tree of widget_value objects
1852 representing the text label and buttons. */
1854 Lisp_Object pane_name
, prefix
;
1856 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1857 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1858 pane_string
= (NILP (pane_name
)
1859 ? "" : (char *) XSTRING (pane_name
)->data
);
1860 prev_wv
= xmalloc_widget_value ();
1861 prev_wv
->value
= pane_string
;
1862 if (keymaps
&& !NILP (prefix
))
1864 prev_wv
->enabled
= 1;
1865 prev_wv
->name
= "message";
1868 /* Loop over all panes and items, filling in the tree. */
1869 i
= MENU_ITEMS_PANE_LENGTH
;
1870 while (i
< menu_items_used
)
1873 /* Create a new item within current pane. */
1874 Lisp_Object item_name
, enable
, descrip
, help
;
1876 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1877 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1879 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1880 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1882 if (NILP (item_name
))
1884 free_menubar_widget_value_tree (first_wv
);
1885 *error
= "Submenu in dialog items";
1888 if (EQ (item_name
, Qquote
))
1890 /* This is the boundary between left-side elts
1891 and right-side elts. Stop incrementing right_count. */
1896 if (nb_buttons
>= 9)
1898 free_menubar_widget_value_tree (first_wv
);
1899 *error
= "Too many dialog items";
1903 wv
= xmalloc_widget_value ();
1905 wv
->name
= (char *) button_names
[nb_buttons
];
1906 if (!NILP (descrip
))
1907 wv
->key
= (char *) XSTRING (descrip
)->data
;
1908 wv
->value
= (char *) XSTRING (item_name
)->data
;
1909 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1910 wv
->enabled
= !NILP (enable
);
1913 if (! boundary_seen
)
1917 i
+= MENU_ITEMS_ITEM_LENGTH
;
1920 /* If the boundary was not specified,
1921 by default put half on the left and half on the right. */
1922 if (! boundary_seen
)
1923 left_count
= nb_buttons
- nb_buttons
/ 2;
1925 wv
= xmalloc_widget_value ();
1926 wv
->name
= dialog_name
;
1928 /* Dialog boxes use a really stupid name encoding
1929 which specifies how many buttons to use
1930 and how many buttons are on the right.
1931 The Q means something also. */
1932 dialog_name
[0] = 'Q';
1933 dialog_name
[1] = '0' + nb_buttons
;
1934 dialog_name
[2] = 'B';
1935 dialog_name
[3] = 'R';
1936 /* Number of buttons to put on the right. */
1937 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1939 wv
->contents
= first_wv
;
1943 /* Actually create the dialog. */
1945 dialog_id
= widget_id_tick
++;
1946 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1947 f
->output_data
.w32
->widget
, 1, 0,
1948 dialog_selection_callback
, 0);
1949 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
1952 /* Free the widget_value objects we used to specify the contents. */
1953 free_menubar_widget_value_tree (first_wv
);
1955 /* No selection has been chosen yet. */
1956 menu_item_selection
= 0;
1958 /* Display the menu. */
1960 lw_pop_up_all_widgets (dialog_id
);
1961 popup_activated_flag
= 1;
1963 /* Process events that apply to the menu. */
1964 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1966 lw_destroy_all_widgets (dialog_id
);
1969 /* Find the selected item, and its pane, to return
1970 the proper value. */
1971 if (menu_item_selection
!= 0)
1977 while (i
< menu_items_used
)
1981 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1984 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1985 i
+= MENU_ITEMS_PANE_LENGTH
;
1990 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1991 if (menu_item_selection
== i
)
1995 entry
= Fcons (entry
, Qnil
);
1997 entry
= Fcons (prefix
, entry
);
2001 i
+= MENU_ITEMS_ITEM_LENGTH
;
2010 /* Is this item a separator? */
2012 name_is_separator (name
)
2017 /* Check if name string consists of only dashes ('-'). */
2018 while (*name
== '-') name
++;
2019 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2020 or "--deep-shadow". We don't implement them yet, se we just treat
2021 them like normal separators. */
2022 return (*name
== '\0' || start
+ 2 == name
);
2026 /* Indicate boundary between left and right. */
2028 add_left_right_boundary (HMENU menu
)
2030 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2034 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2040 if (name_is_separator (wv
->name
))
2042 fuFlags
= MF_SEPARATOR
;
2048 fuFlags
= MF_STRING
;
2050 fuFlags
= MF_STRING
| MF_GRAYED
;
2052 if (wv
->key
!= NULL
)
2054 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2055 strcpy (out_string
, wv
->name
);
2056 strcat (out_string
, "\t");
2057 strcat (out_string
, wv
->key
);
2060 out_string
= wv
->name
;
2062 if (wv
->title
|| wv
->call_data
== 0)
2064 #if 0 /* no GC while popup menu is active */
2065 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2066 strcpy (out_string
, wv
->name
);
2068 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2070 /* Draw radio buttons and tickboxes. */
2071 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2072 wv
->button_type
== BUTTON_TYPE_RADIO
))
2073 fuFlags
|= MF_CHECKED
;
2075 fuFlags
|= MF_UNCHECKED
;
2084 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2087 /* This must be done after the menu item is created. */
2088 if ((fuFlags
& MF_STRING
) != 0)
2090 HMODULE user32
= GetModuleHandle ("user32.dll");
2091 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2093 if (set_menu_item_info
)
2096 bzero (&info
, sizeof (info
));
2097 info
.cbSize
= sizeof (info
);
2098 info
.fMask
= MIIM_DATA
;
2100 /* Set help string for menu item. */
2101 info
.dwItemData
= (DWORD
)wv
->help
;
2103 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2105 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2106 RADIO items, but is not available on NT 3.51 and earlier. */
2107 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2108 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2109 info
.dwTypeData
= out_string
;
2110 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2113 set_menu_item_info (menu
,
2114 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2118 return return_value
;
2121 /* Construct native Windows menu(bar) based on widget_value tree. */
2123 fill_in_menu (HMENU menu
, widget_value
*wv
)
2125 int items_added
= 0;
2127 for ( ; wv
!= NULL
; wv
= wv
->next
)
2131 HMENU sub_menu
= CreatePopupMenu ();
2133 if (sub_menu
== NULL
)
2136 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2137 !add_menu_item (menu
, wv
, sub_menu
))
2139 DestroyMenu (sub_menu
);
2145 if (!add_menu_item (menu
, wv
, NULL
))
2155 /* popup_activated_flag not actually used on W32 */
2159 /* Display help string for currently pointed to menu item. Not
2160 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2163 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2165 int pane
= 0; /* TODO: Set this to pane number. */
2167 HMODULE user32
= GetModuleHandle ("user32.dll");
2168 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2170 if (get_menu_item_info
)
2172 extern Lisp_Object Qmenu_item
;
2173 Lisp_Object
*first_item
;
2174 Lisp_Object pane_name
;
2175 Lisp_Object menu_object
;
2178 bzero (&info
, sizeof (info
));
2179 info
.cbSize
= sizeof (info
);
2180 info
.fMask
= MIIM_DATA
;
2181 get_menu_item_info (menu
, item
, FALSE
, &info
);
2183 first_item
= XVECTOR (menu_items
)->contents
;
2184 if (EQ (first_item
[0], Qt
))
2185 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2186 else if (EQ (first_item
[0], Qquote
))
2187 /* This shouldn't happen, see w32_menu_show. */
2188 pane_name
= build_string ("");
2190 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2192 /* (menu-item MENU-NAME PANE-NUMBER) */
2193 menu_object
= Fcons (Qmenu_item
,
2195 Fcons (make_number (pane
), Qnil
)));
2197 show_help_echo (info
.dwItemData
?
2198 build_string ((char *) info
.dwItemData
) : Qnil
,
2199 Qnil
, menu_object
, make_number (item
), 1);
2205 #endif /* HAVE_MENUS */
2209 staticpro (&menu_items
);
2212 Qdebug_on_next_call
= intern ("debug-on-next-call");
2213 staticpro (&Qdebug_on_next_call
);
2215 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2216 "Frame for which we are updating a menu.\n\
2217 The enable predicate for a menu command should check this variable.");
2218 Vmenu_updating_frame
= Qnil
;
2220 defsubr (&Sx_popup_menu
);
2222 defsubr (&Sx_popup_dialog
);