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
);
552 push_menu_pane (pane_name
, Qnil
);
553 pane_data
= Fcdr (elt
);
554 CHECK_CONS (pane_data
);
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 ();
580 CHECK_STRING (item1
);
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
;
623 int xpos
= 0, ypos
= 0;
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
);
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
);
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
);
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
);
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
);
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
);
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
;
1172 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1173 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1175 #ifndef HAVE_MULTILINGUAL_MENU
1176 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1178 pane_name
= ENCODE_SYSTEM (pane_name
);
1179 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1182 pane_string
= (NILP (pane_name
)
1183 ? "" : (char *) XSTRING (pane_name
)->data
);
1184 /* If there is just one top-level pane, put all its items directly
1185 under the top-level menu. */
1186 if (menu_items_n_panes
== 1)
1189 /* If the pane has a meaningful name,
1190 make the pane a top-level menu item
1191 with its items as a submenu beneath it. */
1192 if (strcmp (pane_string
, ""))
1194 wv
= xmalloc_widget_value ();
1198 first_wv
->contents
= wv
;
1199 wv
->name
= pane_string
;
1200 /* Ignore the @ that means "separate pane".
1201 This is a kludge, but this isn't worth more time. */
1202 if (!NILP (prefix
) && wv
->name
[0] == '@')
1206 wv
->button_type
= BUTTON_TYPE_NONE
;
1210 i
+= MENU_ITEMS_PANE_LENGTH
;
1214 /* Create a new item within current pane. */
1215 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1218 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1219 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1220 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1221 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1222 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1223 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1224 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1226 #ifndef HAVE_MULTILINGUAL_MENU
1227 if (STRING_MULTIBYTE (item_name
))
1229 item_name
= ENCODE_SYSTEM (item_name
);
1230 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1233 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1235 descrip
= ENCODE_SYSTEM (descrip
);
1236 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1238 #endif /* not HAVE_MULTILINGUAL_MENU */
1240 wv
= xmalloc_widget_value ();
1244 save_wv
->contents
= wv
;
1246 wv
->name
= (char *) XSTRING (item_name
)->data
;
1247 if (!NILP (descrip
))
1248 wv
->key
= (char *) XSTRING (descrip
)->data
;
1250 /* The EMACS_INT cast avoids a warning. There's no problem
1251 as long as pointers have enough bits to hold small integers. */
1252 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1253 wv
->enabled
= !NILP (enable
);
1256 wv
->button_type
= BUTTON_TYPE_NONE
;
1257 else if (EQ (type
, QCradio
))
1258 wv
->button_type
= BUTTON_TYPE_RADIO
;
1259 else if (EQ (type
, QCtoggle
))
1260 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1264 wv
->selected
= !NILP (selected
);
1266 wv
->help
= (char *) XSTRING (help
)->data
;
1272 i
+= MENU_ITEMS_ITEM_LENGTH
;
1276 /* If we have just one "menu item"
1277 that was originally a button, return it by itself. */
1278 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1280 wv
= first_wv
->contents
;
1281 free_widget_value (first_wv
);
1288 /* Set the contents of the menubar widgets of frame F.
1289 The argument FIRST_TIME is currently ignored;
1290 it is set the first time this is called, from initialize_frame_menubar. */
1293 set_frame_menubar (f
, first_time
, deep_p
)
1298 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1300 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1303 /* We must not change the menubar when actually in use. */
1304 if (f
->output_data
.w32
->menubar_active
)
1307 XSETFRAME (Vmenu_updating_frame
, f
);
1309 if (! menubar_widget
)
1311 else if (pending_menu_activation
&& !deep_p
)
1314 wv
= xmalloc_widget_value ();
1315 wv
->name
= "menubar";
1318 wv
->button_type
= BUTTON_TYPE_NONE
;
1323 /* Make a widget-value tree representing the entire menu trees. */
1325 struct buffer
*prev
= current_buffer
;
1327 int specpdl_count
= specpdl_ptr
- specpdl
;
1328 int previous_menu_items_used
= f
->menu_bar_items_used
;
1329 Lisp_Object
*previous_items
1330 = (Lisp_Object
*) alloca (previous_menu_items_used
1331 * sizeof (Lisp_Object
));
1333 /* If we are making a new widget, its contents are empty,
1334 do always reinitialize them. */
1335 if (! menubar_widget
)
1336 previous_menu_items_used
= 0;
1338 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1339 specbind (Qinhibit_quit
, Qt
);
1340 /* Don't let the debugger step into this code
1341 because it is not reentrant. */
1342 specbind (Qdebug_on_next_call
, Qnil
);
1344 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1345 if (NILP (Voverriding_local_map_menu_flag
))
1347 specbind (Qoverriding_terminal_local_map
, Qnil
);
1348 specbind (Qoverriding_local_map
, Qnil
);
1351 set_buffer_internal_1 (XBUFFER (buffer
));
1353 /* Run the Lucid hook. */
1354 safe_run_hooks (Qactivate_menubar_hook
);
1355 /* If it has changed current-menubar from previous value,
1356 really recompute the menubar from the value. */
1357 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1358 call0 (Qrecompute_lucid_menubar
);
1359 safe_run_hooks (Qmenu_bar_update_hook
);
1360 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1362 items
= FRAME_MENU_BAR_ITEMS (f
);
1364 inhibit_garbage_collection ();
1366 /* Save the frame's previous menu bar contents data. */
1367 if (previous_menu_items_used
)
1368 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1369 previous_menu_items_used
* sizeof (Lisp_Object
));
1371 /* Fill in the current menu bar contents. */
1372 menu_items
= f
->menu_bar_vector
;
1373 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1375 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1377 Lisp_Object key
, string
, maps
;
1379 key
= XVECTOR (items
)->contents
[i
];
1380 string
= XVECTOR (items
)->contents
[i
+ 1];
1381 maps
= XVECTOR (items
)->contents
[i
+ 2];
1385 wv
= single_submenu (key
, string
, maps
);
1389 first_wv
->contents
= wv
;
1390 /* Don't set wv->name here; GC during the loop might relocate it. */
1392 wv
->button_type
= BUTTON_TYPE_NONE
;
1396 finish_menu_items ();
1398 set_buffer_internal_1 (prev
);
1399 unbind_to (specpdl_count
, Qnil
);
1401 /* If there has been no change in the Lisp-level contents
1402 of the menu bar, skip redisplaying it. Just exit. */
1404 for (i
= 0; i
< previous_menu_items_used
; i
++)
1405 if (menu_items_used
== i
1406 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1408 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1410 free_menubar_widget_value_tree (first_wv
);
1416 /* Now GC cannot happen during the lifetime of the widget_value,
1417 so it's safe to store data from a Lisp_String. */
1418 wv
= first_wv
->contents
;
1419 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1422 string
= XVECTOR (items
)->contents
[i
+ 1];
1425 wv
->name
= (char *) XSTRING (string
)->data
;
1429 f
->menu_bar_vector
= menu_items
;
1430 f
->menu_bar_items_used
= menu_items_used
;
1435 /* Make a widget-value tree containing
1436 just the top level menu bar strings. */
1438 items
= FRAME_MENU_BAR_ITEMS (f
);
1439 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1443 string
= XVECTOR (items
)->contents
[i
+ 1];
1447 wv
= xmalloc_widget_value ();
1448 wv
->name
= (char *) XSTRING (string
)->data
;
1451 wv
->button_type
= BUTTON_TYPE_NONE
;
1452 /* This prevents lwlib from assuming this
1453 menu item is really supposed to be empty. */
1454 /* The EMACS_INT cast avoids a warning.
1455 This value just has to be different from small integers. */
1456 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1461 first_wv
->contents
= wv
;
1465 /* Forget what we thought we knew about what is in the
1466 detailed contents of the menu bar menus.
1467 Changing the top level always destroys the contents. */
1468 f
->menu_bar_items_used
= 0;
1471 /* Create or update the menu bar widget. */
1477 /* Empty current menubar, rather than creating a fresh one. */
1478 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1483 menubar_widget
= CreateMenu ();
1485 fill_in_menu (menubar_widget
, first_wv
->contents
);
1487 free_menubar_widget_value_tree (first_wv
);
1490 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1492 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1493 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1494 /* Causes flicker when menu bar is updated
1495 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1497 /* Force the window size to be recomputed so that the frame's text
1498 area remains the same, if menubar has just been created. */
1499 if (old_widget
== NULL
)
1500 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1506 /* Called from Fx_create_frame to create the initial menubar of a frame
1507 before it is mapped, so that the window is mapped with the menubar already
1508 there instead of us tacking it on later and thrashing the window after it
1512 initialize_frame_menubar (f
)
1515 /* This function is called before the first chance to redisplay
1516 the frame. It has to be, so the frame will have the right size. */
1517 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1518 set_frame_menubar (f
, 1, 1);
1521 /* Get rid of the menu bar of frame F, and free its storage.
1522 This is used when deleting a frame, and when turning off the menu bar. */
1525 free_frame_menubar (f
)
1531 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1532 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1533 f
->output_data
.w32
->menubar_widget
= NULL
;
1541 /* w32_menu_show actually displays a menu using the panes and items in
1542 menu_items and returns the value selected from it; we assume input
1543 is blocked by the caller. */
1545 /* F is the frame the menu is for.
1546 X and Y are the frame-relative specified position,
1547 relative to the inside upper left corner of the frame F.
1548 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1549 KEYMAPS is 1 if this menu was specified with keymaps;
1550 in that case, we return a list containing the chosen item's value
1551 and perhaps also the pane's prefix.
1552 TITLE is the specified menu title.
1553 ERROR is a place to store an error message string in case of failure.
1554 (We return nil on failure, but the value doesn't actually matter.) */
1557 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1567 int menu_item_selection
;
1570 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1571 widget_value
**submenu_stack
1572 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1573 Lisp_Object
*subprefix_stack
1574 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1575 int submenu_depth
= 0;
1580 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1582 *error
= "Empty menu";
1586 /* Create a tree of widget_value objects
1587 representing the panes and their items. */
1588 wv
= xmalloc_widget_value ();
1592 wv
->button_type
= BUTTON_TYPE_NONE
;
1596 /* Loop over all panes and items, filling in the tree. */
1598 while (i
< menu_items_used
)
1600 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1602 submenu_stack
[submenu_depth
++] = save_wv
;
1608 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1611 save_wv
= submenu_stack
[--submenu_depth
];
1615 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1616 && submenu_depth
!= 0)
1617 i
+= MENU_ITEMS_PANE_LENGTH
;
1618 /* Ignore a nil in the item list.
1619 It's meaningful only for dialog boxes. */
1620 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1622 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1624 /* Create a new pane. */
1625 Lisp_Object pane_name
, prefix
;
1627 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1628 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1629 #ifndef HAVE_MULTILINGUAL_MENU
1630 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1632 pane_name
= ENCODE_SYSTEM (pane_name
);
1633 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1636 pane_string
= (NILP (pane_name
)
1637 ? "" : (char *) XSTRING (pane_name
)->data
);
1638 /* If there is just one top-level pane, put all its items directly
1639 under the top-level menu. */
1640 if (menu_items_n_panes
== 1)
1643 /* If the pane has a meaningful name,
1644 make the pane a top-level menu item
1645 with its items as a submenu beneath it. */
1646 if (!keymaps
&& strcmp (pane_string
, ""))
1648 wv
= xmalloc_widget_value ();
1652 first_wv
->contents
= wv
;
1653 wv
->name
= pane_string
;
1654 if (keymaps
&& !NILP (prefix
))
1658 wv
->button_type
= BUTTON_TYPE_NONE
;
1662 else if (first_pane
)
1668 i
+= MENU_ITEMS_PANE_LENGTH
;
1672 /* Create a new item within current pane. */
1673 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1675 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1676 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1677 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1678 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1679 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1680 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1681 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1683 #ifndef HAVE_MULTILINGUAL_MENU
1684 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1686 item_name
= ENCODE_SYSTEM (item_name
);
1687 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1689 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1691 descrip
= ENCODE_SYSTEM (descrip
);
1692 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1694 #endif /* not HAVE_MULTILINGUAL_MENU */
1696 wv
= xmalloc_widget_value ();
1700 save_wv
->contents
= wv
;
1701 wv
->name
= (char *) XSTRING (item_name
)->data
;
1702 if (!NILP (descrip
))
1703 wv
->key
= (char *) XSTRING (descrip
)->data
;
1705 /* Use the contents index as call_data, since we are
1706 restricted to 16-bits.. */
1707 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1708 wv
->enabled
= !NILP (enable
);
1711 wv
->button_type
= BUTTON_TYPE_NONE
;
1712 else if (EQ (type
, QCtoggle
))
1713 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1714 else if (EQ (type
, QCradio
))
1715 wv
->button_type
= BUTTON_TYPE_RADIO
;
1719 wv
->selected
= !NILP (selected
);
1721 wv
->help
= XSTRING (help
)->data
;
1725 i
+= MENU_ITEMS_ITEM_LENGTH
;
1729 /* Deal with the title, if it is non-nil. */
1732 widget_value
*wv_title
= xmalloc_widget_value ();
1733 widget_value
*wv_sep
= xmalloc_widget_value ();
1735 /* Maybe replace this separator with a bitmap or owner-draw item
1736 so that it looks better. Having two separators looks odd. */
1737 wv_sep
->name
= "--";
1738 wv_sep
->next
= first_wv
->contents
;
1740 #ifndef HAVE_MULTILINGUAL_MENU
1741 if (STRING_MULTIBYTE (title
))
1742 title
= ENCODE_SYSTEM (title
);
1744 wv_title
->name
= (char *) XSTRING (title
)->data
;
1745 wv_title
->enabled
= TRUE
;
1746 wv_title
->title
= TRUE
;
1747 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1748 wv_title
->next
= wv_sep
;
1749 first_wv
->contents
= wv_title
;
1752 /* Actually create the menu. */
1753 menu
= CreatePopupMenu ();
1754 fill_in_menu (menu
, first_wv
->contents
);
1756 /* Adjust coordinates to be root-window-relative. */
1759 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1761 /* No selection has been chosen yet. */
1762 menu_item_selection
= 0;
1764 /* Display the menu. */
1765 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1766 WM_EMACS_TRACKPOPUPMENU
,
1767 (WPARAM
)menu
, (LPARAM
)&pos
);
1769 /* Clean up extraneous mouse events which might have been generated
1771 discard_mouse_events ();
1773 /* Free the widget_value objects we used to specify the contents. */
1774 free_menubar_widget_value_tree (first_wv
);
1778 /* Find the selected item, and its pane, to return
1779 the proper value. */
1780 if (menu_item_selection
!= 0)
1782 Lisp_Object prefix
, entry
;
1784 prefix
= entry
= Qnil
;
1786 while (i
< menu_items_used
)
1788 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1790 subprefix_stack
[submenu_depth
++] = prefix
;
1794 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1796 prefix
= subprefix_stack
[--submenu_depth
];
1799 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1802 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1803 i
+= MENU_ITEMS_PANE_LENGTH
;
1805 /* Ignore a nil in the item list.
1806 It's meaningful only for dialog boxes. */
1807 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1812 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1813 if (menu_item_selection
== i
)
1819 entry
= Fcons (entry
, Qnil
);
1821 entry
= Fcons (prefix
, entry
);
1822 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1823 if (!NILP (subprefix_stack
[j
]))
1824 entry
= Fcons (subprefix_stack
[j
], entry
);
1828 i
+= MENU_ITEMS_ITEM_LENGTH
;
1837 static char * button_names
[] = {
1838 "button1", "button2", "button3", "button4", "button5",
1839 "button6", "button7", "button8", "button9", "button10" };
1842 w32_dialog_show (f
, keymaps
, title
, error
)
1848 int i
, nb_buttons
=0;
1849 char dialog_name
[6];
1850 int menu_item_selection
;
1852 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1854 /* Number of elements seen so far, before boundary. */
1856 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1857 int boundary_seen
= 0;
1861 if (menu_items_n_panes
> 1)
1863 *error
= "Multiple panes in dialog box";
1867 /* Create a tree of widget_value objects
1868 representing the text label and buttons. */
1870 Lisp_Object pane_name
, prefix
;
1872 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1873 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1874 pane_string
= (NILP (pane_name
)
1875 ? "" : (char *) XSTRING (pane_name
)->data
);
1876 prev_wv
= xmalloc_widget_value ();
1877 prev_wv
->value
= pane_string
;
1878 if (keymaps
&& !NILP (prefix
))
1880 prev_wv
->enabled
= 1;
1881 prev_wv
->name
= "message";
1884 /* Loop over all panes and items, filling in the tree. */
1885 i
= MENU_ITEMS_PANE_LENGTH
;
1886 while (i
< menu_items_used
)
1889 /* Create a new item within current pane. */
1890 Lisp_Object item_name
, enable
, descrip
, help
;
1892 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1893 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1895 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1896 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1898 if (NILP (item_name
))
1900 free_menubar_widget_value_tree (first_wv
);
1901 *error
= "Submenu in dialog items";
1904 if (EQ (item_name
, Qquote
))
1906 /* This is the boundary between left-side elts
1907 and right-side elts. Stop incrementing right_count. */
1912 if (nb_buttons
>= 9)
1914 free_menubar_widget_value_tree (first_wv
);
1915 *error
= "Too many dialog items";
1919 wv
= xmalloc_widget_value ();
1921 wv
->name
= (char *) button_names
[nb_buttons
];
1922 if (!NILP (descrip
))
1923 wv
->key
= (char *) XSTRING (descrip
)->data
;
1924 wv
->value
= (char *) XSTRING (item_name
)->data
;
1925 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1926 wv
->enabled
= !NILP (enable
);
1929 if (! boundary_seen
)
1933 i
+= MENU_ITEMS_ITEM_LENGTH
;
1936 /* If the boundary was not specified,
1937 by default put half on the left and half on the right. */
1938 if (! boundary_seen
)
1939 left_count
= nb_buttons
- nb_buttons
/ 2;
1941 wv
= xmalloc_widget_value ();
1942 wv
->name
= dialog_name
;
1944 /* Dialog boxes use a really stupid name encoding
1945 which specifies how many buttons to use
1946 and how many buttons are on the right.
1947 The Q means something also. */
1948 dialog_name
[0] = 'Q';
1949 dialog_name
[1] = '0' + nb_buttons
;
1950 dialog_name
[2] = 'B';
1951 dialog_name
[3] = 'R';
1952 /* Number of buttons to put on the right. */
1953 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1955 wv
->contents
= first_wv
;
1959 /* Actually create the dialog. */
1961 dialog_id
= widget_id_tick
++;
1962 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1963 f
->output_data
.w32
->widget
, 1, 0,
1964 dialog_selection_callback
, 0);
1965 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
1968 /* Free the widget_value objects we used to specify the contents. */
1969 free_menubar_widget_value_tree (first_wv
);
1971 /* No selection has been chosen yet. */
1972 menu_item_selection
= 0;
1974 /* Display the menu. */
1976 lw_pop_up_all_widgets (dialog_id
);
1977 popup_activated_flag
= 1;
1979 /* Process events that apply to the menu. */
1980 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1982 lw_destroy_all_widgets (dialog_id
);
1985 /* Find the selected item, and its pane, to return
1986 the proper value. */
1987 if (menu_item_selection
!= 0)
1993 while (i
< menu_items_used
)
1997 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2000 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2001 i
+= MENU_ITEMS_PANE_LENGTH
;
2006 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2007 if (menu_item_selection
== i
)
2011 entry
= Fcons (entry
, Qnil
);
2013 entry
= Fcons (prefix
, entry
);
2017 i
+= MENU_ITEMS_ITEM_LENGTH
;
2026 /* Is this item a separator? */
2028 name_is_separator (name
)
2033 /* Check if name string consists of only dashes ('-'). */
2034 while (*name
== '-') name
++;
2035 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2036 or "--deep-shadow". We don't implement them yet, se we just treat
2037 them like normal separators. */
2038 return (*name
== '\0' || start
+ 2 == name
);
2042 /* Indicate boundary between left and right. */
2044 add_left_right_boundary (HMENU menu
)
2046 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2050 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2056 if (name_is_separator (wv
->name
))
2058 fuFlags
= MF_SEPARATOR
;
2064 fuFlags
= MF_STRING
;
2066 fuFlags
= MF_STRING
| MF_GRAYED
;
2068 if (wv
->key
!= NULL
)
2070 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2071 strcpy (out_string
, wv
->name
);
2072 strcat (out_string
, "\t");
2073 strcat (out_string
, wv
->key
);
2076 out_string
= wv
->name
;
2078 if (wv
->title
|| wv
->call_data
== 0)
2080 #if 0 /* no GC while popup menu is active */
2081 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2082 strcpy (out_string
, wv
->name
);
2084 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2086 /* Draw radio buttons and tickboxes. */
2087 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2088 wv
->button_type
== BUTTON_TYPE_RADIO
))
2089 fuFlags
|= MF_CHECKED
;
2091 fuFlags
|= MF_UNCHECKED
;
2100 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2103 /* This must be done after the menu item is created. */
2104 if ((fuFlags
& MF_STRING
) != 0)
2106 HMODULE user32
= GetModuleHandle ("user32.dll");
2107 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2109 if (set_menu_item_info
)
2112 bzero (&info
, sizeof (info
));
2113 info
.cbSize
= sizeof (info
);
2114 info
.fMask
= MIIM_DATA
;
2116 /* Set help string for menu item. */
2117 info
.dwItemData
= (DWORD
)wv
->help
;
2119 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2121 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2122 RADIO items, but is not available on NT 3.51 and earlier. */
2123 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2124 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2125 info
.dwTypeData
= out_string
;
2126 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2129 set_menu_item_info (menu
,
2130 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2134 return return_value
;
2137 /* Construct native Windows menu(bar) based on widget_value tree. */
2139 fill_in_menu (HMENU menu
, widget_value
*wv
)
2141 int items_added
= 0;
2143 for ( ; wv
!= NULL
; wv
= wv
->next
)
2147 HMENU sub_menu
= CreatePopupMenu ();
2149 if (sub_menu
== NULL
)
2152 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2153 !add_menu_item (menu
, wv
, sub_menu
))
2155 DestroyMenu (sub_menu
);
2161 if (!add_menu_item (menu
, wv
, NULL
))
2171 /* popup_activated_flag not actually used on W32 */
2175 /* Display help string for currently pointed to menu item. Not
2176 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2179 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2181 int pane
= 0; /* TODO: Set this to pane number. */
2183 HMODULE user32
= GetModuleHandle ("user32.dll");
2184 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2186 if (get_menu_item_info
)
2188 extern Lisp_Object Qmenu_item
;
2189 Lisp_Object
*first_item
;
2190 Lisp_Object pane_name
;
2191 Lisp_Object menu_object
;
2194 bzero (&info
, sizeof (info
));
2195 info
.cbSize
= sizeof (info
);
2196 info
.fMask
= MIIM_DATA
;
2197 get_menu_item_info (menu
, item
, FALSE
, &info
);
2199 first_item
= XVECTOR (menu_items
)->contents
;
2200 if (EQ (first_item
[0], Qt
))
2201 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2202 else if (EQ (first_item
[0], Qquote
))
2203 /* This shouldn't happen, see w32_menu_show. */
2204 pane_name
= empty_string
;
2206 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2208 /* (menu-item MENU-NAME PANE-NUMBER) */
2209 menu_object
= Fcons (Qmenu_item
,
2211 Fcons (make_number (pane
), Qnil
)));
2213 show_help_echo (info
.dwItemData
?
2214 build_string ((char *) info
.dwItemData
) : Qnil
,
2215 Qnil
, menu_object
, make_number (item
), 1);
2221 #endif /* HAVE_MENUS */
2225 staticpro (&menu_items
);
2228 Qdebug_on_next_call
= intern ("debug-on-next-call");
2229 staticpro (&Qdebug_on_next_call
);
2231 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2232 "Frame for which we are updating a menu.\n\
2233 The enable predicate for a menu command should check this variable.");
2234 Vmenu_updating_frame
= Qnil
;
2236 defsubr (&Sx_popup_menu
);
2238 defsubr (&Sx_popup_dialog
);