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"
33 /* This may include sys/types.h, and that somehow loses
34 if this is not done before the other system files. */
37 /* Load sys/types.h if not already loaded.
38 In some systems loading it twice is suicidal. */
40 #include <sys/types.h>
43 #include "dispextern.h"
45 #undef HAVE_MULTILINGUAL_MENU
46 #undef HAVE_DIALOGS /* NTEMACS_TODO: Implement native dialogs. */
48 /******************************************************************/
49 /* Definitions copied from lwlib.h */
51 typedef void * XtPointer
;
57 #if 0 /* Not used below. */
58 typedef enum _change_type
74 typedef struct _widget_value
78 /* value (meaning depend on widget type) */
80 /* keyboard equivalent. no implications for XtTranslations */
82 /* Help string or null if none. */
86 /* true if selected */
88 /* The type of a button. */
89 enum button_type button_type
;
90 /* true if menu title */
93 /* true if was edited (maintained by get_value) */
95 /* true if has changed (maintained by lw library) */
97 /* true if this widget itself has changed,
98 but not counting the other widgets found in the `next' field. */
99 change_type this_one_change
;
101 /* Contents of the sub-widgets, also selected slot for checkbox */
102 struct _widget_value
* contents
;
103 /* data passed to callback */
105 /* next one in the list */
106 struct _widget_value
* next
;
108 /* slot for the toolkit dependent part. Always initialize to NULL. */
110 /* tell us if we should free the toolkit data slot when freeing the
111 widget_value itself. */
112 Boolean free_toolkit_data
;
114 /* we resource the widget_value structures; this points to the next
115 one on the free list if this one has been deallocated.
117 struct _widget_value
*free_list
;
121 /* LocalAlloc/Free is a reasonably good allocator. */
122 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
123 #define free_widget_value(wv) LocalFree (wv)
125 /******************************************************************/
127 #define min(x,y) (((x) < (y)) ? (x) : (y))
128 #define max(x,y) (((x) > (y)) ? (x) : (y))
135 Lisp_Object Vmenu_updating_frame
;
137 Lisp_Object Qdebug_on_next_call
;
139 extern Lisp_Object Qmenu_bar
;
140 extern Lisp_Object Qmouse_click
, Qevent_kind
;
142 extern Lisp_Object QCtoggle
, QCradio
;
144 extern Lisp_Object Voverriding_local_map
;
145 extern Lisp_Object Voverriding_local_map_menu_flag
;
147 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
149 extern Lisp_Object Qmenu_bar_update_hook
;
151 void set_frame_menubar ();
153 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
154 Lisp_Object
, Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
));
156 static Lisp_Object
w32_dialog_show ();
157 static Lisp_Object
w32_menu_show ();
159 static void keymap_panes ();
160 static void single_keymap_panes ();
161 static void single_menu_item ();
162 static void list_of_panes ();
163 static void list_of_items ();
165 /* This holds a Lisp vector that holds the results of decoding
166 the keymaps or alist-of-alists that specify a menu.
168 It describes the panes and items within the panes.
170 Each pane is described by 3 elements in the vector:
171 t, the pane name, the pane's prefix key.
172 Then follow the pane's items, with 5 elements per item:
173 the item string, the enable flag, the item's value,
174 the definition, and the equivalent keyboard key's description string.
176 In some cases, multiple levels of menus may be described.
177 A single vector slot containing nil indicates the start of a submenu.
178 A single vector slot containing lambda indicates the end of a submenu.
179 The submenu follows a menu item which is the way to reach the submenu.
181 A single vector slot containing quote indicates that the
182 following items should appear on the right of a dialog box.
184 Using a Lisp vector to hold this information while we decode it
185 takes care of protecting all the data from GC. */
187 #define MENU_ITEMS_PANE_NAME 1
188 #define MENU_ITEMS_PANE_PREFIX 2
189 #define MENU_ITEMS_PANE_LENGTH 3
193 MENU_ITEMS_ITEM_NAME
= 0,
194 MENU_ITEMS_ITEM_ENABLE
,
195 MENU_ITEMS_ITEM_VALUE
,
196 MENU_ITEMS_ITEM_EQUIV_KEY
,
197 MENU_ITEMS_ITEM_DEFINITION
,
198 MENU_ITEMS_ITEM_TYPE
,
199 MENU_ITEMS_ITEM_SELECTED
,
200 MENU_ITEMS_ITEM_HELP
,
201 MENU_ITEMS_ITEM_LENGTH
204 static Lisp_Object menu_items
;
206 /* Number of slots currently allocated in menu_items. */
207 static int menu_items_allocated
;
209 /* This is the index in menu_items of the first empty slot. */
210 static int menu_items_used
;
212 /* The number of panes currently recorded in menu_items,
213 excluding those within submenus. */
214 static int menu_items_n_panes
;
216 /* Current depth within submenus. */
217 static int menu_items_submenu_depth
;
219 /* Flag which when set indicates a dialog or menu has been posted by
220 Xt on behalf of one of the widget sets. */
221 static int popup_activated_flag
;
223 static int next_menubar_widget_id
;
225 /* This is set nonzero after the user activates the menu bar, and set
226 to zero again after the menu bars are redisplayed by prepare_menu_bar.
227 While it is nonzero, all calls to set_frame_menubar go deep.
229 I don't understand why this is needed, but it does seem to be
230 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
232 int pending_menu_activation
;
235 /* Return the frame whose ->output_data.w32->menubar_widget equals
238 static struct frame
*
239 menubar_id_to_frame (id
)
242 Lisp_Object tail
, frame
;
245 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
248 if (!GC_FRAMEP (frame
))
251 if (!FRAME_WINDOW_P (f
))
253 if (f
->output_data
.w32
->menubar_widget
== id
)
259 /* Initialize the menu_items structure if we haven't already done so.
260 Also mark it as currently empty. */
265 if (NILP (menu_items
))
267 menu_items_allocated
= 60;
268 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
272 menu_items_n_panes
= 0;
273 menu_items_submenu_depth
= 0;
276 /* Call at the end of generating the data in menu_items.
277 This fills in the number of items in the last pane. */
284 /* Call when finished using the data for the current menu
288 discard_menu_items ()
290 /* Free the structure if it is especially large.
291 Otherwise, hold on to it, to save time. */
292 if (menu_items_allocated
> 200)
295 menu_items_allocated
= 0;
299 /* Make the menu_items vector twice as large. */
305 int old_size
= menu_items_allocated
;
308 menu_items_allocated
*= 2;
309 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
310 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
311 old_size
* sizeof (Lisp_Object
));
314 /* Begin a submenu. */
317 push_submenu_start ()
319 if (menu_items_used
+ 1 > menu_items_allocated
)
322 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
323 menu_items_submenu_depth
++;
331 if (menu_items_used
+ 1 > menu_items_allocated
)
334 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
335 menu_items_submenu_depth
--;
338 /* Indicate boundary between left and right. */
341 push_left_right_boundary ()
343 if (menu_items_used
+ 1 > menu_items_allocated
)
346 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
349 /* Start a new menu pane in menu_items..
350 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
353 push_menu_pane (name
, prefix_vec
)
354 Lisp_Object name
, prefix_vec
;
356 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
359 if (menu_items_submenu_depth
== 0)
360 menu_items_n_panes
++;
361 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
362 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
363 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
366 /* Push one menu item into the current pane. NAME is the string to
367 display. ENABLE if non-nil means this item can be selected. KEY
368 is the key generated by choosing this item, or nil if this item
369 doesn't really have a definition. DEF is the definition of this
370 item. EQUIV is the textual description of the keyboard equivalent
371 for this item (or nil if none). TYPE is the type of this menu
372 item, one of nil, `toggle' or `radio'. */
375 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
376 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
378 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
381 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
382 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
383 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
384 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
385 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
386 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
391 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
392 and generate menu panes for them in menu_items.
393 If NOTREAL is nonzero,
394 don't bother really computing whether an item is enabled. */
397 keymap_panes (keymaps
, nmaps
, notreal
)
398 Lisp_Object
*keymaps
;
406 /* Loop over the given keymaps, making a pane for each map.
407 But don't make a pane that is empty--ignore that map instead.
408 P is the number of panes we have made so far. */
409 for (mapno
= 0; mapno
< nmaps
; mapno
++)
410 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
412 finish_menu_items ();
415 /* This is a recursive subroutine of keymap_panes.
416 It handles one keymap, KEYMAP.
417 The other arguments are passed along
418 or point to local variables of the previous function.
419 If NOTREAL is nonzero, only check for equivalent key bindings, don't
420 evaluate expressions in menu items and don't make any menu.
422 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
425 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
427 Lisp_Object pane_name
;
432 Lisp_Object pending_maps
= Qnil
;
433 Lisp_Object tail
, item
;
434 struct gcpro gcpro1
, gcpro2
;
439 push_menu_pane (pane_name
, prefix
);
441 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
443 GCPRO2 (keymap
, pending_maps
);
444 /* Look at each key binding, and if it is a menu item add it
448 single_menu_item (XCAR (item
), XCDR (item
),
449 &pending_maps
, notreal
, maxdepth
);
450 else if (VECTORP (item
))
452 /* Loop over the char values represented in the vector. */
453 int len
= XVECTOR (item
)->size
;
455 for (c
= 0; c
< len
; c
++)
457 Lisp_Object character
;
458 XSETFASTINT (character
, c
);
459 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
460 &pending_maps
, notreal
, maxdepth
);
466 /* Process now any submenus which want to be panes at this level. */
467 while (!NILP (pending_maps
))
469 Lisp_Object elt
, eltcdr
, string
;
470 elt
= Fcar (pending_maps
);
472 string
= XCAR (eltcdr
);
473 /* We no longer discard the @ from the beginning of the string here.
474 Instead, we do this in w32_menu_show. */
475 single_keymap_panes (Fcar (elt
), string
,
476 XCDR (eltcdr
), notreal
, maxdepth
- 1);
477 pending_maps
= Fcdr (pending_maps
);
481 /* This is a subroutine of single_keymap_panes that handles one
483 KEY is a key in a keymap and ITEM is its binding.
484 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
486 If NOTREAL is nonzero, only check for equivalent key bindings, don't
487 evaluate expressions in menu items and don't make any menu.
488 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
491 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
492 Lisp_Object key
, item
;
493 Lisp_Object
*pending_maps_ptr
;
494 int maxdepth
, notreal
;
496 Lisp_Object map
, item_string
, enabled
;
497 struct gcpro gcpro1
, gcpro2
;
500 /* Parse the menu item and leave the result in item_properties. */
502 res
= parse_menu_item (item
, notreal
, 0);
505 return; /* Not a menu item. */
507 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
511 /* We don't want to make a menu, just traverse the keymaps to
512 precompute equivalent key bindings. */
514 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
518 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
519 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
521 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
524 /* An enabled separate pane. Remember this to handle it later. */
525 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
530 push_menu_item (item_string
, enabled
, key
,
531 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
532 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
533 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
534 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
535 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
537 /* Display a submenu using the toolkit. */
538 if (! (NILP (map
) || NILP (enabled
)))
540 push_submenu_start ();
541 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
546 /* Push all the panes and items of a menu described by the
547 alist-of-alists MENU.
548 This handles old-fashioned calls to x-popup-menu. */
558 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
560 Lisp_Object elt
, pane_name
, pane_data
;
562 pane_name
= Fcar (elt
);
563 CHECK_STRING (pane_name
, 0);
564 push_menu_pane (pane_name
, Qnil
);
565 pane_data
= Fcdr (elt
);
566 CHECK_CONS (pane_data
, 0);
567 list_of_items (pane_data
);
570 finish_menu_items ();
573 /* Push the items in a single pane defined by the alist PANE. */
579 Lisp_Object tail
, item
, item1
;
581 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
585 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
586 else if (NILP (item
))
587 push_left_right_boundary ();
590 CHECK_CONS (item
, 0);
592 CHECK_STRING (item1
, 1);
593 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
598 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
599 "Pop up a deck-of-cards menu and return user's selection.\n\
600 POSITION is a position specification. This is either a mouse button event\n\
601 or a list ((XOFFSET YOFFSET) WINDOW)\n\
602 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
603 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
604 This controls the position of the center of the first line\n\
605 in the first pane of the menu, not the top left of the menu as a whole.\n\
606 If POSITION is t, it means to use the current mouse position.\n\
608 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
609 The menu items come from key bindings that have a menu string as well as\n\
610 a definition; actually, the \"definition\" in such a key binding looks like\n\
611 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
612 the keymap as a top-level element.\n\n\
613 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
614 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
616 You can also use a list of keymaps as MENU.\n\
617 Then each keymap makes a separate pane.\n\
618 When MENU is a keymap or a list of keymaps, the return value\n\
619 is a list of events.\n\n\
621 Alternatively, you can specify a menu of multiple panes\n\
622 with a list of the form (TITLE PANE1 PANE2...),\n\
623 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
624 Each ITEM is normally a cons cell (STRING . VALUE);\n\
625 but a string can appear as an item--that makes a nonselectable line\n\
627 With this form of menu, the return value is VALUE from the chosen item.\n\
629 If POSITION is nil, don't display the menu at all, just precalculate the\n\
630 cached information about equivalent key sequences.")
632 Lisp_Object position
, menu
;
634 Lisp_Object keymap
, tem
;
638 Lisp_Object selection
;
640 Lisp_Object x
, y
, window
;
646 if (! NILP (position
))
650 /* Decode the first argument: find the window and the coordinates. */
651 if (EQ (position
, Qt
)
652 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
654 /* Use the mouse's current position. */
655 FRAME_PTR new_f
= SELECTED_FRAME ();
656 Lisp_Object bar_window
;
657 enum scroll_bar_part part
;
660 if (mouse_position_hook
)
661 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
662 &part
, &x
, &y
, &time
);
664 XSETFRAME (window
, new_f
);
667 window
= selected_window
;
674 tem
= Fcar (position
);
677 window
= Fcar (Fcdr (position
));
679 y
= Fcar (Fcdr (tem
));
684 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
685 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
686 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
695 /* Decode where to put the menu. */
703 else if (WINDOWP (window
))
705 CHECK_LIVE_WINDOW (window
, 0);
706 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
708 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
709 * XFASTINT (XWINDOW (window
)->left
));
710 ypos
= (FRAME_LINE_HEIGHT (f
)
711 * XFASTINT (XWINDOW (window
)->top
));
714 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
715 but I don't want to make one now. */
716 CHECK_WINDOW (window
, 0);
721 XSETFRAME (Vmenu_updating_frame
, f
);
723 Vmenu_updating_frame
= Qnil
;
724 #endif /* HAVE_MENUS */
729 /* Decode the menu items from what was specified. */
731 keymap
= Fkeymapp (menu
);
734 tem
= Fkeymapp (Fcar (menu
));
737 /* We were given a keymap. Extract menu info from the keymap. */
739 keymap
= get_keymap (menu
);
741 /* Extract the detailed info to make one pane. */
742 keymap_panes (&menu
, 1, NILP (position
));
744 /* Search for a string appearing directly as an element of the keymap.
745 That string is the title of the menu. */
746 prompt
= map_prompt (keymap
);
747 if (NILP (title
) && !NILP (prompt
))
750 /* Make that be the pane title of the first pane. */
751 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
752 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
756 else if (!NILP (tem
))
758 /* We were given a list of keymaps. */
759 int nmaps
= XFASTINT (Flength (menu
));
761 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
766 /* The first keymap that has a prompt string
767 supplies the menu title. */
768 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
772 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
774 prompt
= map_prompt (keymap
);
775 if (NILP (title
) && !NILP (prompt
))
779 /* Extract the detailed info to make one pane. */
780 keymap_panes (maps
, nmaps
, NILP (position
));
782 /* Make the title be the pane title of the first pane. */
783 if (!NILP (title
) && menu_items_n_panes
>= 0)
784 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
790 /* We were given an old-fashioned menu. */
792 CHECK_STRING (title
, 1);
794 list_of_panes (Fcdr (menu
));
801 discard_menu_items ();
807 /* Display them in a menu. */
810 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
811 keymaps
, title
, &error_name
);
814 discard_menu_items ();
817 #endif /* HAVE_MENUS */
819 if (error_name
) error (error_name
);
825 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
826 "Pop up a dialog box and return user's selection.\n\
827 POSITION specifies which frame to use.\n\
828 This is normally a mouse button event or a window or frame.\n\
829 If POSITION is t, it means to use the frame the mouse is on.\n\
830 The dialog box appears in the middle of the specified frame.\n\
832 CONTENTS specifies the alternatives to display in the dialog box.\n\
833 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
834 Each ITEM is a cons cell (STRING . VALUE).\n\
835 The return value is VALUE from the chosen item.\n\n\
836 An ITEM may also be just a string--that makes a nonselectable item.\n\
837 An ITEM may also be nil--that means to put all preceding items\n\
838 on the left of the dialog box and all following items on the right.\n\
839 \(By default, approximately half appear on each side.)")
841 Lisp_Object position
, contents
;
848 /* Decode the first argument: find the window or frame to use. */
849 if (EQ (position
, Qt
)
850 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
852 #if 0 /* Using the frame the mouse is on may not be right. */
853 /* Use the mouse's current position. */
854 FRAME_PTR new_f
= SELECTED_FRAME ();
855 Lisp_Object bar_window
;
860 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
863 XSETFRAME (window
, new_f
);
865 window
= selected_window
;
867 window
= selected_window
;
869 else if (CONSP (position
))
872 tem
= Fcar (position
);
874 window
= Fcar (Fcdr (position
));
877 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
878 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
881 else if (WINDOWP (position
) || FRAMEP (position
))
886 /* Decode where to put the menu. */
890 else if (WINDOWP (window
))
892 CHECK_LIVE_WINDOW (window
, 0);
893 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
896 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
897 but I don't want to make one now. */
898 CHECK_WINDOW (window
, 0);
901 /* Display a menu with these alternatives
902 in the middle of frame F. */
904 Lisp_Object x
, y
, frame
, newpos
;
905 XSETFRAME (frame
, f
);
906 XSETINT (x
, x_pixel_width (f
) / 2);
907 XSETINT (y
, x_pixel_height (f
) / 2);
908 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
910 return Fx_popup_menu (newpos
,
911 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
913 #else /* HAVE_DIALOGS */
917 Lisp_Object selection
;
919 /* Decode the dialog items from what was specified. */
920 title
= Fcar (contents
);
921 CHECK_STRING (title
, 1);
923 list_of_panes (Fcons (contents
, Qnil
));
925 /* Display them in a dialog box. */
927 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
930 discard_menu_items ();
932 if (error_name
) error (error_name
);
935 #endif /* HAVE_DIALOGS */
938 /* Activate the menu bar of frame F.
939 This is called from keyboard.c when it gets the
940 menu_bar_activate_event out of the Emacs event queue.
942 To activate the menu bar, we signal to the input thread that it can
943 return from the WM_INITMENU message, allowing the normal Windows
944 processing of the menus.
946 But first we recompute the menu bar contents (the whole tree).
948 This way we can safely execute Lisp code. */
951 x_activate_menubar (f
)
954 set_frame_menubar (f
, 0, 1);
956 /* Lock out further menubar changes while active. */
957 f
->output_data
.w32
->menubar_active
= 1;
959 /* Signal input thread to return from WM_INITMENU. */
960 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
963 /* This callback is called from the menu bar pulldown menu
964 when the user makes a selection.
965 Figure out what the user chose
966 and put the appropriate events into the keyboard buffer. */
969 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
971 Lisp_Object prefix
, entry
;
973 Lisp_Object
*subprefix_stack
;
974 int submenu_depth
= 0;
979 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
980 vector
= f
->menu_bar_vector
;
983 while (i
< f
->menu_bar_items_used
)
985 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
987 subprefix_stack
[submenu_depth
++] = prefix
;
991 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
993 prefix
= subprefix_stack
[--submenu_depth
];
996 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
998 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
999 i
+= MENU_ITEMS_PANE_LENGTH
;
1003 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1004 /* The EMACS_INT cast avoids a warning. There's no problem
1005 as long as pointers have enough bits to hold small integers. */
1006 if ((int) (EMACS_INT
) client_data
== i
)
1009 struct input_event buf
;
1012 XSETFRAME (frame
, f
);
1013 buf
.kind
= menu_bar_event
;
1014 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1015 kbd_buffer_store_event (&buf
);
1017 for (j
= 0; j
< submenu_depth
; j
++)
1018 if (!NILP (subprefix_stack
[j
]))
1020 buf
.kind
= menu_bar_event
;
1021 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1022 kbd_buffer_store_event (&buf
);
1027 buf
.kind
= menu_bar_event
;
1028 buf
.frame_or_window
= Fcons (frame
, prefix
);
1029 kbd_buffer_store_event (&buf
);
1032 buf
.kind
= menu_bar_event
;
1033 buf
.frame_or_window
= Fcons (frame
, entry
);
1034 kbd_buffer_store_event (&buf
);
1038 i
+= MENU_ITEMS_ITEM_LENGTH
;
1043 /* Allocate a widget_value, blocking input. */
1046 xmalloc_widget_value ()
1048 widget_value
*value
;
1051 value
= malloc_widget_value ();
1057 /* This recursively calls free_widget_value on the tree of widgets.
1058 It must free all data that was malloc'ed for these widget_values.
1059 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1060 must be left alone. */
1063 free_menubar_widget_value_tree (wv
)
1068 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1070 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1072 free_menubar_widget_value_tree (wv
->contents
);
1073 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1077 free_menubar_widget_value_tree (wv
->next
);
1078 wv
->next
= (widget_value
*) 0xDEADBEEF;
1081 free_widget_value (wv
);
1085 /* Return a tree of widget_value structures for a menu bar item
1086 whose event type is ITEM_KEY (with string ITEM_NAME)
1087 and whose contents come from the list of keymaps MAPS. */
1089 static widget_value
*
1090 single_submenu (item_key
, item_name
, maps
)
1091 Lisp_Object item_key
, item_name
, maps
;
1093 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1095 int submenu_depth
= 0;
1098 Lisp_Object
*mapvec
;
1099 widget_value
**submenu_stack
;
1100 int previous_items
= menu_items_used
;
1101 int top_level_items
= 0;
1103 length
= Flength (maps
);
1104 len
= XINT (length
);
1106 /* Convert the list MAPS into a vector MAPVEC. */
1107 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1108 for (i
= 0; i
< len
; i
++)
1110 mapvec
[i
] = Fcar (maps
);
1114 menu_items_n_panes
= 0;
1116 /* Loop over the given keymaps, making a pane for each map.
1117 But don't make a pane that is empty--ignore that map instead. */
1118 for (i
= 0; i
< len
; i
++)
1120 if (SYMBOLP (mapvec
[i
])
1121 || (CONSP (mapvec
[i
])
1122 && NILP (Fkeymapp (mapvec
[i
]))))
1124 /* Here we have a command at top level in the menu bar
1125 as opposed to a submenu. */
1126 top_level_items
= 1;
1127 push_menu_pane (Qnil
, Qnil
);
1128 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1129 Qnil
, Qnil
, Qnil
, Qnil
);
1132 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1135 /* Create a tree of widget_value objects
1136 representing the panes and their items. */
1139 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1140 wv
= xmalloc_widget_value ();
1144 wv
->button_type
= BUTTON_TYPE_NONE
;
1149 /* Loop over all panes and items made during this call
1150 and construct a tree of widget_value objects.
1151 Ignore the panes and items made by previous calls to
1152 single_submenu, even though those are also in menu_items. */
1154 while (i
< menu_items_used
)
1156 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1158 submenu_stack
[submenu_depth
++] = save_wv
;
1163 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1166 save_wv
= submenu_stack
[--submenu_depth
];
1169 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1170 && submenu_depth
!= 0)
1171 i
+= MENU_ITEMS_PANE_LENGTH
;
1172 /* Ignore a nil in the item list.
1173 It's meaningful only for dialog boxes. */
1174 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1176 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1178 /* Create a new pane. */
1179 Lisp_Object pane_name
, prefix
;
1181 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1182 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1183 #ifndef HAVE_MULTILINGUAL_MENU
1184 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1185 pane_name
= string_make_unibyte (pane_name
);
1187 pane_string
= (NILP (pane_name
)
1188 ? "" : (char *) XSTRING (pane_name
)->data
);
1189 /* If there is just one top-level pane, put all its items directly
1190 under the top-level menu. */
1191 if (menu_items_n_panes
== 1)
1194 /* If the pane has a meaningful name,
1195 make the pane a top-level menu item
1196 with its items as a submenu beneath it. */
1197 if (strcmp (pane_string
, ""))
1199 wv
= xmalloc_widget_value ();
1203 first_wv
->contents
= wv
;
1204 wv
->name
= pane_string
;
1205 /* Ignore the @ that means "separate pane".
1206 This is a kludge, but this isn't worth more time. */
1207 if (!NILP (prefix
) && wv
->name
[0] == '@')
1211 wv
->button_type
= BUTTON_TYPE_NONE
;
1215 i
+= MENU_ITEMS_PANE_LENGTH
;
1219 /* Create a new item within current pane. */
1220 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1222 /* NTEMACS_TODO: implement popup/modeline help for menus. */
1224 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1225 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1227 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1228 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1229 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1230 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1231 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1233 #ifndef HAVE_MULTILINGUAL_MENU
1234 if (STRING_MULTIBYTE (item_name
))
1235 item_name
= string_make_unibyte (item_name
);
1236 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1237 descrip
= string_make_unibyte (descrip
);
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
= XSTRING (help
)->data
;
1270 i
+= MENU_ITEMS_ITEM_LENGTH
;
1274 /* If we have just one "menu item"
1275 that was originally a button, return it by itself. */
1276 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1278 wv
= first_wv
->contents
;
1279 free_widget_value (first_wv
);
1286 /* Set the contents of the menubar widgets of frame F.
1287 The argument FIRST_TIME is currently ignored;
1288 it is set the first time this is called, from initialize_frame_menubar. */
1291 set_frame_menubar (f
, first_time
, deep_p
)
1296 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1298 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1301 /* We must not change the menubar when actually in use. */
1302 if (f
->output_data
.w32
->menubar_active
)
1305 XSETFRAME (Vmenu_updating_frame
, f
);
1307 if (! menubar_widget
)
1309 else if (pending_menu_activation
&& !deep_p
)
1312 wv
= xmalloc_widget_value ();
1313 wv
->name
= "menubar";
1316 wv
->button_type
= BUTTON_TYPE_NONE
;
1321 /* Make a widget-value tree representing the entire menu trees. */
1323 struct buffer
*prev
= current_buffer
;
1325 int specpdl_count
= specpdl_ptr
- specpdl
;
1326 int previous_menu_items_used
= f
->menu_bar_items_used
;
1327 Lisp_Object
*previous_items
1328 = (Lisp_Object
*) alloca (previous_menu_items_used
1329 * sizeof (Lisp_Object
));
1331 /* If we are making a new widget, its contents are empty,
1332 do always reinitialize them. */
1333 if (! menubar_widget
)
1334 previous_menu_items_used
= 0;
1336 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1337 specbind (Qinhibit_quit
, Qt
);
1338 /* Don't let the debugger step into this code
1339 because it is not reentrant. */
1340 specbind (Qdebug_on_next_call
, Qnil
);
1342 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1343 if (NILP (Voverriding_local_map_menu_flag
))
1345 specbind (Qoverriding_terminal_local_map
, Qnil
);
1346 specbind (Qoverriding_local_map
, Qnil
);
1349 set_buffer_internal_1 (XBUFFER (buffer
));
1351 /* Run the Lucid hook. */
1352 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1353 /* If it has changed current-menubar from previous value,
1354 really recompute the menubar from the value. */
1355 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1356 call0 (Qrecompute_lucid_menubar
);
1357 safe_run_hooks (Qmenu_bar_update_hook
);
1358 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1360 items
= FRAME_MENU_BAR_ITEMS (f
);
1362 inhibit_garbage_collection ();
1364 /* Save the frame's previous menu bar contents data. */
1365 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1366 previous_menu_items_used
* sizeof (Lisp_Object
));
1368 /* Fill in the current menu bar contents. */
1369 menu_items
= f
->menu_bar_vector
;
1370 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1372 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1374 Lisp_Object key
, string
, maps
;
1376 key
= XVECTOR (items
)->contents
[i
];
1377 string
= XVECTOR (items
)->contents
[i
+ 1];
1378 maps
= XVECTOR (items
)->contents
[i
+ 2];
1382 wv
= single_submenu (key
, string
, maps
);
1386 first_wv
->contents
= wv
;
1387 /* Don't set wv->name here; GC during the loop might relocate it. */
1389 wv
->button_type
= BUTTON_TYPE_NONE
;
1393 finish_menu_items ();
1395 set_buffer_internal_1 (prev
);
1396 unbind_to (specpdl_count
, Qnil
);
1398 /* If there has been no change in the Lisp-level contents
1399 of the menu bar, skip redisplaying it. Just exit. */
1401 for (i
= 0; i
< previous_menu_items_used
; i
++)
1402 if (menu_items_used
== i
1403 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1405 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1407 free_menubar_widget_value_tree (first_wv
);
1413 /* Now GC cannot happen during the lifetime of the widget_value,
1414 so it's safe to store data from a Lisp_String. */
1415 wv
= first_wv
->contents
;
1416 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1419 string
= XVECTOR (items
)->contents
[i
+ 1];
1422 wv
->name
= (char *) XSTRING (string
)->data
;
1426 f
->menu_bar_vector
= menu_items
;
1427 f
->menu_bar_items_used
= menu_items_used
;
1432 /* Make a widget-value tree containing
1433 just the top level menu bar strings. */
1435 items
= FRAME_MENU_BAR_ITEMS (f
);
1436 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1440 string
= XVECTOR (items
)->contents
[i
+ 1];
1444 wv
= xmalloc_widget_value ();
1445 wv
->name
= (char *) XSTRING (string
)->data
;
1448 wv
->button_type
= BUTTON_TYPE_NONE
;
1449 /* This prevents lwlib from assuming this
1450 menu item is really supposed to be empty. */
1451 /* The EMACS_INT cast avoids a warning.
1452 This value just has to be different from small integers. */
1453 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1458 first_wv
->contents
= wv
;
1462 /* Forget what we thought we knew about what is in the
1463 detailed contents of the menu bar menus.
1464 Changing the top level always destroys the contents. */
1465 f
->menu_bar_items_used
= 0;
1468 /* Create or update the menu bar widget. */
1474 /* Empty current menubar, rather than creating a fresh one. */
1475 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1480 menubar_widget
= CreateMenu ();
1482 fill_in_menu (menubar_widget
, first_wv
->contents
);
1484 free_menubar_widget_value_tree (first_wv
);
1487 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1489 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1490 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1491 /* Causes flicker when menu bar is updated
1492 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1494 /* Force the window size to be recomputed so that the frame's text
1495 area remains the same, if menubar has just been created. */
1496 if (old_widget
== NULL
)
1497 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1503 /* Called from Fx_create_frame to create the initial menubar of a frame
1504 before it is mapped, so that the window is mapped with the menubar already
1505 there instead of us tacking it on later and thrashing the window after it
1509 initialize_frame_menubar (f
)
1512 /* This function is called before the first chance to redisplay
1513 the frame. It has to be, so the frame will have the right size. */
1514 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1515 set_frame_menubar (f
, 1, 1);
1518 /* Get rid of the menu bar of frame F, and free its storage.
1519 This is used when deleting a frame, and when turning off the menu bar. */
1522 free_frame_menubar (f
)
1528 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1529 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1530 f
->output_data
.w32
->menubar_widget
= NULL
;
1538 /* w32_menu_show actually displays a menu using the panes and items in
1539 menu_items and returns the value selected from it; we assume input
1540 is blocked by the caller. */
1542 /* F is the frame the menu is for.
1543 X and Y are the frame-relative specified position,
1544 relative to the inside upper left corner of the frame F.
1545 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1546 KEYMAPS is 1 if this menu was specified with keymaps;
1547 in that case, we return a list containing the chosen item's value
1548 and perhaps also the pane's prefix.
1549 TITLE is the specified menu title.
1550 ERROR is a place to store an error message string in case of failure.
1551 (We return nil on failure, but the value doesn't actually matter.) */
1554 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1564 int menu_item_selection
;
1567 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1568 widget_value
**submenu_stack
1569 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1570 Lisp_Object
*subprefix_stack
1571 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1572 int submenu_depth
= 0;
1574 int next_release_must_exit
= 0;
1578 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1580 *error
= "Empty menu";
1584 /* Create a tree of widget_value objects
1585 representing the panes and their items. */
1586 wv
= xmalloc_widget_value ();
1590 wv
->button_type
= BUTTON_TYPE_NONE
;
1594 /* Loop over all panes and items, filling in the tree. */
1596 while (i
< menu_items_used
)
1598 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1600 submenu_stack
[submenu_depth
++] = save_wv
;
1606 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1609 save_wv
= submenu_stack
[--submenu_depth
];
1613 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1614 && submenu_depth
!= 0)
1615 i
+= MENU_ITEMS_PANE_LENGTH
;
1616 /* Ignore a nil in the item list.
1617 It's meaningful only for dialog boxes. */
1618 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1620 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1622 /* Create a new pane. */
1623 Lisp_Object pane_name
, prefix
;
1625 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1626 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1627 #ifndef HAVE_MULTILINGUAL_MENU
1628 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1629 pane_name
= string_make_unibyte (pane_name
);
1631 pane_string
= (NILP (pane_name
)
1632 ? "" : (char *) XSTRING (pane_name
)->data
);
1633 /* If there is just one top-level pane, put all its items directly
1634 under the top-level menu. */
1635 if (menu_items_n_panes
== 1)
1638 /* If the pane has a meaningful name,
1639 make the pane a top-level menu item
1640 with its items as a submenu beneath it. */
1641 if (!keymaps
&& strcmp (pane_string
, ""))
1643 wv
= xmalloc_widget_value ();
1647 first_wv
->contents
= wv
;
1648 wv
->name
= pane_string
;
1649 if (keymaps
&& !NILP (prefix
))
1653 wv
->button_type
= BUTTON_TYPE_NONE
;
1657 else if (first_pane
)
1663 i
+= MENU_ITEMS_PANE_LENGTH
;
1667 /* Create a new item within current pane. */
1668 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1671 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1672 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1674 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1675 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1676 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1677 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1678 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1680 #ifndef HAVE_MULTILINGUAL_MENU
1681 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1682 item_name
= string_make_unibyte (item_name
);
1683 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1684 descrip
= string_make_unibyte (descrip
);
1685 if (STRINGP (help
) && STRING_MULTIBYTE (help
))
1686 help
= string_make_unibyte (help
);
1689 help_string
= STRINGP (help
) ? XSTRING (help
)->data
: NULL
;
1691 wv
= xmalloc_widget_value ();
1695 save_wv
->contents
= wv
;
1696 wv
->name
= (char *) XSTRING (item_name
)->data
;
1697 if (!NILP (descrip
))
1698 wv
->key
= (char *) XSTRING (descrip
)->data
;
1700 /* Use the contents index as call_data, since we are
1701 restricted to 16-bits.. */
1702 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1703 wv
->enabled
= !NILP (enable
);
1706 wv
->button_type
= BUTTON_TYPE_NONE
;
1707 else if (EQ (type
, QCtoggle
))
1708 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1709 else if (EQ (type
, QCradio
))
1710 wv
->button_type
= BUTTON_TYPE_RADIO
;
1714 wv
->selected
= !NILP (selected
);
1718 i
+= MENU_ITEMS_ITEM_LENGTH
;
1722 /* Deal with the title, if it is non-nil. */
1725 widget_value
*wv_title
= xmalloc_widget_value ();
1726 widget_value
*wv_sep
= xmalloc_widget_value ();
1728 /* Maybe replace this separator with a bitmap or owner-draw item
1729 so that it looks better. Having two separators looks odd. */
1730 wv_sep
->name
= "--";
1731 wv_sep
->next
= first_wv
->contents
;
1733 #ifndef HAVE_MULTILINGUAL_MENU
1734 if (STRING_MULTIBYTE (title
))
1735 title
= string_make_unibyte (title
);
1737 wv_title
->name
= (char *) XSTRING (title
)->data
;
1738 wv_title
->enabled
= True
;
1739 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1740 wv_title
->next
= wv_sep
;
1741 first_wv
->contents
= wv_title
;
1744 /* Actually create the menu. */
1745 menu
= CreatePopupMenu ();
1746 fill_in_menu (menu
, first_wv
->contents
);
1748 /* Adjust coordinates to be root-window-relative. */
1751 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1753 /* Free the widget_value objects we used to specify the contents. */
1754 free_menubar_widget_value_tree (first_wv
);
1756 /* No selection has been chosen yet. */
1757 menu_item_selection
= 0;
1759 /* Display the menu. */
1760 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1761 WM_EMACS_TRACKPOPUPMENU
,
1762 (WPARAM
)menu
, (LPARAM
)&pos
);
1764 /* Clean up extraneous mouse events which might have been generated
1766 discard_mouse_events ();
1770 /* Find the selected item, and its pane, to return
1771 the proper value. */
1772 if (menu_item_selection
!= 0)
1774 Lisp_Object prefix
, entry
;
1778 while (i
< menu_items_used
)
1780 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1782 subprefix_stack
[submenu_depth
++] = prefix
;
1786 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1788 prefix
= subprefix_stack
[--submenu_depth
];
1791 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1794 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1795 i
+= MENU_ITEMS_PANE_LENGTH
;
1797 /* Ignore a nil in the item list.
1798 It's meaningful only for dialog boxes. */
1799 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1804 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1805 if (menu_item_selection
== i
)
1811 entry
= Fcons (entry
, Qnil
);
1813 entry
= Fcons (prefix
, entry
);
1814 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1815 if (!NILP (subprefix_stack
[j
]))
1816 entry
= Fcons (subprefix_stack
[j
], entry
);
1820 i
+= MENU_ITEMS_ITEM_LENGTH
;
1829 static char * button_names
[] = {
1830 "button1", "button2", "button3", "button4", "button5",
1831 "button6", "button7", "button8", "button9", "button10" };
1834 w32_dialog_show (f
, keymaps
, title
, error
)
1840 int i
, nb_buttons
=0;
1841 char dialog_name
[6];
1842 int menu_item_selection
;
1844 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1846 /* Number of elements seen so far, before boundary. */
1848 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1849 int boundary_seen
= 0;
1853 if (menu_items_n_panes
> 1)
1855 *error
= "Multiple panes in dialog box";
1859 /* Create a tree of widget_value objects
1860 representing the text label and buttons. */
1862 Lisp_Object pane_name
, prefix
;
1864 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1865 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1866 pane_string
= (NILP (pane_name
)
1867 ? "" : (char *) XSTRING (pane_name
)->data
);
1868 prev_wv
= xmalloc_widget_value ();
1869 prev_wv
->value
= pane_string
;
1870 if (keymaps
&& !NILP (prefix
))
1872 prev_wv
->enabled
= 1;
1873 prev_wv
->name
= "message";
1876 /* Loop over all panes and items, filling in the tree. */
1877 i
= MENU_ITEMS_PANE_LENGTH
;
1878 while (i
< menu_items_used
)
1881 /* Create a new item within current pane. */
1882 Lisp_Object item_name
, enable
, descrip
, help
;
1885 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1886 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1888 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1889 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1890 help_string
= STRINGP (help
) ? XSTRING (help
)->data
: NULL
;
1892 if (NILP (item_name
))
1894 free_menubar_widget_value_tree (first_wv
);
1895 *error
= "Submenu in dialog items";
1898 if (EQ (item_name
, Qquote
))
1900 /* This is the boundary between left-side elts
1901 and right-side elts. Stop incrementing right_count. */
1906 if (nb_buttons
>= 9)
1908 free_menubar_widget_value_tree (first_wv
);
1909 *error
= "Too many dialog items";
1913 wv
= xmalloc_widget_value ();
1915 wv
->name
= (char *) button_names
[nb_buttons
];
1916 if (!NILP (descrip
))
1917 wv
->key
= (char *) XSTRING (descrip
)->data
;
1918 wv
->value
= (char *) XSTRING (item_name
)->data
;
1919 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1920 wv
->enabled
= !NILP (enable
);
1923 if (! boundary_seen
)
1927 i
+= MENU_ITEMS_ITEM_LENGTH
;
1930 /* If the boundary was not specified,
1931 by default put half on the left and half on the right. */
1932 if (! boundary_seen
)
1933 left_count
= nb_buttons
- nb_buttons
/ 2;
1935 wv
= xmalloc_widget_value ();
1936 wv
->name
= dialog_name
;
1938 /* Dialog boxes use a really stupid name encoding
1939 which specifies how many buttons to use
1940 and how many buttons are on the right.
1941 The Q means something also. */
1942 dialog_name
[0] = 'Q';
1943 dialog_name
[1] = '0' + nb_buttons
;
1944 dialog_name
[2] = 'B';
1945 dialog_name
[3] = 'R';
1946 /* Number of buttons to put on the right. */
1947 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1949 wv
->contents
= first_wv
;
1953 /* Actually create the dialog. */
1955 dialog_id
= widget_id_tick
++;
1956 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1957 f
->output_data
.w32
->widget
, 1, 0,
1958 dialog_selection_callback
, 0);
1959 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1962 /* Free the widget_value objects we used to specify the contents. */
1963 free_menubar_widget_value_tree (first_wv
);
1965 /* No selection has been chosen yet. */
1966 menu_item_selection
= 0;
1968 /* Display the menu. */
1970 lw_pop_up_all_widgets (dialog_id
);
1971 popup_activated_flag
= 1;
1973 /* Process events that apply to the menu. */
1974 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1976 lw_destroy_all_widgets (dialog_id
);
1979 /* Find the selected item, and its pane, to return
1980 the proper value. */
1981 if (menu_item_selection
!= 0)
1987 while (i
< menu_items_used
)
1991 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1994 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1995 i
+= MENU_ITEMS_PANE_LENGTH
;
2000 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2001 if (menu_item_selection
== i
)
2005 entry
= Fcons (entry
, Qnil
);
2007 entry
= Fcons (prefix
, entry
);
2011 i
+= MENU_ITEMS_ITEM_LENGTH
;
2020 /* Is this item a separator? */
2022 name_is_separator (name
)
2025 /* Check if name string consists of only dashes ('-') */
2026 while (*name
== '-') name
++;
2027 return (*name
== '\0');
2031 /* Indicate boundary between left and right. */
2033 add_left_right_boundary (HMENU menu
)
2035 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2039 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2045 if (name_is_separator (wv
->name
))
2046 fuFlags
= MF_SEPARATOR
;
2050 fuFlags
= MF_STRING
;
2052 fuFlags
= MF_STRING
| MF_GRAYED
;
2054 if (wv
->key
!= NULL
)
2056 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2057 strcpy (out_string
, wv
->name
);
2058 strcat (out_string
, "\t");
2059 strcat (out_string
, wv
->key
);
2062 out_string
= wv
->name
;
2064 if (wv
->title
|| wv
->call_data
== 0)
2066 #if 0 /* no GC while popup menu is active */
2067 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2068 strcpy (out_string
, wv
->name
);
2070 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2073 /* Draw radio buttons and tickboxes. */
2075 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2076 wv
->button_type
== BUTTON_TYPE_RADIO
))
2077 fuFlags
|= MF_CHECKED
;
2079 fuFlags
|= MF_UNCHECKED
;
2088 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2089 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2091 /* This must be done after the menu item is created. */
2092 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2094 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2095 RADIO items, but is not available on NT 3.51 and earlier. */
2096 HMODULE user32
= GetModuleHandle ("user32.dll");
2097 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfo");
2099 if (set_menu_item_info
)
2102 bzero (&info
, sizeof (info
));
2103 info
.cbSize
= sizeof (info
);
2104 info
.fMask
= MIIM_TYPE
| MIIM_STATE
;
2105 info
.fType
= MFT_RADIOCHECK
;
2106 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2107 set_menu_item_info (menu
, item
, FALSE
, &info
);
2111 return return_value
;
2114 /* Construct native Windows menu(bar) based on widget_value tree. */
2116 fill_in_menu (HMENU menu
, widget_value
*wv
)
2118 int items_added
= 0;
2120 for ( ; wv
!= NULL
; wv
= wv
->next
)
2124 HMENU sub_menu
= CreatePopupMenu ();
2126 if (sub_menu
== NULL
)
2129 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2130 !add_menu_item (menu
, wv
, sub_menu
))
2132 DestroyMenu (sub_menu
);
2138 if (!add_menu_item (menu
, wv
, NULL
))
2148 /* popup_activated_flag not actually used on W32 */
2152 #endif /* HAVE_MENUS */
2156 staticpro (&menu_items
);
2159 Qdebug_on_next_call
= intern ("debug-on-next-call");
2160 staticpro (&Qdebug_on_next_call
);
2162 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2163 "Frame for which we are updating a menu.\n\
2164 The enable predicate for a menu command should check this variable.");
2165 Vmenu_updating_frame
= Qnil
;
2167 defsubr (&Sx_popup_menu
);
2169 defsubr (&Sx_popup_dialog
);