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
;
64 typedef struct _widget_value
68 /* value (meaning depend on widget type) */
70 /* keyboard equivalent. no implications for XtTranslations */
76 /* true if selected */
78 /* The type of a button. */
79 enum button_type button_type
;
80 /* true if menu title */
83 /* true if was edited (maintained by get_value) */
85 /* true if has changed (maintained by lw library) */
87 /* true if this widget itself has changed,
88 but not counting the other widgets found in the `next' field. */
89 change_type this_one_change
;
91 /* Contents of the sub-widgets, also selected slot for checkbox */
92 struct _widget_value
* contents
;
93 /* data passed to callback */
95 /* next one in the list */
96 struct _widget_value
* next
;
98 /* slot for the toolkit dependent part. Always initialize to NULL. */
100 /* tell us if we should free the toolkit data slot when freeing the
101 widget_value itself. */
102 Boolean free_toolkit_data
;
104 /* we resource the widget_value structures; this points to the next
105 one on the free list if this one has been deallocated.
107 struct _widget_value
*free_list
;
111 /* LocalAlloc/Free is a reasonably good allocator. */
112 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
113 #define free_widget_value(wv) LocalFree (wv)
115 /******************************************************************/
117 #define min(x,y) (((x) < (y)) ? (x) : (y))
118 #define max(x,y) (((x) > (y)) ? (x) : (y))
125 Lisp_Object Vmenu_updating_frame
;
127 Lisp_Object Qdebug_on_next_call
;
129 extern Lisp_Object Qmenu_bar
;
130 extern Lisp_Object Qmouse_click
, Qevent_kind
;
132 extern Lisp_Object QCtoggle
, QCradio
;
134 extern Lisp_Object Voverriding_local_map
;
135 extern Lisp_Object Voverriding_local_map_menu_flag
;
137 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
139 extern Lisp_Object Qmenu_bar_update_hook
;
141 void set_frame_menubar ();
143 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
144 Lisp_Object
, Lisp_Object
, Lisp_Object
,
145 Lisp_Object
, Lisp_Object
));
146 static Lisp_Object
w32_dialog_show ();
147 static Lisp_Object
w32_menu_show ();
149 static void keymap_panes ();
150 static void single_keymap_panes ();
151 static void single_menu_item ();
152 static void list_of_panes ();
153 static void list_of_items ();
155 /* This holds a Lisp vector that holds the results of decoding
156 the keymaps or alist-of-alists that specify a menu.
158 It describes the panes and items within the panes.
160 Each pane is described by 3 elements in the vector:
161 t, the pane name, the pane's prefix key.
162 Then follow the pane's items, with 5 elements per item:
163 the item string, the enable flag, the item's value,
164 the definition, and the equivalent keyboard key's description string.
166 In some cases, multiple levels of menus may be described.
167 A single vector slot containing nil indicates the start of a submenu.
168 A single vector slot containing lambda indicates the end of a submenu.
169 The submenu follows a menu item which is the way to reach the submenu.
171 A single vector slot containing quote indicates that the
172 following items should appear on the right of a dialog box.
174 Using a Lisp vector to hold this information while we decode it
175 takes care of protecting all the data from GC. */
177 #define MENU_ITEMS_PANE_NAME 1
178 #define MENU_ITEMS_PANE_PREFIX 2
179 #define MENU_ITEMS_PANE_LENGTH 3
183 MENU_ITEMS_ITEM_NAME
= 0,
184 MENU_ITEMS_ITEM_ENABLE
,
185 MENU_ITEMS_ITEM_VALUE
,
186 MENU_ITEMS_ITEM_EQUIV_KEY
,
187 MENU_ITEMS_ITEM_DEFINITION
,
188 MENU_ITEMS_ITEM_TYPE
,
189 MENU_ITEMS_ITEM_SELECTED
,
190 MENU_ITEMS_ITEM_HELP
,
191 MENU_ITEMS_ITEM_LENGTH
194 static Lisp_Object menu_items
;
196 /* Number of slots currently allocated in menu_items. */
197 static int menu_items_allocated
;
199 /* This is the index in menu_items of the first empty slot. */
200 static int menu_items_used
;
202 /* The number of panes currently recorded in menu_items,
203 excluding those within submenus. */
204 static int menu_items_n_panes
;
206 /* Current depth within submenus. */
207 static int menu_items_submenu_depth
;
209 /* Flag which when set indicates a dialog or menu has been posted by
210 Xt on behalf of one of the widget sets. */
211 static int popup_activated_flag
;
213 static int next_menubar_widget_id
;
215 /* This is set nonzero after the user activates the menu bar, and set
216 to zero again after the menu bars are redisplayed by prepare_menu_bar.
217 While it is nonzero, all calls to set_frame_menubar go deep.
219 I don't understand why this is needed, but it does seem to be
220 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
222 int pending_menu_activation
;
225 /* Return the frame whose ->output_data.w32->menubar_widget equals
228 static struct frame
*
229 menubar_id_to_frame (id
)
232 Lisp_Object tail
, frame
;
235 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
238 if (!GC_FRAMEP (frame
))
241 if (!FRAME_WINDOW_P (f
))
243 if (f
->output_data
.w32
->menubar_widget
== id
)
249 /* Initialize the menu_items structure if we haven't already done so.
250 Also mark it as currently empty. */
255 if (NILP (menu_items
))
257 menu_items_allocated
= 60;
258 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
262 menu_items_n_panes
= 0;
263 menu_items_submenu_depth
= 0;
266 /* Call at the end of generating the data in menu_items.
267 This fills in the number of items in the last pane. */
274 /* Call when finished using the data for the current menu
278 discard_menu_items ()
280 /* Free the structure if it is especially large.
281 Otherwise, hold on to it, to save time. */
282 if (menu_items_allocated
> 200)
285 menu_items_allocated
= 0;
289 /* Make the menu_items vector twice as large. */
295 int old_size
= menu_items_allocated
;
298 menu_items_allocated
*= 2;
299 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
300 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
301 old_size
* sizeof (Lisp_Object
));
304 /* Begin a submenu. */
307 push_submenu_start ()
309 if (menu_items_used
+ 1 > menu_items_allocated
)
312 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
313 menu_items_submenu_depth
++;
321 if (menu_items_used
+ 1 > menu_items_allocated
)
324 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
325 menu_items_submenu_depth
--;
328 /* Indicate boundary between left and right. */
331 push_left_right_boundary ()
333 if (menu_items_used
+ 1 > menu_items_allocated
)
336 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
339 /* Start a new menu pane in menu_items..
340 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
343 push_menu_pane (name
, prefix_vec
)
344 Lisp_Object name
, prefix_vec
;
346 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
349 if (menu_items_submenu_depth
== 0)
350 menu_items_n_panes
++;
351 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
356 /* Push one menu item into the current pane. NAME is the string to
357 display. ENABLE if non-nil means this item can be selected. KEY
358 is the key generated by choosing this item, or nil if this item
359 doesn't really have a definition. DEF is the definition of this
360 item. EQUIV is the textual description of the keyboard equivalent
361 for this item (or nil if none). TYPE is the type of this menu
362 item, one of nil, `toggle' or `radio'. */
365 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
366 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
368 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
378 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
381 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
382 and generate menu panes for them in menu_items.
383 If NOTREAL is nonzero,
384 don't bother really computing whether an item is enabled. */
387 keymap_panes (keymaps
, nmaps
, notreal
)
388 Lisp_Object
*keymaps
;
396 /* Loop over the given keymaps, making a pane for each map.
397 But don't make a pane that is empty--ignore that map instead.
398 P is the number of panes we have made so far. */
399 for (mapno
= 0; mapno
< nmaps
; mapno
++)
400 single_keymap_panes (keymaps
[mapno
], Qnil
, 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
)))
644 /* Use the mouse's current position. */
645 FRAME_PTR new_f
= SELECTED_FRAME ();
646 Lisp_Object bar_window
;
647 enum scroll_bar_part part
;
650 if (mouse_position_hook
)
651 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
652 &part
, &x
, &y
, &time
);
654 XSETFRAME (window
, new_f
);
657 window
= selected_window
;
664 tem
= Fcar (position
);
667 window
= Fcar (Fcdr (position
));
669 y
= Fcar (Fcdr (tem
));
674 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
675 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
676 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
685 /* Decode where to put the menu. */
693 else if (WINDOWP (window
))
695 CHECK_LIVE_WINDOW (window
, 0);
696 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
698 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
699 * XFASTINT (XWINDOW (window
)->left
));
700 ypos
= (FRAME_LINE_HEIGHT (f
)
701 * XFASTINT (XWINDOW (window
)->top
));
704 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
705 but I don't want to make one now. */
706 CHECK_WINDOW (window
, 0);
711 XSETFRAME (Vmenu_updating_frame
, f
);
713 Vmenu_updating_frame
= Qnil
;
714 #endif /* HAVE_MENUS */
719 /* Decode the menu items from what was specified. */
721 keymap
= Fkeymapp (menu
);
724 tem
= Fkeymapp (Fcar (menu
));
727 /* We were given a keymap. Extract menu info from the keymap. */
729 keymap
= get_keymap (menu
);
731 /* Extract the detailed info to make one pane. */
732 keymap_panes (&menu
, 1, NILP (position
));
734 /* Search for a string appearing directly as an element of the keymap.
735 That string is the title of the menu. */
736 prompt
= map_prompt (keymap
);
737 if (NILP (title
) && !NILP (prompt
))
740 /* Make that be the pane title of the first pane. */
741 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
742 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
746 else if (!NILP (tem
))
748 /* We were given a list of keymaps. */
749 int nmaps
= XFASTINT (Flength (menu
));
751 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
756 /* The first keymap that has a prompt string
757 supplies the menu title. */
758 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
762 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
764 prompt
= map_prompt (keymap
);
765 if (NILP (title
) && !NILP (prompt
))
769 /* Extract the detailed info to make one pane. */
770 keymap_panes (maps
, nmaps
, NILP (position
));
772 /* Make the title be the pane title of the first pane. */
773 if (!NILP (title
) && menu_items_n_panes
>= 0)
774 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
780 /* We were given an old-fashioned menu. */
782 CHECK_STRING (title
, 1);
784 list_of_panes (Fcdr (menu
));
791 discard_menu_items ();
797 /* Display them in a menu. */
800 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
801 keymaps
, title
, &error_name
);
804 discard_menu_items ();
807 #endif /* HAVE_MENUS */
809 if (error_name
) error (error_name
);
815 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
816 "Pop up a dialog box and return user's selection.\n\
817 POSITION specifies which frame to use.\n\
818 This is normally a mouse button event or a window or frame.\n\
819 If POSITION is t, it means to use the frame the mouse is on.\n\
820 The dialog box appears in the middle of the specified frame.\n\
822 CONTENTS specifies the alternatives to display in the dialog box.\n\
823 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
824 Each ITEM is a cons cell (STRING . VALUE).\n\
825 The return value is VALUE from the chosen item.\n\n\
826 An ITEM may also be just a string--that makes a nonselectable item.\n\
827 An ITEM may also be nil--that means to put all preceding items\n\
828 on the left of the dialog box and all following items on the right.\n\
829 \(By default, approximately half appear on each side.)")
831 Lisp_Object position
, contents
;
838 /* Decode the first argument: find the window or frame to use. */
839 if (EQ (position
, Qt
)
840 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
842 #if 0 /* Using the frame the mouse is on may not be right. */
843 /* Use the mouse's current position. */
844 FRAME_PTR new_f
= SELECTED_FRAME ();
845 Lisp_Object bar_window
;
850 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
853 XSETFRAME (window
, new_f
);
855 window
= selected_window
;
857 window
= selected_window
;
859 else if (CONSP (position
))
862 tem
= Fcar (position
);
864 window
= Fcar (Fcdr (position
));
867 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
868 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
871 else if (WINDOWP (position
) || FRAMEP (position
))
876 /* Decode where to put the menu. */
880 else if (WINDOWP (window
))
882 CHECK_LIVE_WINDOW (window
, 0);
883 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
886 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
887 but I don't want to make one now. */
888 CHECK_WINDOW (window
, 0);
891 /* Display a menu with these alternatives
892 in the middle of frame F. */
894 Lisp_Object x
, y
, frame
, newpos
;
895 XSETFRAME (frame
, f
);
896 XSETINT (x
, x_pixel_width (f
) / 2);
897 XSETINT (y
, x_pixel_height (f
) / 2);
898 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
900 return Fx_popup_menu (newpos
,
901 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
903 #else /* HAVE_DIALOGS */
907 Lisp_Object selection
;
909 /* Decode the dialog items from what was specified. */
910 title
= Fcar (contents
);
911 CHECK_STRING (title
, 1);
913 list_of_panes (Fcons (contents
, Qnil
));
915 /* Display them in a dialog box. */
917 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
920 discard_menu_items ();
922 if (error_name
) error (error_name
);
925 #endif /* HAVE_DIALOGS */
928 /* Activate the menu bar of frame F.
929 This is called from keyboard.c when it gets the
930 menu_bar_activate_event out of the Emacs event queue.
932 To activate the menu bar, we signal to the input thread that it can
933 return from the WM_INITMENU message, allowing the normal Windows
934 processing of the menus.
936 But first we recompute the menu bar contents (the whole tree).
938 This way we can safely execute Lisp code. */
941 x_activate_menubar (f
)
944 set_frame_menubar (f
, 0, 1);
946 /* Lock out further menubar changes while active. */
947 f
->output_data
.w32
->menubar_active
= 1;
949 /* Signal input thread to return from WM_INITMENU. */
950 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
953 /* This callback is called from the menu bar pulldown menu
954 when the user makes a selection.
955 Figure out what the user chose
956 and put the appropriate events into the keyboard buffer. */
959 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
961 Lisp_Object prefix
, entry
;
963 Lisp_Object
*subprefix_stack
;
964 int submenu_depth
= 0;
969 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
970 vector
= f
->menu_bar_vector
;
973 while (i
< f
->menu_bar_items_used
)
975 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
977 subprefix_stack
[submenu_depth
++] = prefix
;
981 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
983 prefix
= subprefix_stack
[--submenu_depth
];
986 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
988 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
989 i
+= MENU_ITEMS_PANE_LENGTH
;
993 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
994 /* The EMACS_INT cast avoids a warning. There's no problem
995 as long as pointers have enough bits to hold small integers. */
996 if ((int) (EMACS_INT
) client_data
== i
)
999 struct input_event buf
;
1002 XSETFRAME (frame
, f
);
1003 buf
.kind
= menu_bar_event
;
1004 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
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
= Fcons (frame
, subprefix_stack
[j
]);
1012 kbd_buffer_store_event (&buf
);
1017 buf
.kind
= menu_bar_event
;
1018 buf
.frame_or_window
= Fcons (frame
, prefix
);
1019 kbd_buffer_store_event (&buf
);
1022 buf
.kind
= menu_bar_event
;
1023 buf
.frame_or_window
= Fcons (frame
, entry
);
1024 kbd_buffer_store_event (&buf
);
1028 i
+= MENU_ITEMS_ITEM_LENGTH
;
1033 /* Allocate a widget_value, blocking input. */
1036 xmalloc_widget_value ()
1038 widget_value
*value
;
1041 value
= malloc_widget_value ();
1047 /* This recursively calls free_widget_value on the tree of widgets.
1048 It must free all data that was malloc'ed for these widget_values.
1049 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1050 must be left alone. */
1053 free_menubar_widget_value_tree (wv
)
1058 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1060 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1062 free_menubar_widget_value_tree (wv
->contents
);
1063 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1067 free_menubar_widget_value_tree (wv
->next
);
1068 wv
->next
= (widget_value
*) 0xDEADBEEF;
1071 free_widget_value (wv
);
1075 /* Return a tree of widget_value structures for a menu bar item
1076 whose event type is ITEM_KEY (with string ITEM_NAME)
1077 and whose contents come from the list of keymaps MAPS. */
1079 static widget_value
*
1080 single_submenu (item_key
, item_name
, maps
)
1081 Lisp_Object item_key
, item_name
, maps
;
1083 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1085 int submenu_depth
= 0;
1088 Lisp_Object
*mapvec
;
1089 widget_value
**submenu_stack
;
1090 int previous_items
= menu_items_used
;
1091 int top_level_items
= 0;
1093 length
= Flength (maps
);
1094 len
= XINT (length
);
1096 /* Convert the list MAPS into a vector MAPVEC. */
1097 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1098 for (i
= 0; i
< len
; i
++)
1100 mapvec
[i
] = Fcar (maps
);
1104 menu_items_n_panes
= 0;
1106 /* Loop over the given keymaps, making a pane for each map.
1107 But don't make a pane that is empty--ignore that map instead. */
1108 for (i
= 0; i
< len
; i
++)
1110 if (SYMBOLP (mapvec
[i
])
1111 || (CONSP (mapvec
[i
])
1112 && NILP (Fkeymapp (mapvec
[i
]))))
1114 /* Here we have a command at top level in the menu bar
1115 as opposed to a submenu. */
1116 top_level_items
= 1;
1117 push_menu_pane (Qnil
, Qnil
);
1118 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1119 Qnil
, Qnil
, Qnil
, Qnil
);
1122 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1125 /* Create a tree of widget_value objects
1126 representing the panes and their items. */
1129 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1130 wv
= xmalloc_widget_value ();
1134 wv
->button_type
= BUTTON_TYPE_NONE
;
1139 /* Loop over all panes and items made during this call
1140 and construct a tree of widget_value objects.
1141 Ignore the panes and items made by previous calls to
1142 single_submenu, even though those are also in menu_items. */
1144 while (i
< menu_items_used
)
1146 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1148 submenu_stack
[submenu_depth
++] = save_wv
;
1153 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1156 save_wv
= submenu_stack
[--submenu_depth
];
1159 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1160 && submenu_depth
!= 0)
1161 i
+= MENU_ITEMS_PANE_LENGTH
;
1162 /* Ignore a nil in the item list.
1163 It's meaningful only for dialog boxes. */
1164 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1166 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1168 /* Create a new pane. */
1169 Lisp_Object pane_name
, prefix
;
1171 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1172 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1173 #ifndef HAVE_MULTILINGUAL_MENU
1174 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1175 pane_name
= string_make_unibyte (pane_name
);
1177 pane_string
= (NILP (pane_name
)
1178 ? "" : (char *) XSTRING (pane_name
)->data
);
1179 /* If there is just one top-level pane, put all its items directly
1180 under the top-level menu. */
1181 if (menu_items_n_panes
== 1)
1184 /* If the pane has a meaningful name,
1185 make the pane a top-level menu item
1186 with its items as a submenu beneath it. */
1187 if (strcmp (pane_string
, ""))
1189 wv
= xmalloc_widget_value ();
1193 first_wv
->contents
= wv
;
1194 wv
->name
= pane_string
;
1195 /* Ignore the @ that means "separate pane".
1196 This is a kludge, but this isn't worth more time. */
1197 if (!NILP (prefix
) && wv
->name
[0] == '@')
1201 wv
->button_type
= BUTTON_TYPE_NONE
;
1205 i
+= MENU_ITEMS_PANE_LENGTH
;
1209 /* Create a new item within current pane. */
1210 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1213 /* NTEMACS_TODO: implement popup/modeline help for menus. */
1215 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1216 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1218 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1219 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1220 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1221 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1222 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1224 #ifndef HAVE_MULTILINGUAL_MENU
1225 if (STRING_MULTIBYTE (item_name
))
1226 item_name
= string_make_unibyte (item_name
);
1227 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1228 descrip
= string_make_unibyte (descrip
);
1231 wv
= xmalloc_widget_value ();
1235 save_wv
->contents
= wv
;
1237 wv
->name
= (char *) XSTRING (item_name
)->data
;
1238 if (!NILP (descrip
))
1239 wv
->key
= (char *) XSTRING (descrip
)->data
;
1241 /* The EMACS_INT cast avoids a warning. There's no problem
1242 as long as pointers have enough bits to hold small integers. */
1243 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1244 wv
->enabled
= !NILP (enable
);
1247 wv
->button_type
= BUTTON_TYPE_NONE
;
1248 else if (EQ (type
, QCradio
))
1249 wv
->button_type
= BUTTON_TYPE_RADIO
;
1250 else if (EQ (type
, QCtoggle
))
1251 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1255 wv
->selected
= !NILP (selected
);
1257 wv
->help
= (char *) XSTRING (help
)->data
;
1263 i
+= MENU_ITEMS_ITEM_LENGTH
;
1267 /* If we have just one "menu item"
1268 that was originally a button, return it by itself. */
1269 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1271 wv
= first_wv
->contents
;
1272 free_widget_value (first_wv
);
1279 /* Set the contents of the menubar widgets of frame F.
1280 The argument FIRST_TIME is currently ignored;
1281 it is set the first time this is called, from initialize_frame_menubar. */
1284 set_frame_menubar (f
, first_time
, deep_p
)
1289 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1291 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1294 /* We must not change the menubar when actually in use. */
1295 if (f
->output_data
.w32
->menubar_active
)
1298 XSETFRAME (Vmenu_updating_frame
, f
);
1300 if (! menubar_widget
)
1302 else if (pending_menu_activation
&& !deep_p
)
1305 wv
= xmalloc_widget_value ();
1306 wv
->name
= "menubar";
1309 wv
->button_type
= BUTTON_TYPE_NONE
;
1314 /* Make a widget-value tree representing the entire menu trees. */
1316 struct buffer
*prev
= current_buffer
;
1318 int specpdl_count
= specpdl_ptr
- specpdl
;
1319 int previous_menu_items_used
= f
->menu_bar_items_used
;
1320 Lisp_Object
*previous_items
1321 = (Lisp_Object
*) alloca (previous_menu_items_used
1322 * sizeof (Lisp_Object
));
1324 /* If we are making a new widget, its contents are empty,
1325 do always reinitialize them. */
1326 if (! menubar_widget
)
1327 previous_menu_items_used
= 0;
1329 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1330 specbind (Qinhibit_quit
, Qt
);
1331 /* Don't let the debugger step into this code
1332 because it is not reentrant. */
1333 specbind (Qdebug_on_next_call
, Qnil
);
1335 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1336 if (NILP (Voverriding_local_map_menu_flag
))
1338 specbind (Qoverriding_terminal_local_map
, Qnil
);
1339 specbind (Qoverriding_local_map
, Qnil
);
1342 set_buffer_internal_1 (XBUFFER (buffer
));
1344 /* Run the Lucid hook. */
1345 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1346 /* If it has changed current-menubar from previous value,
1347 really recompute the menubar from the value. */
1348 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1349 call0 (Qrecompute_lucid_menubar
);
1350 safe_run_hooks (Qmenu_bar_update_hook
);
1351 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1353 items
= FRAME_MENU_BAR_ITEMS (f
);
1355 inhibit_garbage_collection ();
1357 /* Save the frame's previous menu bar contents data. */
1358 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1359 previous_menu_items_used
* sizeof (Lisp_Object
));
1361 /* Fill in the current menu bar contents. */
1362 menu_items
= f
->menu_bar_vector
;
1363 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1365 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1367 Lisp_Object key
, string
, maps
;
1369 key
= XVECTOR (items
)->contents
[i
];
1370 string
= XVECTOR (items
)->contents
[i
+ 1];
1371 maps
= XVECTOR (items
)->contents
[i
+ 2];
1375 wv
= single_submenu (key
, string
, maps
);
1379 first_wv
->contents
= wv
;
1380 /* Don't set wv->name here; GC during the loop might relocate it. */
1382 wv
->button_type
= BUTTON_TYPE_NONE
;
1386 finish_menu_items ();
1388 set_buffer_internal_1 (prev
);
1389 unbind_to (specpdl_count
, Qnil
);
1391 /* If there has been no change in the Lisp-level contents
1392 of the menu bar, skip redisplaying it. Just exit. */
1394 for (i
= 0; i
< previous_menu_items_used
; i
++)
1395 if (menu_items_used
== i
1396 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1398 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1400 free_menubar_widget_value_tree (first_wv
);
1406 /* Now GC cannot happen during the lifetime of the widget_value,
1407 so it's safe to store data from a Lisp_String. */
1408 wv
= first_wv
->contents
;
1409 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1412 string
= XVECTOR (items
)->contents
[i
+ 1];
1415 wv
->name
= (char *) XSTRING (string
)->data
;
1419 f
->menu_bar_vector
= menu_items
;
1420 f
->menu_bar_items_used
= menu_items_used
;
1425 /* Make a widget-value tree containing
1426 just the top level menu bar strings. */
1428 items
= FRAME_MENU_BAR_ITEMS (f
);
1429 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1433 string
= XVECTOR (items
)->contents
[i
+ 1];
1437 wv
= xmalloc_widget_value ();
1438 wv
->name
= (char *) XSTRING (string
)->data
;
1441 wv
->button_type
= BUTTON_TYPE_NONE
;
1442 /* This prevents lwlib from assuming this
1443 menu item is really supposed to be empty. */
1444 /* The EMACS_INT cast avoids a warning.
1445 This value just has to be different from small integers. */
1446 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1451 first_wv
->contents
= wv
;
1455 /* Forget what we thought we knew about what is in the
1456 detailed contents of the menu bar menus.
1457 Changing the top level always destroys the contents. */
1458 f
->menu_bar_items_used
= 0;
1461 /* Create or update the menu bar widget. */
1467 /* Empty current menubar, rather than creating a fresh one. */
1468 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1473 menubar_widget
= CreateMenu ();
1475 fill_in_menu (menubar_widget
, first_wv
->contents
);
1477 free_menubar_widget_value_tree (first_wv
);
1480 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1482 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1483 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1484 /* Causes flicker when menu bar is updated
1485 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1487 /* Force the window size to be recomputed so that the frame's text
1488 area remains the same, if menubar has just been created. */
1489 if (old_widget
== NULL
)
1490 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1496 /* Called from Fx_create_frame to create the initial menubar of a frame
1497 before it is mapped, so that the window is mapped with the menubar already
1498 there instead of us tacking it on later and thrashing the window after it
1502 initialize_frame_menubar (f
)
1505 /* This function is called before the first chance to redisplay
1506 the frame. It has to be, so the frame will have the right size. */
1507 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1508 set_frame_menubar (f
, 1, 1);
1511 /* Get rid of the menu bar of frame F, and free its storage.
1512 This is used when deleting a frame, and when turning off the menu bar. */
1515 free_frame_menubar (f
)
1521 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1522 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1523 f
->output_data
.w32
->menubar_widget
= NULL
;
1531 /* w32_menu_show actually displays a menu using the panes and items in
1532 menu_items and returns the value selected from it; we assume input
1533 is blocked by the caller. */
1535 /* F is the frame the menu is for.
1536 X and Y are the frame-relative specified position,
1537 relative to the inside upper left corner of the frame F.
1538 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1539 KEYMAPS is 1 if this menu was specified with keymaps;
1540 in that case, we return a list containing the chosen item's value
1541 and perhaps also the pane's prefix.
1542 TITLE is the specified menu title.
1543 ERROR is a place to store an error message string in case of failure.
1544 (We return nil on failure, but the value doesn't actually matter.) */
1547 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1557 int menu_item_selection
;
1560 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1561 widget_value
**submenu_stack
1562 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1563 Lisp_Object
*subprefix_stack
1564 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1565 int submenu_depth
= 0;
1567 int next_release_must_exit
= 0;
1571 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1573 *error
= "Empty menu";
1577 /* Create a tree of widget_value objects
1578 representing the panes and their items. */
1579 wv
= xmalloc_widget_value ();
1583 wv
->button_type
= BUTTON_TYPE_NONE
;
1587 /* Loop over all panes and items, filling in the tree. */
1589 while (i
< menu_items_used
)
1591 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1593 submenu_stack
[submenu_depth
++] = save_wv
;
1599 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1602 save_wv
= submenu_stack
[--submenu_depth
];
1606 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1607 && submenu_depth
!= 0)
1608 i
+= MENU_ITEMS_PANE_LENGTH
;
1609 /* Ignore a nil in the item list.
1610 It's meaningful only for dialog boxes. */
1611 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1613 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1615 /* Create a new pane. */
1616 Lisp_Object pane_name
, prefix
;
1618 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1619 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1620 #ifndef HAVE_MULTILINGUAL_MENU
1621 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1622 pane_name
= string_make_unibyte (pane_name
);
1624 pane_string
= (NILP (pane_name
)
1625 ? "" : (char *) XSTRING (pane_name
)->data
);
1626 /* If there is just one top-level pane, put all its items directly
1627 under the top-level menu. */
1628 if (menu_items_n_panes
== 1)
1631 /* If the pane has a meaningful name,
1632 make the pane a top-level menu item
1633 with its items as a submenu beneath it. */
1634 if (!keymaps
&& strcmp (pane_string
, ""))
1636 wv
= xmalloc_widget_value ();
1640 first_wv
->contents
= wv
;
1641 wv
->name
= pane_string
;
1642 if (keymaps
&& !NILP (prefix
))
1646 wv
->button_type
= BUTTON_TYPE_NONE
;
1650 else if (first_pane
)
1656 i
+= MENU_ITEMS_PANE_LENGTH
;
1660 /* Create a new item within current pane. */
1661 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1663 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1664 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1666 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1667 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1668 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1669 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1670 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1672 #ifndef HAVE_MULTILINGUAL_MENU
1673 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1674 item_name
= string_make_unibyte (item_name
);
1675 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1676 descrip
= string_make_unibyte (descrip
);
1679 wv
= xmalloc_widget_value ();
1683 save_wv
->contents
= wv
;
1684 wv
->name
= (char *) XSTRING (item_name
)->data
;
1685 if (!NILP (descrip
))
1686 wv
->key
= (char *) XSTRING (descrip
)->data
;
1688 /* Use the contents index as call_data, since we are
1689 restricted to 16-bits.. */
1690 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1691 wv
->enabled
= !NILP (enable
);
1694 wv
->button_type
= BUTTON_TYPE_NONE
;
1695 else if (EQ (type
, QCtoggle
))
1696 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1697 else if (EQ (type
, QCradio
))
1698 wv
->button_type
= BUTTON_TYPE_RADIO
;
1702 wv
->selected
= !NILP (selected
);
1705 wv
->help
= (char *) XSTRING (help
)->data
;
1711 i
+= MENU_ITEMS_ITEM_LENGTH
;
1715 /* Deal with the title, if it is non-nil. */
1718 widget_value
*wv_title
= xmalloc_widget_value ();
1719 widget_value
*wv_sep
= xmalloc_widget_value ();
1721 /* Maybe replace this separator with a bitmap or owner-draw item
1722 so that it looks better. Having two separators looks odd. */
1723 wv_sep
->name
= "--";
1724 wv_sep
->next
= first_wv
->contents
;
1726 #ifndef HAVE_MULTILINGUAL_MENU
1727 if (STRING_MULTIBYTE (title
))
1728 title
= string_make_unibyte (title
);
1730 wv_title
->name
= (char *) XSTRING (title
)->data
;
1731 wv_title
->enabled
= True
;
1732 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1733 wv_title
->next
= wv_sep
;
1734 first_wv
->contents
= wv_title
;
1737 /* Actually create the menu. */
1738 menu
= CreatePopupMenu ();
1739 fill_in_menu (menu
, first_wv
->contents
);
1741 /* Adjust coordinates to be root-window-relative. */
1744 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1746 /* Free the widget_value objects we used to specify the contents. */
1747 free_menubar_widget_value_tree (first_wv
);
1749 /* No selection has been chosen yet. */
1750 menu_item_selection
= 0;
1752 /* Display the menu. */
1753 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1754 WM_EMACS_TRACKPOPUPMENU
,
1755 (WPARAM
)menu
, (LPARAM
)&pos
);
1757 /* Clean up extraneous mouse events which might have been generated
1759 discard_mouse_events ();
1763 /* Find the selected item, and its pane, to return
1764 the proper value. */
1765 if (menu_item_selection
!= 0)
1767 Lisp_Object prefix
, entry
;
1771 while (i
< menu_items_used
)
1773 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1775 subprefix_stack
[submenu_depth
++] = prefix
;
1779 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1781 prefix
= subprefix_stack
[--submenu_depth
];
1784 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1787 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1788 i
+= MENU_ITEMS_PANE_LENGTH
;
1790 /* Ignore a nil in the item list.
1791 It's meaningful only for dialog boxes. */
1792 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1797 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1798 if (menu_item_selection
== i
)
1804 entry
= Fcons (entry
, Qnil
);
1806 entry
= Fcons (prefix
, entry
);
1807 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1808 if (!NILP (subprefix_stack
[j
]))
1809 entry
= Fcons (subprefix_stack
[j
], entry
);
1813 i
+= MENU_ITEMS_ITEM_LENGTH
;
1822 static char * button_names
[] = {
1823 "button1", "button2", "button3", "button4", "button5",
1824 "button6", "button7", "button8", "button9", "button10" };
1827 w32_dialog_show (f
, keymaps
, title
, error
)
1833 int i
, nb_buttons
=0;
1834 char dialog_name
[6];
1835 int menu_item_selection
;
1837 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1839 /* Number of elements seen so far, before boundary. */
1841 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1842 int boundary_seen
= 0;
1846 if (menu_items_n_panes
> 1)
1848 *error
= "Multiple panes in dialog box";
1852 /* Create a tree of widget_value objects
1853 representing the text label and buttons. */
1855 Lisp_Object pane_name
, prefix
;
1857 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1858 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1859 pane_string
= (NILP (pane_name
)
1860 ? "" : (char *) XSTRING (pane_name
)->data
);
1861 prev_wv
= xmalloc_widget_value ();
1862 prev_wv
->value
= pane_string
;
1863 if (keymaps
&& !NILP (prefix
))
1865 prev_wv
->enabled
= 1;
1866 prev_wv
->name
= "message";
1869 /* Loop over all panes and items, filling in the tree. */
1870 i
= MENU_ITEMS_PANE_LENGTH
;
1871 while (i
< menu_items_used
)
1874 /* Create a new item within current pane. */
1875 Lisp_Object item_name
, enable
, descrip
, help
;
1877 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1878 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1880 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1881 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1883 if (NILP (item_name
))
1885 free_menubar_widget_value_tree (first_wv
);
1886 *error
= "Submenu in dialog items";
1889 if (EQ (item_name
, Qquote
))
1891 /* This is the boundary between left-side elts
1892 and right-side elts. Stop incrementing right_count. */
1897 if (nb_buttons
>= 9)
1899 free_menubar_widget_value_tree (first_wv
);
1900 *error
= "Too many dialog items";
1904 wv
= xmalloc_widget_value ();
1906 wv
->name
= (char *) button_names
[nb_buttons
];
1907 if (!NILP (descrip
))
1908 wv
->key
= (char *) XSTRING (descrip
)->data
;
1909 wv
->value
= (char *) XSTRING (item_name
)->data
;
1910 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1911 wv
->enabled
= !NILP (enable
);
1914 if (! boundary_seen
)
1918 i
+= MENU_ITEMS_ITEM_LENGTH
;
1921 /* If the boundary was not specified,
1922 by default put half on the left and half on the right. */
1923 if (! boundary_seen
)
1924 left_count
= nb_buttons
- nb_buttons
/ 2;
1926 wv
= xmalloc_widget_value ();
1927 wv
->name
= dialog_name
;
1929 /* Dialog boxes use a really stupid name encoding
1930 which specifies how many buttons to use
1931 and how many buttons are on the right.
1932 The Q means something also. */
1933 dialog_name
[0] = 'Q';
1934 dialog_name
[1] = '0' + nb_buttons
;
1935 dialog_name
[2] = 'B';
1936 dialog_name
[3] = 'R';
1937 /* Number of buttons to put on the right. */
1938 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1940 wv
->contents
= first_wv
;
1944 /* Actually create the dialog. */
1946 dialog_id
= widget_id_tick
++;
1947 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1948 f
->output_data
.w32
->widget
, 1, 0,
1949 dialog_selection_callback
, 0);
1950 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1953 /* Free the widget_value objects we used to specify the contents. */
1954 free_menubar_widget_value_tree (first_wv
);
1956 /* No selection has been chosen yet. */
1957 menu_item_selection
= 0;
1959 /* Display the menu. */
1961 lw_pop_up_all_widgets (dialog_id
);
1962 popup_activated_flag
= 1;
1964 /* Process events that apply to the menu. */
1965 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1967 lw_destroy_all_widgets (dialog_id
);
1970 /* Find the selected item, and its pane, to return
1971 the proper value. */
1972 if (menu_item_selection
!= 0)
1978 while (i
< menu_items_used
)
1982 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1985 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1986 i
+= MENU_ITEMS_PANE_LENGTH
;
1991 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1992 if (menu_item_selection
== i
)
1996 entry
= Fcons (entry
, Qnil
);
1998 entry
= Fcons (prefix
, entry
);
2002 i
+= MENU_ITEMS_ITEM_LENGTH
;
2011 /* Is this item a separator? */
2013 name_is_separator (name
)
2016 /* Check if name string consists of only dashes ('-') */
2017 while (*name
== '-') name
++;
2018 return (*name
== '\0');
2022 /* Indicate boundary between left and right. */
2024 add_left_right_boundary (HMENU menu
)
2026 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2030 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2036 if (name_is_separator (wv
->name
))
2037 fuFlags
= MF_SEPARATOR
;
2041 fuFlags
= MF_STRING
;
2043 fuFlags
= MF_STRING
| MF_GRAYED
;
2045 if (wv
->key
!= NULL
)
2047 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2048 strcpy (out_string
, wv
->name
);
2049 strcat (out_string
, "\t");
2050 strcat (out_string
, wv
->key
);
2053 out_string
= wv
->name
;
2055 if (wv
->title
|| wv
->call_data
== 0)
2057 #if 0 /* no GC while popup menu is active */
2058 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2059 strcpy (out_string
, wv
->name
);
2061 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2064 /* Draw radio buttons and tickboxes. */
2066 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2067 wv
->button_type
== BUTTON_TYPE_RADIO
))
2068 fuFlags
|= MF_CHECKED
;
2070 fuFlags
|= MF_UNCHECKED
;
2079 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2080 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2082 /* This must be done after the menu item is created. */
2084 HMODULE user32
= GetModuleHandle ("user32.dll");
2085 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2087 if (set_menu_item_info
)
2090 bzero (&info
, sizeof (info
));
2091 info
.cbSize
= sizeof (info
);
2092 info
.fMask
= MIIM_DATA
;
2093 /* Set help string for menu item. */
2094 info
.dwItemData
= (DWORD
)wv
->help
;
2096 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2098 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2099 RADIO items, but is not available on NT 3.51 and earlier. */
2100 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2101 info
.fType
= MFT_RADIOCHECK
;
2102 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2104 set_menu_item_info (menu
,
2105 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2109 return return_value
;
2112 /* Construct native Windows menu(bar) based on widget_value tree. */
2114 fill_in_menu (HMENU menu
, widget_value
*wv
)
2116 int items_added
= 0;
2118 for ( ; wv
!= NULL
; wv
= wv
->next
)
2122 HMENU sub_menu
= CreatePopupMenu ();
2124 if (sub_menu
== NULL
)
2127 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2128 !add_menu_item (menu
, wv
, sub_menu
))
2130 DestroyMenu (sub_menu
);
2136 if (!add_menu_item (menu
, wv
, NULL
))
2146 /* popup_activated_flag not actually used on W32 */
2150 /* Display help string for currently pointed to menu item. Not
2151 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2154 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2156 HMODULE user32
= GetModuleHandle ("user32.dll");
2157 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2159 if (get_menu_item_info
)
2161 struct gcpro gcpro1
;
2162 extern Lisp_Object Vshow_help_function
;
2166 bzero (&info
, sizeof (info
));
2167 info
.cbSize
= sizeof (info
);
2168 info
.fMask
= MIIM_DATA
;
2169 get_menu_item_info (menu
, item
, FALSE
, &info
);
2171 msg
= info
.dwItemData
? build_string ((char *) info
.dwItemData
) : Qnil
;
2174 if (!NILP (Vshow_help_function
))
2175 call1 (Vshow_help_function
, msg
);
2176 else if (!MINI_WINDOW_P (XWINDOW (selected_window
)))
2179 message3_nolog (msg
, XSTRING (msg
)->size
, STRING_MULTIBYTE (msg
));
2189 #endif /* HAVE_MENUS */
2193 staticpro (&menu_items
);
2196 Qdebug_on_next_call
= intern ("debug-on-next-call");
2197 staticpro (&Qdebug_on_next_call
);
2199 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2200 "Frame for which we are updating a menu.\n\
2201 The enable predicate for a menu command should check this variable.");
2202 Vmenu_updating_frame
= Qnil
;
2204 defsubr (&Sx_popup_menu
);
2206 defsubr (&Sx_popup_dialog
);