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"
30 #include "blockinput.h"
35 /* This may include sys/types.h, and that somehow loses
36 if this is not done before the other system files. */
39 /* Load sys/types.h if not already loaded.
40 In some systems loading it twice is suicidal. */
42 #include <sys/types.h>
45 #include "dispextern.h"
47 #undef HAVE_MULTILINGUAL_MENU
48 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
53 typedef void * XtPointer
;
63 typedef struct _widget_value
67 /* value (meaning depend on widget type) */
69 /* keyboard equivalent. no implications for XtTranslations */
71 /* Help string or null if none. */
75 /* true if selected */
77 /* The type of a button. */
78 enum button_type button_type
;
79 /* true if menu title */
82 /* true if was edited (maintained by get_value) */
84 /* true if has changed (maintained by lw library) */
86 /* true if this widget itself has changed,
87 but not counting the other widgets found in the `next' field. */
88 change_type this_one_change
;
90 /* Contents of the sub-widgets, also selected slot for checkbox */
91 struct _widget_value
* contents
;
92 /* data passed to callback */
94 /* next one in the list */
95 struct _widget_value
* next
;
97 /* slot for the toolkit dependent part. Always initialize to NULL. */
99 /* tell us if we should free the toolkit data slot when freeing the
100 widget_value itself. */
101 Boolean free_toolkit_data
;
103 /* we resource the widget_value structures; this points to the next
104 one on the free list if this one has been deallocated.
106 struct _widget_value
*free_list
;
110 /* LocalAlloc/Free is a reasonably good allocator. */
111 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
112 #define free_widget_value(wv) LocalFree (wv)
114 /******************************************************************/
116 #define min(x,y) (((x) < (y)) ? (x) : (y))
117 #define max(x,y) (((x) > (y)) ? (x) : (y))
124 Lisp_Object Vmenu_updating_frame
;
126 Lisp_Object Qdebug_on_next_call
;
128 extern Lisp_Object Qmenu_bar
;
129 extern Lisp_Object Qmouse_click
, Qevent_kind
;
131 extern Lisp_Object QCtoggle
, QCradio
;
133 extern Lisp_Object Voverriding_local_map
;
134 extern Lisp_Object Voverriding_local_map_menu_flag
;
136 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
138 extern Lisp_Object Qmenu_bar_update_hook
;
140 void set_frame_menubar ();
142 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
143 Lisp_Object
, Lisp_Object
, Lisp_Object
,
144 Lisp_Object
, Lisp_Object
));
145 static Lisp_Object
w32_dialog_show ();
146 static Lisp_Object
w32_menu_show ();
148 static void keymap_panes ();
149 static void single_keymap_panes ();
150 static void single_menu_item ();
151 static void list_of_panes ();
152 static void list_of_items ();
154 /* This holds a Lisp vector that holds the results of decoding
155 the keymaps or alist-of-alists that specify a menu.
157 It describes the panes and items within the panes.
159 Each pane is described by 3 elements in the vector:
160 t, the pane name, the pane's prefix key.
161 Then follow the pane's items, with 5 elements per item:
162 the item string, the enable flag, the item's value,
163 the definition, and the equivalent keyboard key's description string.
165 In some cases, multiple levels of menus may be described.
166 A single vector slot containing nil indicates the start of a submenu.
167 A single vector slot containing lambda indicates the end of a submenu.
168 The submenu follows a menu item which is the way to reach the submenu.
170 A single vector slot containing quote indicates that the
171 following items should appear on the right of a dialog box.
173 Using a Lisp vector to hold this information while we decode it
174 takes care of protecting all the data from GC. */
176 #define MENU_ITEMS_PANE_NAME 1
177 #define MENU_ITEMS_PANE_PREFIX 2
178 #define MENU_ITEMS_PANE_LENGTH 3
182 MENU_ITEMS_ITEM_NAME
= 0,
183 MENU_ITEMS_ITEM_ENABLE
,
184 MENU_ITEMS_ITEM_VALUE
,
185 MENU_ITEMS_ITEM_EQUIV_KEY
,
186 MENU_ITEMS_ITEM_DEFINITION
,
187 MENU_ITEMS_ITEM_TYPE
,
188 MENU_ITEMS_ITEM_SELECTED
,
189 MENU_ITEMS_ITEM_HELP
,
190 MENU_ITEMS_ITEM_LENGTH
193 static Lisp_Object menu_items
;
195 /* Number of slots currently allocated in menu_items. */
196 static int menu_items_allocated
;
198 /* This is the index in menu_items of the first empty slot. */
199 static int menu_items_used
;
201 /* The number of panes currently recorded in menu_items,
202 excluding those within submenus. */
203 static int menu_items_n_panes
;
205 /* Current depth within submenus. */
206 static int menu_items_submenu_depth
;
208 /* Flag which when set indicates a dialog or menu has been posted by
209 Xt on behalf of one of the widget sets. */
210 static int popup_activated_flag
;
212 static int next_menubar_widget_id
;
214 /* This is set nonzero after the user activates the menu bar, and set
215 to zero again after the menu bars are redisplayed by prepare_menu_bar.
216 While it is nonzero, all calls to set_frame_menubar go deep.
218 I don't understand why this is needed, but it does seem to be
219 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
221 int pending_menu_activation
;
224 /* Return the frame whose ->output_data.w32->menubar_widget equals
227 static struct frame
*
228 menubar_id_to_frame (id
)
231 Lisp_Object tail
, frame
;
234 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
237 if (!GC_FRAMEP (frame
))
240 if (!FRAME_WINDOW_P (f
))
242 if (f
->output_data
.w32
->menubar_widget
== id
)
248 /* Initialize the menu_items structure if we haven't already done so.
249 Also mark it as currently empty. */
254 if (NILP (menu_items
))
256 menu_items_allocated
= 60;
257 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
261 menu_items_n_panes
= 0;
262 menu_items_submenu_depth
= 0;
265 /* Call at the end of generating the data in menu_items.
266 This fills in the number of items in the last pane. */
273 /* Call when finished using the data for the current menu
277 discard_menu_items ()
279 /* Free the structure if it is especially large.
280 Otherwise, hold on to it, to save time. */
281 if (menu_items_allocated
> 200)
284 menu_items_allocated
= 0;
288 /* Make the menu_items vector twice as large. */
294 int old_size
= menu_items_allocated
;
297 menu_items_allocated
*= 2;
298 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
299 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
300 old_size
* sizeof (Lisp_Object
));
303 /* Begin a submenu. */
306 push_submenu_start ()
308 if (menu_items_used
+ 1 > menu_items_allocated
)
311 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
312 menu_items_submenu_depth
++;
320 if (menu_items_used
+ 1 > menu_items_allocated
)
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
324 menu_items_submenu_depth
--;
327 /* Indicate boundary between left and right. */
330 push_left_right_boundary ()
332 if (menu_items_used
+ 1 > menu_items_allocated
)
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
338 /* Start a new menu pane in menu_items..
339 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
342 push_menu_pane (name
, prefix_vec
)
343 Lisp_Object name
, prefix_vec
;
345 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
348 if (menu_items_submenu_depth
== 0)
349 menu_items_n_panes
++;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
351 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
355 /* Push one menu item into the current pane. NAME is the string to
356 display. ENABLE if non-nil means this item can be selected. KEY
357 is the key generated by choosing this item, or nil if this item
358 doesn't really have a definition. DEF is the definition of this
359 item. EQUIV is the textual description of the keyboard equivalent
360 for this item (or nil if none). TYPE is the type of this menu
361 item, one of nil, `toggle' or `radio'. */
364 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
365 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
367 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
380 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
381 and generate menu panes for them in menu_items.
382 If NOTREAL is nonzero,
383 don't bother really computing whether an item is enabled. */
386 keymap_panes (keymaps
, nmaps
, notreal
)
387 Lisp_Object
*keymaps
;
395 /* Loop over the given keymaps, making a pane for each map.
396 But don't make a pane that is empty--ignore that map instead.
397 P is the number of panes we have made so far. */
398 for (mapno
= 0; mapno
< nmaps
; mapno
++)
399 single_keymap_panes (keymaps
[mapno
],
400 map_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
402 finish_menu_items ();
405 /* This is a recursive subroutine of keymap_panes.
406 It handles one keymap, KEYMAP.
407 The other arguments are passed along
408 or point to local variables of the previous function.
409 If NOTREAL is nonzero, only check for equivalent key bindings, don't
410 evaluate expressions in menu items and don't make any menu.
412 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
415 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
417 Lisp_Object pane_name
;
422 Lisp_Object pending_maps
= Qnil
;
423 Lisp_Object tail
, item
;
424 struct gcpro gcpro1
, gcpro2
;
429 push_menu_pane (pane_name
, prefix
);
431 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
433 GCPRO2 (keymap
, pending_maps
);
434 /* Look at each key binding, and if it is a menu item add it
438 single_menu_item (XCAR (item
), XCDR (item
),
439 &pending_maps
, notreal
, maxdepth
);
440 else if (VECTORP (item
))
442 /* Loop over the char values represented in the vector. */
443 int len
= XVECTOR (item
)->size
;
445 for (c
= 0; c
< len
; c
++)
447 Lisp_Object character
;
448 XSETFASTINT (character
, c
);
449 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
450 &pending_maps
, notreal
, maxdepth
);
456 /* Process now any submenus which want to be panes at this level. */
457 while (!NILP (pending_maps
))
459 Lisp_Object elt
, eltcdr
, string
;
460 elt
= Fcar (pending_maps
);
462 string
= XCAR (eltcdr
);
463 /* We no longer discard the @ from the beginning of the string here.
464 Instead, we do this in w32_menu_show. */
465 single_keymap_panes (Fcar (elt
), string
,
466 XCDR (eltcdr
), notreal
, maxdepth
- 1);
467 pending_maps
= Fcdr (pending_maps
);
471 /* This is a subroutine of single_keymap_panes that handles one
473 KEY is a key in a keymap and ITEM is its binding.
474 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
476 If NOTREAL is nonzero, only check for equivalent key bindings, don't
477 evaluate expressions in menu items and don't make any menu.
478 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
481 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
482 Lisp_Object key
, item
;
483 Lisp_Object
*pending_maps_ptr
;
484 int maxdepth
, notreal
;
486 Lisp_Object map
, item_string
, enabled
;
487 struct gcpro gcpro1
, gcpro2
;
490 /* Parse the menu item and leave the result in item_properties. */
492 res
= parse_menu_item (item
, notreal
, 0);
495 return; /* Not a menu item. */
497 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
501 /* We don't want to make a menu, just traverse the keymaps to
502 precompute equivalent key bindings. */
504 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
508 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
509 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
511 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
514 /* An enabled separate pane. Remember this to handle it later. */
515 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
520 push_menu_item (item_string
, enabled
, key
,
521 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
522 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
523 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
524 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
525 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
527 /* Display a submenu using the toolkit. */
528 if (! (NILP (map
) || NILP (enabled
)))
530 push_submenu_start ();
531 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
536 /* Push all the panes and items of a menu described by the
537 alist-of-alists MENU.
538 This handles old-fashioned calls to x-popup-menu. */
548 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
550 Lisp_Object elt
, pane_name
, pane_data
;
552 pane_name
= Fcar (elt
);
553 CHECK_STRING (pane_name
, 0);
554 push_menu_pane (pane_name
, Qnil
);
555 pane_data
= Fcdr (elt
);
556 CHECK_CONS (pane_data
, 0);
557 list_of_items (pane_data
);
560 finish_menu_items ();
563 /* Push the items in a single pane defined by the alist PANE. */
569 Lisp_Object tail
, item
, item1
;
571 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
575 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
576 else if (NILP (item
))
577 push_left_right_boundary ();
580 CHECK_CONS (item
, 0);
582 CHECK_STRING (item1
, 1);
583 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
588 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
589 "Pop up a deck-of-cards menu and return user's selection.\n\
590 POSITION is a position specification. This is either a mouse button event\n\
591 or a list ((XOFFSET YOFFSET) WINDOW)\n\
592 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
593 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
594 This controls the position of the center of the first line\n\
595 in the first pane of the menu, not the top left of the menu as a whole.\n\
596 If POSITION is t, it means to use the current mouse position.\n\
598 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
599 The menu items come from key bindings that have a menu string as well as\n\
600 a definition; actually, the \"definition\" in such a key binding looks like\n\
601 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
602 the keymap as a top-level element.\n\n\
603 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
604 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
606 You can also use a list of keymaps as MENU.\n\
607 Then each keymap makes a separate pane.\n\
608 When MENU is a keymap or a list of keymaps, the return value\n\
609 is a list of events.\n\n\
611 Alternatively, you can specify a menu of multiple panes\n\
612 with a list of the form (TITLE PANE1 PANE2...),\n\
613 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
614 Each ITEM is normally a cons cell (STRING . VALUE);\n\
615 but a string can appear as an item--that makes a nonselectable line\n\
617 With this form of menu, the return value is VALUE from the chosen item.\n\
619 If POSITION is nil, don't display the menu at all, just precalculate the\n\
620 cached information about equivalent key sequences.")
622 Lisp_Object position
, menu
;
624 Lisp_Object keymap
, tem
;
628 Lisp_Object selection
;
630 Lisp_Object x
, y
, window
;
636 if (! NILP (position
))
640 /* Decode the first argument: find the window and the coordinates. */
641 if (EQ (position
, Qt
)
642 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
643 || EQ (XCAR (position
), Qtool_bar
))))
645 /* Use the mouse's current position. */
646 FRAME_PTR new_f
= SELECTED_FRAME ();
647 Lisp_Object bar_window
;
648 enum scroll_bar_part part
;
651 if (mouse_position_hook
)
652 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
653 &part
, &x
, &y
, &time
);
655 XSETFRAME (window
, new_f
);
658 window
= selected_window
;
665 tem
= Fcar (position
);
668 window
= Fcar (Fcdr (position
));
670 y
= Fcar (Fcdr (tem
));
675 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
676 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
677 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
686 /* Decode where to put the menu. */
694 else if (WINDOWP (window
))
696 CHECK_LIVE_WINDOW (window
, 0);
697 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
699 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
700 * XFASTINT (XWINDOW (window
)->left
));
701 ypos
= (FRAME_LINE_HEIGHT (f
)
702 * XFASTINT (XWINDOW (window
)->top
));
705 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
706 but I don't want to make one now. */
707 CHECK_WINDOW (window
, 0);
712 XSETFRAME (Vmenu_updating_frame
, f
);
714 Vmenu_updating_frame
= Qnil
;
715 #endif /* HAVE_MENUS */
720 /* Decode the menu items from what was specified. */
722 keymap
= get_keymap (menu
, 0, 0);
725 /* We were given a keymap. Extract menu info from the keymap. */
728 /* Extract the detailed info to make one pane. */
729 keymap_panes (&menu
, 1, NILP (position
));
731 /* Search for a string appearing directly as an element of the keymap.
732 That string is the title of the menu. */
733 prompt
= map_prompt (keymap
);
734 if (NILP (title
) && !NILP (prompt
))
737 /* Make that be the pane title of the first pane. */
738 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
739 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
743 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
745 /* We were given a list of keymaps. */
746 int nmaps
= XFASTINT (Flength (menu
));
748 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
753 /* The first keymap that has a prompt string
754 supplies the menu title. */
755 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
759 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
761 prompt
= map_prompt (keymap
);
762 if (NILP (title
) && !NILP (prompt
))
766 /* Extract the detailed info to make one pane. */
767 keymap_panes (maps
, nmaps
, NILP (position
));
769 /* Make the title be the pane title of the first pane. */
770 if (!NILP (title
) && menu_items_n_panes
>= 0)
771 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
777 /* We were given an old-fashioned menu. */
779 CHECK_STRING (title
, 1);
781 list_of_panes (Fcdr (menu
));
788 discard_menu_items ();
794 /* Display them in a menu. */
797 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
798 keymaps
, title
, &error_name
);
801 discard_menu_items ();
804 #endif /* HAVE_MENUS */
806 if (error_name
) error (error_name
);
812 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
813 "Pop up a dialog box and return user's selection.\n\
814 POSITION specifies which frame to use.\n\
815 This is normally a mouse button event or a window or frame.\n\
816 If POSITION is t, it means to use the frame the mouse is on.\n\
817 The dialog box appears in the middle of the specified frame.\n\
819 CONTENTS specifies the alternatives to display in the dialog box.\n\
820 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
821 Each ITEM is a cons cell (STRING . VALUE).\n\
822 The return value is VALUE from the chosen item.\n\n\
823 An ITEM may also be just a string--that makes a nonselectable item.\n\
824 An ITEM may also be nil--that means to put all preceding items\n\
825 on the left of the dialog box and all following items on the right.\n\
826 \(By default, approximately half appear on each side.)")
828 Lisp_Object position
, contents
;
835 /* Decode the first argument: find the window or frame to use. */
836 if (EQ (position
, Qt
)
837 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
838 || EQ (XCAR (position
), Qtool_bar
))))
840 #if 0 /* Using the frame the mouse is on may not be right. */
841 /* Use the mouse's current position. */
842 FRAME_PTR new_f
= SELECTED_FRAME ();
843 Lisp_Object bar_window
;
844 enum scroll_bar_part part
;
848 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
851 XSETFRAME (window
, new_f
);
853 window
= selected_window
;
855 window
= selected_window
;
857 else if (CONSP (position
))
860 tem
= Fcar (position
);
862 window
= Fcar (Fcdr (position
));
865 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
866 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
869 else if (WINDOWP (position
) || FRAMEP (position
))
874 /* Decode where to put the menu. */
878 else if (WINDOWP (window
))
880 CHECK_LIVE_WINDOW (window
, 0);
881 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
884 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
885 but I don't want to make one now. */
886 CHECK_WINDOW (window
, 0);
889 /* Display a menu with these alternatives
890 in the middle of frame F. */
892 Lisp_Object x
, y
, frame
, newpos
;
893 XSETFRAME (frame
, f
);
894 XSETINT (x
, x_pixel_width (f
) / 2);
895 XSETINT (y
, x_pixel_height (f
) / 2);
896 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
898 return Fx_popup_menu (newpos
,
899 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
901 #else /* HAVE_DIALOGS */
905 Lisp_Object selection
;
907 /* Decode the dialog items from what was specified. */
908 title
= Fcar (contents
);
909 CHECK_STRING (title
, 1);
911 list_of_panes (Fcons (contents
, Qnil
));
913 /* Display them in a dialog box. */
915 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
918 discard_menu_items ();
920 if (error_name
) error (error_name
);
923 #endif /* HAVE_DIALOGS */
926 /* Activate the menu bar of frame F.
927 This is called from keyboard.c when it gets the
928 menu_bar_activate_event out of the Emacs event queue.
930 To activate the menu bar, we signal to the input thread that it can
931 return from the WM_INITMENU message, allowing the normal Windows
932 processing of the menus.
934 But first we recompute the menu bar contents (the whole tree).
936 This way we can safely execute Lisp code. */
939 x_activate_menubar (f
)
942 set_frame_menubar (f
, 0, 1);
944 /* Lock out further menubar changes while active. */
945 f
->output_data
.w32
->menubar_active
= 1;
947 /* Signal input thread to return from WM_INITMENU. */
948 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
951 /* This callback is called from the menu bar pulldown menu
952 when the user makes a selection.
953 Figure out what the user chose
954 and put the appropriate events into the keyboard buffer. */
957 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
959 Lisp_Object prefix
, entry
;
961 Lisp_Object
*subprefix_stack
;
962 int submenu_depth
= 0;
968 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
969 vector
= f
->menu_bar_vector
;
972 while (i
< f
->menu_bar_items_used
)
974 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
976 subprefix_stack
[submenu_depth
++] = prefix
;
980 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
982 prefix
= subprefix_stack
[--submenu_depth
];
985 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
987 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
988 i
+= MENU_ITEMS_PANE_LENGTH
;
992 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
993 /* The EMACS_INT cast avoids a warning. There's no problem
994 as long as pointers have enough bits to hold small integers. */
995 if ((int) (EMACS_INT
) client_data
== i
)
998 struct input_event buf
;
1001 XSETFRAME (frame
, f
);
1002 buf
.kind
= MENU_BAR_EVENT
;
1003 buf
.frame_or_window
= frame
;
1005 kbd_buffer_store_event (&buf
);
1007 for (j
= 0; j
< submenu_depth
; j
++)
1008 if (!NILP (subprefix_stack
[j
]))
1010 buf
.kind
= MENU_BAR_EVENT
;
1011 buf
.frame_or_window
= frame
;
1012 buf
.arg
= subprefix_stack
[j
];
1013 kbd_buffer_store_event (&buf
);
1018 buf
.kind
= MENU_BAR_EVENT
;
1019 buf
.frame_or_window
= frame
;
1021 kbd_buffer_store_event (&buf
);
1024 buf
.kind
= MENU_BAR_EVENT
;
1025 buf
.frame_or_window
= frame
;
1027 kbd_buffer_store_event (&buf
);
1031 i
+= MENU_ITEMS_ITEM_LENGTH
;
1036 /* Allocate a widget_value, blocking input. */
1039 xmalloc_widget_value ()
1041 widget_value
*value
;
1044 value
= malloc_widget_value ();
1050 /* This recursively calls free_widget_value on the tree of widgets.
1051 It must free all data that was malloc'ed for these widget_values.
1052 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1053 must be left alone. */
1056 free_menubar_widget_value_tree (wv
)
1061 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1063 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1065 free_menubar_widget_value_tree (wv
->contents
);
1066 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1070 free_menubar_widget_value_tree (wv
->next
);
1071 wv
->next
= (widget_value
*) 0xDEADBEEF;
1074 free_widget_value (wv
);
1078 /* Return a tree of widget_value structures for a menu bar item
1079 whose event type is ITEM_KEY (with string ITEM_NAME)
1080 and whose contents come from the list of keymaps MAPS. */
1082 static widget_value
*
1083 single_submenu (item_key
, item_name
, maps
)
1084 Lisp_Object item_key
, item_name
, maps
;
1086 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1088 int submenu_depth
= 0;
1091 Lisp_Object
*mapvec
;
1092 widget_value
**submenu_stack
;
1093 int previous_items
= menu_items_used
;
1094 int top_level_items
= 0;
1096 length
= Flength (maps
);
1097 len
= XINT (length
);
1099 /* Convert the list MAPS into a vector MAPVEC. */
1100 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1101 for (i
= 0; i
< len
; i
++)
1103 mapvec
[i
] = Fcar (maps
);
1107 menu_items_n_panes
= 0;
1109 /* Loop over the given keymaps, making a pane for each map.
1110 But don't make a pane that is empty--ignore that map instead. */
1111 for (i
= 0; i
< len
; i
++)
1113 if (SYMBOLP (mapvec
[i
])
1114 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1116 /* Here we have a command at top level in the menu bar
1117 as opposed to a submenu. */
1118 top_level_items
= 1;
1119 push_menu_pane (Qnil
, Qnil
);
1120 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1121 Qnil
, Qnil
, Qnil
, Qnil
);
1124 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1127 /* Create a tree of widget_value objects
1128 representing the panes and their items. */
1131 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1132 wv
= xmalloc_widget_value ();
1136 wv
->button_type
= BUTTON_TYPE_NONE
;
1141 /* Loop over all panes and items made during this call
1142 and construct a tree of widget_value objects.
1143 Ignore the panes and items made by previous calls to
1144 single_submenu, even though those are also in menu_items. */
1146 while (i
< menu_items_used
)
1148 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1150 submenu_stack
[submenu_depth
++] = save_wv
;
1155 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1158 save_wv
= submenu_stack
[--submenu_depth
];
1161 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1162 && submenu_depth
!= 0)
1163 i
+= MENU_ITEMS_PANE_LENGTH
;
1164 /* Ignore a nil in the item list.
1165 It's meaningful only for dialog boxes. */
1166 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1168 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1170 /* Create a new pane. */
1171 Lisp_Object pane_name
, prefix
;
1174 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1175 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1177 #ifndef HAVE_MULTILINGUAL_MENU
1178 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1180 pane_name
= ENCODE_SYSTEM (pane_name
);
1181 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1184 pane_string
= (NILP (pane_name
)
1185 ? "" : (char *) XSTRING (pane_name
)->data
);
1186 /* If there is just one top-level pane, put all its items directly
1187 under the top-level menu. */
1188 if (menu_items_n_panes
== 1)
1191 /* If the pane has a meaningful name,
1192 make the pane a top-level menu item
1193 with its items as a submenu beneath it. */
1194 if (strcmp (pane_string
, ""))
1196 wv
= xmalloc_widget_value ();
1200 first_wv
->contents
= wv
;
1201 wv
->name
= pane_string
;
1202 /* Ignore the @ that means "separate pane".
1203 This is a kludge, but this isn't worth more time. */
1204 if (!NILP (prefix
) && wv
->name
[0] == '@')
1208 wv
->button_type
= BUTTON_TYPE_NONE
;
1212 i
+= MENU_ITEMS_PANE_LENGTH
;
1216 /* Create a new item within current pane. */
1217 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1220 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1221 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1222 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1223 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1224 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1225 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1226 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1228 #ifndef HAVE_MULTILINGUAL_MENU
1229 if (STRING_MULTIBYTE (item_name
))
1231 item_name
= ENCODE_SYSTEM (item_name
);
1232 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1235 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1237 descrip
= ENCODE_SYSTEM (descrip
);
1238 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1240 #endif /* not HAVE_MULTILINGUAL_MENU */
1242 wv
= xmalloc_widget_value ();
1246 save_wv
->contents
= wv
;
1248 wv
->name
= (char *) XSTRING (item_name
)->data
;
1249 if (!NILP (descrip
))
1250 wv
->key
= (char *) XSTRING (descrip
)->data
;
1252 /* The EMACS_INT cast avoids a warning. There's no problem
1253 as long as pointers have enough bits to hold small integers. */
1254 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1255 wv
->enabled
= !NILP (enable
);
1258 wv
->button_type
= BUTTON_TYPE_NONE
;
1259 else if (EQ (type
, QCradio
))
1260 wv
->button_type
= BUTTON_TYPE_RADIO
;
1261 else if (EQ (type
, QCtoggle
))
1262 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1266 wv
->selected
= !NILP (selected
);
1268 wv
->help
= (char *) XSTRING (help
)->data
;
1274 i
+= MENU_ITEMS_ITEM_LENGTH
;
1278 /* If we have just one "menu item"
1279 that was originally a button, return it by itself. */
1280 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1282 wv
= first_wv
->contents
;
1283 free_widget_value (first_wv
);
1290 /* Set the contents of the menubar widgets of frame F.
1291 The argument FIRST_TIME is currently ignored;
1292 it is set the first time this is called, from initialize_frame_menubar. */
1295 set_frame_menubar (f
, first_time
, deep_p
)
1300 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1302 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1305 /* We must not change the menubar when actually in use. */
1306 if (f
->output_data
.w32
->menubar_active
)
1309 XSETFRAME (Vmenu_updating_frame
, f
);
1311 if (! menubar_widget
)
1313 else if (pending_menu_activation
&& !deep_p
)
1316 wv
= xmalloc_widget_value ();
1317 wv
->name
= "menubar";
1320 wv
->button_type
= BUTTON_TYPE_NONE
;
1325 /* Make a widget-value tree representing the entire menu trees. */
1327 struct buffer
*prev
= current_buffer
;
1329 int specpdl_count
= specpdl_ptr
- specpdl
;
1330 int previous_menu_items_used
= f
->menu_bar_items_used
;
1331 Lisp_Object
*previous_items
1332 = (Lisp_Object
*) alloca (previous_menu_items_used
1333 * sizeof (Lisp_Object
));
1335 /* If we are making a new widget, its contents are empty,
1336 do always reinitialize them. */
1337 if (! menubar_widget
)
1338 previous_menu_items_used
= 0;
1340 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1341 specbind (Qinhibit_quit
, Qt
);
1342 /* Don't let the debugger step into this code
1343 because it is not reentrant. */
1344 specbind (Qdebug_on_next_call
, Qnil
);
1346 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1347 if (NILP (Voverriding_local_map_menu_flag
))
1349 specbind (Qoverriding_terminal_local_map
, Qnil
);
1350 specbind (Qoverriding_local_map
, Qnil
);
1353 set_buffer_internal_1 (XBUFFER (buffer
));
1355 /* Run the Lucid hook. */
1356 safe_run_hooks (Qactivate_menubar_hook
);
1357 /* If it has changed current-menubar from previous value,
1358 really recompute the menubar from the value. */
1359 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1360 call0 (Qrecompute_lucid_menubar
);
1361 safe_run_hooks (Qmenu_bar_update_hook
);
1362 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1364 items
= FRAME_MENU_BAR_ITEMS (f
);
1366 inhibit_garbage_collection ();
1368 /* Save the frame's previous menu bar contents data. */
1369 if (previous_menu_items_used
)
1370 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1371 previous_menu_items_used
* sizeof (Lisp_Object
));
1373 /* Fill in the current menu bar contents. */
1374 menu_items
= f
->menu_bar_vector
;
1375 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1377 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1379 Lisp_Object key
, string
, maps
;
1381 key
= XVECTOR (items
)->contents
[i
];
1382 string
= XVECTOR (items
)->contents
[i
+ 1];
1383 maps
= XVECTOR (items
)->contents
[i
+ 2];
1387 wv
= single_submenu (key
, string
, maps
);
1391 first_wv
->contents
= wv
;
1392 /* Don't set wv->name here; GC during the loop might relocate it. */
1394 wv
->button_type
= BUTTON_TYPE_NONE
;
1398 finish_menu_items ();
1400 set_buffer_internal_1 (prev
);
1401 unbind_to (specpdl_count
, Qnil
);
1403 /* If there has been no change in the Lisp-level contents
1404 of the menu bar, skip redisplaying it. Just exit. */
1406 for (i
= 0; i
< previous_menu_items_used
; i
++)
1407 if (menu_items_used
== i
1408 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1410 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1412 free_menubar_widget_value_tree (first_wv
);
1418 /* Now GC cannot happen during the lifetime of the widget_value,
1419 so it's safe to store data from a Lisp_String. */
1420 wv
= first_wv
->contents
;
1421 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1424 string
= XVECTOR (items
)->contents
[i
+ 1];
1427 wv
->name
= (char *) XSTRING (string
)->data
;
1431 f
->menu_bar_vector
= menu_items
;
1432 f
->menu_bar_items_used
= menu_items_used
;
1437 /* Make a widget-value tree containing
1438 just the top level menu bar strings. */
1440 items
= FRAME_MENU_BAR_ITEMS (f
);
1441 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1445 string
= XVECTOR (items
)->contents
[i
+ 1];
1449 wv
= xmalloc_widget_value ();
1450 wv
->name
= (char *) XSTRING (string
)->data
;
1453 wv
->button_type
= BUTTON_TYPE_NONE
;
1454 /* This prevents lwlib from assuming this
1455 menu item is really supposed to be empty. */
1456 /* The EMACS_INT cast avoids a warning.
1457 This value just has to be different from small integers. */
1458 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1463 first_wv
->contents
= wv
;
1467 /* Forget what we thought we knew about what is in the
1468 detailed contents of the menu bar menus.
1469 Changing the top level always destroys the contents. */
1470 f
->menu_bar_items_used
= 0;
1473 /* Create or update the menu bar widget. */
1479 /* Empty current menubar, rather than creating a fresh one. */
1480 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1485 menubar_widget
= CreateMenu ();
1487 fill_in_menu (menubar_widget
, first_wv
->contents
);
1489 free_menubar_widget_value_tree (first_wv
);
1492 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1494 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1495 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1496 /* Causes flicker when menu bar is updated
1497 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1499 /* Force the window size to be recomputed so that the frame's text
1500 area remains the same, if menubar has just been created. */
1501 if (old_widget
== NULL
)
1502 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1508 /* Called from Fx_create_frame to create the initial menubar of a frame
1509 before it is mapped, so that the window is mapped with the menubar already
1510 there instead of us tacking it on later and thrashing the window after it
1514 initialize_frame_menubar (f
)
1517 /* This function is called before the first chance to redisplay
1518 the frame. It has to be, so the frame will have the right size. */
1519 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1520 set_frame_menubar (f
, 1, 1);
1523 /* Get rid of the menu bar of frame F, and free its storage.
1524 This is used when deleting a frame, and when turning off the menu bar. */
1527 free_frame_menubar (f
)
1533 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1534 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1535 f
->output_data
.w32
->menubar_widget
= NULL
;
1543 /* w32_menu_show actually displays a menu using the panes and items in
1544 menu_items and returns the value selected from it; we assume input
1545 is blocked by the caller. */
1547 /* F is the frame the menu is for.
1548 X and Y are the frame-relative specified position,
1549 relative to the inside upper left corner of the frame F.
1550 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1551 KEYMAPS is 1 if this menu was specified with keymaps;
1552 in that case, we return a list containing the chosen item's value
1553 and perhaps also the pane's prefix.
1554 TITLE is the specified menu title.
1555 ERROR is a place to store an error message string in case of failure.
1556 (We return nil on failure, but the value doesn't actually matter.) */
1559 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1569 int menu_item_selection
;
1572 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1573 widget_value
**submenu_stack
1574 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1575 Lisp_Object
*subprefix_stack
1576 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1577 int submenu_depth
= 0;
1582 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1584 *error
= "Empty menu";
1588 /* Create a tree of widget_value objects
1589 representing the panes and their items. */
1590 wv
= xmalloc_widget_value ();
1594 wv
->button_type
= BUTTON_TYPE_NONE
;
1598 /* Loop over all panes and items, filling in the tree. */
1600 while (i
< menu_items_used
)
1602 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1604 submenu_stack
[submenu_depth
++] = save_wv
;
1610 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1613 save_wv
= submenu_stack
[--submenu_depth
];
1617 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1618 && submenu_depth
!= 0)
1619 i
+= MENU_ITEMS_PANE_LENGTH
;
1620 /* Ignore a nil in the item list.
1621 It's meaningful only for dialog boxes. */
1622 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1624 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1626 /* Create a new pane. */
1627 Lisp_Object pane_name
, prefix
;
1629 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1630 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1631 #ifndef HAVE_MULTILINGUAL_MENU
1632 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1634 pane_name
= ENCODE_SYSTEM (pane_name
);
1635 AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
) = pane_name
;
1638 pane_string
= (NILP (pane_name
)
1639 ? "" : (char *) XSTRING (pane_name
)->data
);
1640 /* If there is just one top-level pane, put all its items directly
1641 under the top-level menu. */
1642 if (menu_items_n_panes
== 1)
1645 /* If the pane has a meaningful name,
1646 make the pane a top-level menu item
1647 with its items as a submenu beneath it. */
1648 if (!keymaps
&& strcmp (pane_string
, ""))
1650 wv
= xmalloc_widget_value ();
1654 first_wv
->contents
= wv
;
1655 wv
->name
= pane_string
;
1656 if (keymaps
&& !NILP (prefix
))
1660 wv
->button_type
= BUTTON_TYPE_NONE
;
1664 else if (first_pane
)
1670 i
+= MENU_ITEMS_PANE_LENGTH
;
1674 /* Create a new item within current pane. */
1675 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1677 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1678 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1679 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1680 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1681 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1682 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1683 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1685 #ifndef HAVE_MULTILINGUAL_MENU
1686 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1688 item_name
= ENCODE_SYSTEM (item_name
);
1689 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
) = item_name
;
1691 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1693 descrip
= ENCODE_SYSTEM (descrip
);
1694 AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
) = descrip
;
1696 #endif /* not HAVE_MULTILINGUAL_MENU */
1698 wv
= xmalloc_widget_value ();
1702 save_wv
->contents
= wv
;
1703 wv
->name
= (char *) XSTRING (item_name
)->data
;
1704 if (!NILP (descrip
))
1705 wv
->key
= (char *) XSTRING (descrip
)->data
;
1707 /* Use the contents index as call_data, since we are
1708 restricted to 16-bits.. */
1709 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1710 wv
->enabled
= !NILP (enable
);
1713 wv
->button_type
= BUTTON_TYPE_NONE
;
1714 else if (EQ (type
, QCtoggle
))
1715 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1716 else if (EQ (type
, QCradio
))
1717 wv
->button_type
= BUTTON_TYPE_RADIO
;
1721 wv
->selected
= !NILP (selected
);
1723 wv
->help
= (char *) XSTRING (help
)->data
;
1729 i
+= MENU_ITEMS_ITEM_LENGTH
;
1733 /* Deal with the title, if it is non-nil. */
1736 widget_value
*wv_title
= xmalloc_widget_value ();
1737 widget_value
*wv_sep
= xmalloc_widget_value ();
1739 /* Maybe replace this separator with a bitmap or owner-draw item
1740 so that it looks better. Having two separators looks odd. */
1741 wv_sep
->name
= "--";
1742 wv_sep
->next
= first_wv
->contents
;
1744 #ifndef HAVE_MULTILINGUAL_MENU
1745 if (STRING_MULTIBYTE (title
))
1746 title
= ENCODE_SYSTEM (title
);
1748 wv_title
->name
= (char *) XSTRING (title
)->data
;
1749 wv_title
->enabled
= TRUE
;
1750 wv_title
->title
= TRUE
;
1751 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1752 wv_title
->next
= wv_sep
;
1753 first_wv
->contents
= wv_title
;
1756 /* Actually create the menu. */
1757 menu
= CreatePopupMenu ();
1758 fill_in_menu (menu
, first_wv
->contents
);
1760 /* Adjust coordinates to be root-window-relative. */
1763 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1765 /* No selection has been chosen yet. */
1766 menu_item_selection
= 0;
1768 /* Display the menu. */
1769 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1770 WM_EMACS_TRACKPOPUPMENU
,
1771 (WPARAM
)menu
, (LPARAM
)&pos
);
1773 /* Clean up extraneous mouse events which might have been generated
1775 discard_mouse_events ();
1777 /* Free the widget_value objects we used to specify the contents. */
1778 free_menubar_widget_value_tree (first_wv
);
1782 /* Find the selected item, and its pane, to return
1783 the proper value. */
1784 if (menu_item_selection
!= 0)
1786 Lisp_Object prefix
, entry
;
1788 prefix
= entry
= Qnil
;
1790 while (i
< menu_items_used
)
1792 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1794 subprefix_stack
[submenu_depth
++] = prefix
;
1798 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1800 prefix
= subprefix_stack
[--submenu_depth
];
1803 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1806 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1807 i
+= MENU_ITEMS_PANE_LENGTH
;
1809 /* Ignore a nil in the item list.
1810 It's meaningful only for dialog boxes. */
1811 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1816 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1817 if (menu_item_selection
== i
)
1823 entry
= Fcons (entry
, Qnil
);
1825 entry
= Fcons (prefix
, entry
);
1826 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1827 if (!NILP (subprefix_stack
[j
]))
1828 entry
= Fcons (subprefix_stack
[j
], entry
);
1832 i
+= MENU_ITEMS_ITEM_LENGTH
;
1841 static char * button_names
[] = {
1842 "button1", "button2", "button3", "button4", "button5",
1843 "button6", "button7", "button8", "button9", "button10" };
1846 w32_dialog_show (f
, keymaps
, title
, error
)
1852 int i
, nb_buttons
=0;
1853 char dialog_name
[6];
1854 int menu_item_selection
;
1856 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1858 /* Number of elements seen so far, before boundary. */
1860 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1861 int boundary_seen
= 0;
1865 if (menu_items_n_panes
> 1)
1867 *error
= "Multiple panes in dialog box";
1871 /* Create a tree of widget_value objects
1872 representing the text label and buttons. */
1874 Lisp_Object pane_name
, prefix
;
1876 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1877 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1878 pane_string
= (NILP (pane_name
)
1879 ? "" : (char *) XSTRING (pane_name
)->data
);
1880 prev_wv
= xmalloc_widget_value ();
1881 prev_wv
->value
= pane_string
;
1882 if (keymaps
&& !NILP (prefix
))
1884 prev_wv
->enabled
= 1;
1885 prev_wv
->name
= "message";
1888 /* Loop over all panes and items, filling in the tree. */
1889 i
= MENU_ITEMS_PANE_LENGTH
;
1890 while (i
< menu_items_used
)
1893 /* Create a new item within current pane. */
1894 Lisp_Object item_name
, enable
, descrip
, help
;
1896 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1897 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1899 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1900 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1902 if (NILP (item_name
))
1904 free_menubar_widget_value_tree (first_wv
);
1905 *error
= "Submenu in dialog items";
1908 if (EQ (item_name
, Qquote
))
1910 /* This is the boundary between left-side elts
1911 and right-side elts. Stop incrementing right_count. */
1916 if (nb_buttons
>= 9)
1918 free_menubar_widget_value_tree (first_wv
);
1919 *error
= "Too many dialog items";
1923 wv
= xmalloc_widget_value ();
1925 wv
->name
= (char *) button_names
[nb_buttons
];
1926 if (!NILP (descrip
))
1927 wv
->key
= (char *) XSTRING (descrip
)->data
;
1928 wv
->value
= (char *) XSTRING (item_name
)->data
;
1929 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1930 wv
->enabled
= !NILP (enable
);
1933 if (! boundary_seen
)
1937 i
+= MENU_ITEMS_ITEM_LENGTH
;
1940 /* If the boundary was not specified,
1941 by default put half on the left and half on the right. */
1942 if (! boundary_seen
)
1943 left_count
= nb_buttons
- nb_buttons
/ 2;
1945 wv
= xmalloc_widget_value ();
1946 wv
->name
= dialog_name
;
1948 /* Dialog boxes use a really stupid name encoding
1949 which specifies how many buttons to use
1950 and how many buttons are on the right.
1951 The Q means something also. */
1952 dialog_name
[0] = 'Q';
1953 dialog_name
[1] = '0' + nb_buttons
;
1954 dialog_name
[2] = 'B';
1955 dialog_name
[3] = 'R';
1956 /* Number of buttons to put on the right. */
1957 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1959 wv
->contents
= first_wv
;
1963 /* Actually create the dialog. */
1965 dialog_id
= widget_id_tick
++;
1966 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1967 f
->output_data
.w32
->widget
, 1, 0,
1968 dialog_selection_callback
, 0);
1969 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
1972 /* Free the widget_value objects we used to specify the contents. */
1973 free_menubar_widget_value_tree (first_wv
);
1975 /* No selection has been chosen yet. */
1976 menu_item_selection
= 0;
1978 /* Display the menu. */
1980 lw_pop_up_all_widgets (dialog_id
);
1981 popup_activated_flag
= 1;
1983 /* Process events that apply to the menu. */
1984 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1986 lw_destroy_all_widgets (dialog_id
);
1989 /* Find the selected item, and its pane, to return
1990 the proper value. */
1991 if (menu_item_selection
!= 0)
1997 while (i
< menu_items_used
)
2001 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2004 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2005 i
+= MENU_ITEMS_PANE_LENGTH
;
2010 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2011 if (menu_item_selection
== i
)
2015 entry
= Fcons (entry
, Qnil
);
2017 entry
= Fcons (prefix
, entry
);
2021 i
+= MENU_ITEMS_ITEM_LENGTH
;
2030 /* Is this item a separator? */
2032 name_is_separator (name
)
2037 /* Check if name string consists of only dashes ('-'). */
2038 while (*name
== '-') name
++;
2039 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2040 or "--deep-shadow". We don't implement them yet, se we just treat
2041 them like normal separators. */
2042 return (*name
== '\0' || start
+ 2 == name
);
2046 /* Indicate boundary between left and right. */
2048 add_left_right_boundary (HMENU menu
)
2050 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2054 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2060 if (name_is_separator (wv
->name
))
2062 fuFlags
= MF_SEPARATOR
;
2068 fuFlags
= MF_STRING
;
2070 fuFlags
= MF_STRING
| MF_GRAYED
;
2072 if (wv
->key
!= NULL
)
2074 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2075 strcpy (out_string
, wv
->name
);
2076 strcat (out_string
, "\t");
2077 strcat (out_string
, wv
->key
);
2080 out_string
= wv
->name
;
2082 if (wv
->title
|| wv
->call_data
== 0)
2084 #if 0 /* no GC while popup menu is active */
2085 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2086 strcpy (out_string
, wv
->name
);
2088 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2090 /* Draw radio buttons and tickboxes. */
2091 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2092 wv
->button_type
== BUTTON_TYPE_RADIO
))
2093 fuFlags
|= MF_CHECKED
;
2095 fuFlags
|= MF_UNCHECKED
;
2104 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2107 /* This must be done after the menu item is created. */
2108 if (!wv
->title
&& wv
->call_data
!= 0)
2110 HMODULE user32
= GetModuleHandle ("user32.dll");
2111 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2113 if (set_menu_item_info
)
2116 bzero (&info
, sizeof (info
));
2117 info
.cbSize
= sizeof (info
);
2118 info
.fMask
= MIIM_DATA
;
2120 /* Set help string for menu item. */
2121 info
.dwItemData
= (DWORD
)wv
->help
;
2123 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2125 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2126 RADIO items, but is not available on NT 3.51 and earlier. */
2127 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2128 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2129 info
.dwTypeData
= out_string
;
2130 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2133 set_menu_item_info (menu
,
2134 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2138 return return_value
;
2141 /* Construct native Windows menu(bar) based on widget_value tree. */
2143 fill_in_menu (HMENU menu
, widget_value
*wv
)
2145 int items_added
= 0;
2147 for ( ; wv
!= NULL
; wv
= wv
->next
)
2151 HMENU sub_menu
= CreatePopupMenu ();
2153 if (sub_menu
== NULL
)
2156 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2157 !add_menu_item (menu
, wv
, sub_menu
))
2159 DestroyMenu (sub_menu
);
2165 if (!add_menu_item (menu
, wv
, NULL
))
2175 /* popup_activated_flag not actually used on W32 */
2179 /* Display help string for currently pointed to menu item. Not
2180 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2183 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2185 int pane
= 0; /* TODO: Set this to pane number. */
2187 HMODULE user32
= GetModuleHandle ("user32.dll");
2188 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2190 if (get_menu_item_info
)
2192 extern Lisp_Object Qmenu_item
;
2193 Lisp_Object
*first_item
;
2194 Lisp_Object pane_name
;
2195 Lisp_Object menu_object
;
2198 bzero (&info
, sizeof (info
));
2199 info
.cbSize
= sizeof (info
);
2200 info
.fMask
= MIIM_DATA
;
2201 get_menu_item_info (menu
, item
, FALSE
, &info
);
2203 first_item
= XVECTOR (menu_items
)->contents
;
2204 if (EQ (first_item
[0], Qt
))
2205 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2206 else if (EQ (first_item
[0], Qquote
))
2207 /* This shouldn't happen, see w32_menu_show. */
2208 pane_name
= build_string ("");
2210 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2212 /* (menu-item MENU-NAME PANE-NUMBER) */
2213 menu_object
= Fcons (Qmenu_item
,
2215 Fcons (make_number (pane
), Qnil
)));
2217 show_help_echo (info
.dwItemData
?
2218 build_string ((char *) info
.dwItemData
) : Qnil
,
2219 Qnil
, menu_object
, make_number (item
), 1);
2225 #endif /* HAVE_MENUS */
2229 staticpro (&menu_items
);
2232 Qdebug_on_next_call
= intern ("debug-on-next-call");
2233 staticpro (&Qdebug_on_next_call
);
2235 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2236 "Frame for which we are updating a menu.\n\
2237 The enable predicate for a menu command should check this variable.");
2238 Vmenu_updating_frame
= Qnil
;
2240 defsubr (&Sx_popup_menu
);
2242 defsubr (&Sx_popup_dialog
);