1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
26 #include "termhooks.h"
30 #include "blockinput.h"
35 /* This may include sys/types.h, and that somehow loses
36 if this is not done before the other system files. */
39 /* Load sys/types.h if not already loaded.
40 In some systems loading it twice is suicidal. */
42 #include <sys/types.h>
45 #include "dispextern.h"
47 #undef HAVE_MULTILINGUAL_MENU
48 #undef HAVE_DIALOGS /* NTEMACS_TODO: Implement native dialogs. */
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
53 typedef void * XtPointer
;
63 typedef struct _widget_value
67 /* value (meaning depend on widget type) */
69 /* keyboard equivalent. no implications for XtTranslations */
71 /* Help string or null if none. */
75 /* true if selected */
77 /* The type of a button. */
78 enum button_type button_type
;
79 /* true if menu title */
82 /* true if was edited (maintained by get_value) */
84 /* true if has changed (maintained by lw library) */
86 /* true if this widget itself has changed,
87 but not counting the other widgets found in the `next' field. */
88 change_type this_one_change
;
90 /* Contents of the sub-widgets, also selected slot for checkbox */
91 struct _widget_value
* contents
;
92 /* data passed to callback */
94 /* next one in the list */
95 struct _widget_value
* next
;
97 /* slot for the toolkit dependent part. Always initialize to NULL. */
99 /* tell us if we should free the toolkit data slot when freeing the
100 widget_value itself. */
101 Boolean free_toolkit_data
;
103 /* we resource the widget_value structures; this points to the next
104 one on the free list if this one has been deallocated.
106 struct _widget_value
*free_list
;
110 /* LocalAlloc/Free is a reasonably good allocator. */
111 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
112 #define free_widget_value(wv) LocalFree (wv)
114 /******************************************************************/
116 #define min(x,y) (((x) < (y)) ? (x) : (y))
117 #define max(x,y) (((x) > (y)) ? (x) : (y))
124 Lisp_Object Vmenu_updating_frame
;
126 Lisp_Object Qdebug_on_next_call
;
128 extern Lisp_Object Qmenu_bar
;
129 extern Lisp_Object Qmouse_click
, Qevent_kind
;
131 extern Lisp_Object QCtoggle
, QCradio
;
133 extern Lisp_Object Voverriding_local_map
;
134 extern Lisp_Object Voverriding_local_map_menu_flag
;
136 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
138 extern Lisp_Object Qmenu_bar_update_hook
;
140 void set_frame_menubar ();
142 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
143 Lisp_Object
, Lisp_Object
, Lisp_Object
,
144 Lisp_Object
, Lisp_Object
));
145 static Lisp_Object
w32_dialog_show ();
146 static Lisp_Object
w32_menu_show ();
148 static void keymap_panes ();
149 static void single_keymap_panes ();
150 static void single_menu_item ();
151 static void list_of_panes ();
152 static void list_of_items ();
154 /* This holds a Lisp vector that holds the results of decoding
155 the keymaps or alist-of-alists that specify a menu.
157 It describes the panes and items within the panes.
159 Each pane is described by 3 elements in the vector:
160 t, the pane name, the pane's prefix key.
161 Then follow the pane's items, with 5 elements per item:
162 the item string, the enable flag, the item's value,
163 the definition, and the equivalent keyboard key's description string.
165 In some cases, multiple levels of menus may be described.
166 A single vector slot containing nil indicates the start of a submenu.
167 A single vector slot containing lambda indicates the end of a submenu.
168 The submenu follows a menu item which is the way to reach the submenu.
170 A single vector slot containing quote indicates that the
171 following items should appear on the right of a dialog box.
173 Using a Lisp vector to hold this information while we decode it
174 takes care of protecting all the data from GC. */
176 #define MENU_ITEMS_PANE_NAME 1
177 #define MENU_ITEMS_PANE_PREFIX 2
178 #define MENU_ITEMS_PANE_LENGTH 3
182 MENU_ITEMS_ITEM_NAME
= 0,
183 MENU_ITEMS_ITEM_ENABLE
,
184 MENU_ITEMS_ITEM_VALUE
,
185 MENU_ITEMS_ITEM_EQUIV_KEY
,
186 MENU_ITEMS_ITEM_DEFINITION
,
187 MENU_ITEMS_ITEM_TYPE
,
188 MENU_ITEMS_ITEM_SELECTED
,
189 MENU_ITEMS_ITEM_HELP
,
190 MENU_ITEMS_ITEM_LENGTH
193 static Lisp_Object menu_items
;
195 /* Number of slots currently allocated in menu_items. */
196 static int menu_items_allocated
;
198 /* This is the index in menu_items of the first empty slot. */
199 static int menu_items_used
;
201 /* The number of panes currently recorded in menu_items,
202 excluding those within submenus. */
203 static int menu_items_n_panes
;
205 /* Current depth within submenus. */
206 static int menu_items_submenu_depth
;
208 /* Flag which when set indicates a dialog or menu has been posted by
209 Xt on behalf of one of the widget sets. */
210 static int popup_activated_flag
;
212 static int next_menubar_widget_id
;
214 /* This is set nonzero after the user activates the menu bar, and set
215 to zero again after the menu bars are redisplayed by prepare_menu_bar.
216 While it is nonzero, all calls to set_frame_menubar go deep.
218 I don't understand why this is needed, but it does seem to be
219 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
221 int pending_menu_activation
;
224 /* Return the frame whose ->output_data.w32->menubar_widget equals
227 static struct frame
*
228 menubar_id_to_frame (id
)
231 Lisp_Object tail
, frame
;
234 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
237 if (!GC_FRAMEP (frame
))
240 if (!FRAME_WINDOW_P (f
))
242 if (f
->output_data
.w32
->menubar_widget
== id
)
248 /* Initialize the menu_items structure if we haven't already done so.
249 Also mark it as currently empty. */
254 if (NILP (menu_items
))
256 menu_items_allocated
= 60;
257 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
261 menu_items_n_panes
= 0;
262 menu_items_submenu_depth
= 0;
265 /* Call at the end of generating the data in menu_items.
266 This fills in the number of items in the last pane. */
273 /* Call when finished using the data for the current menu
277 discard_menu_items ()
279 /* Free the structure if it is especially large.
280 Otherwise, hold on to it, to save time. */
281 if (menu_items_allocated
> 200)
284 menu_items_allocated
= 0;
288 /* Make the menu_items vector twice as large. */
294 int old_size
= menu_items_allocated
;
297 menu_items_allocated
*= 2;
298 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
299 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
300 old_size
* sizeof (Lisp_Object
));
303 /* Begin a submenu. */
306 push_submenu_start ()
308 if (menu_items_used
+ 1 > menu_items_allocated
)
311 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
312 menu_items_submenu_depth
++;
320 if (menu_items_used
+ 1 > menu_items_allocated
)
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
324 menu_items_submenu_depth
--;
327 /* Indicate boundary between left and right. */
330 push_left_right_boundary ()
332 if (menu_items_used
+ 1 > menu_items_allocated
)
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
338 /* Start a new menu pane in menu_items..
339 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
342 push_menu_pane (name
, prefix_vec
)
343 Lisp_Object name
, prefix_vec
;
345 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
348 if (menu_items_submenu_depth
== 0)
349 menu_items_n_panes
++;
350 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
351 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
355 /* Push one menu item into the current pane. NAME is the string to
356 display. ENABLE if non-nil means this item can be selected. KEY
357 is the key generated by choosing this item, or nil if this item
358 doesn't really have a definition. DEF is the definition of this
359 item. EQUIV is the textual description of the keyboard equivalent
360 for this item (or nil if none). TYPE is the type of this menu
361 item, one of nil, `toggle' or `radio'. */
364 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
365 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
367 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
370 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
371 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
372 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
380 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
381 and generate menu panes for them in menu_items.
382 If NOTREAL is nonzero,
383 don't bother really computing whether an item is enabled. */
386 keymap_panes (keymaps
, nmaps
, notreal
)
387 Lisp_Object
*keymaps
;
395 /* Loop over the given keymaps, making a pane for each map.
396 But don't make a pane that is empty--ignore that map instead.
397 P is the number of panes we have made so far. */
398 for (mapno
= 0; mapno
< nmaps
; mapno
++)
399 single_keymap_panes (keymaps
[mapno
],
400 map_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
402 finish_menu_items ();
405 /* This is a recursive subroutine of keymap_panes.
406 It handles one keymap, KEYMAP.
407 The other arguments are passed along
408 or point to local variables of the previous function.
409 If NOTREAL is nonzero, only check for equivalent key bindings, don't
410 evaluate expressions in menu items and don't make any menu.
412 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
415 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
417 Lisp_Object pane_name
;
422 Lisp_Object pending_maps
= Qnil
;
423 Lisp_Object tail
, item
;
424 struct gcpro gcpro1
, gcpro2
;
429 push_menu_pane (pane_name
, prefix
);
431 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
433 GCPRO2 (keymap
, pending_maps
);
434 /* Look at each key binding, and if it is a menu item add it
438 single_menu_item (XCAR (item
), XCDR (item
),
439 &pending_maps
, notreal
, maxdepth
);
440 else if (VECTORP (item
))
442 /* Loop over the char values represented in the vector. */
443 int len
= XVECTOR (item
)->size
;
445 for (c
= 0; c
< len
; c
++)
447 Lisp_Object character
;
448 XSETFASTINT (character
, c
);
449 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
450 &pending_maps
, notreal
, maxdepth
);
456 /* Process now any submenus which want to be panes at this level. */
457 while (!NILP (pending_maps
))
459 Lisp_Object elt
, eltcdr
, string
;
460 elt
= Fcar (pending_maps
);
462 string
= XCAR (eltcdr
);
463 /* We no longer discard the @ from the beginning of the string here.
464 Instead, we do this in w32_menu_show. */
465 single_keymap_panes (Fcar (elt
), string
,
466 XCDR (eltcdr
), notreal
, maxdepth
- 1);
467 pending_maps
= Fcdr (pending_maps
);
471 /* This is a subroutine of single_keymap_panes that handles one
473 KEY is a key in a keymap and ITEM is its binding.
474 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
476 If NOTREAL is nonzero, only check for equivalent key bindings, don't
477 evaluate expressions in menu items and don't make any menu.
478 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
481 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
482 Lisp_Object key
, item
;
483 Lisp_Object
*pending_maps_ptr
;
484 int maxdepth
, notreal
;
486 Lisp_Object map
, item_string
, enabled
;
487 struct gcpro gcpro1
, gcpro2
;
490 /* Parse the menu item and leave the result in item_properties. */
492 res
= parse_menu_item (item
, notreal
, 0);
495 return; /* Not a menu item. */
497 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
501 /* We don't want to make a menu, just traverse the keymaps to
502 precompute equivalent key bindings. */
504 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
508 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
509 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
511 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
514 /* An enabled separate pane. Remember this to handle it later. */
515 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
520 push_menu_item (item_string
, enabled
, key
,
521 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
522 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
523 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
524 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
525 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
527 /* Display a submenu using the toolkit. */
528 if (! (NILP (map
) || NILP (enabled
)))
530 push_submenu_start ();
531 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
536 /* Push all the panes and items of a menu described by the
537 alist-of-alists MENU.
538 This handles old-fashioned calls to x-popup-menu. */
548 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
550 Lisp_Object elt
, pane_name
, pane_data
;
552 pane_name
= Fcar (elt
);
553 CHECK_STRING (pane_name
, 0);
554 push_menu_pane (pane_name
, Qnil
);
555 pane_data
= Fcdr (elt
);
556 CHECK_CONS (pane_data
, 0);
557 list_of_items (pane_data
);
560 finish_menu_items ();
563 /* Push the items in a single pane defined by the alist PANE. */
569 Lisp_Object tail
, item
, item1
;
571 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
575 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
576 else if (NILP (item
))
577 push_left_right_boundary ();
580 CHECK_CONS (item
, 0);
582 CHECK_STRING (item1
, 1);
583 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
588 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
589 "Pop up a deck-of-cards menu and return user's selection.\n\
590 POSITION is a position specification. This is either a mouse button event\n\
591 or a list ((XOFFSET YOFFSET) WINDOW)\n\
592 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
593 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
594 This controls the position of the center of the first line\n\
595 in the first pane of the menu, not the top left of the menu as a whole.\n\
596 If POSITION is t, it means to use the current mouse position.\n\
598 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
599 The menu items come from key bindings that have a menu string as well as\n\
600 a definition; actually, the \"definition\" in such a key binding looks like\n\
601 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
602 the keymap as a top-level element.\n\n\
603 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
604 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
606 You can also use a list of keymaps as MENU.\n\
607 Then each keymap makes a separate pane.\n\
608 When MENU is a keymap or a list of keymaps, the return value\n\
609 is a list of events.\n\n\
611 Alternatively, you can specify a menu of multiple panes\n\
612 with a list of the form (TITLE PANE1 PANE2...),\n\
613 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
614 Each ITEM is normally a cons cell (STRING . VALUE);\n\
615 but a string can appear as an item--that makes a nonselectable line\n\
617 With this form of menu, the return value is VALUE from the chosen item.\n\
619 If POSITION is nil, don't display the menu at all, just precalculate the\n\
620 cached information about equivalent key sequences.")
622 Lisp_Object position
, menu
;
624 Lisp_Object keymap
, tem
;
628 Lisp_Object selection
;
630 Lisp_Object x
, y
, window
;
636 if (! NILP (position
))
640 /* Decode the first argument: find the window and the coordinates. */
641 if (EQ (position
, Qt
)
642 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
643 || EQ (XCAR (position
), Qtool_bar
))))
645 /* Use the mouse's current position. */
646 FRAME_PTR new_f
= SELECTED_FRAME ();
647 Lisp_Object bar_window
;
648 enum scroll_bar_part part
;
651 if (mouse_position_hook
)
652 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
653 &part
, &x
, &y
, &time
);
655 XSETFRAME (window
, new_f
);
658 window
= selected_window
;
665 tem
= Fcar (position
);
668 window
= Fcar (Fcdr (position
));
670 y
= Fcar (Fcdr (tem
));
675 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
676 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
677 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
686 /* Decode where to put the menu. */
694 else if (WINDOWP (window
))
696 CHECK_LIVE_WINDOW (window
, 0);
697 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
699 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
700 * XFASTINT (XWINDOW (window
)->left
));
701 ypos
= (FRAME_LINE_HEIGHT (f
)
702 * XFASTINT (XWINDOW (window
)->top
));
705 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
706 but I don't want to make one now. */
707 CHECK_WINDOW (window
, 0);
712 XSETFRAME (Vmenu_updating_frame
, f
);
714 Vmenu_updating_frame
= Qnil
;
715 #endif /* HAVE_MENUS */
720 /* Decode the menu items from what was specified. */
722 keymap
= get_keymap (menu
, 0, 0);
725 /* We were given a keymap. Extract menu info from the keymap. */
728 /* Extract the detailed info to make one pane. */
729 keymap_panes (&menu
, 1, NILP (position
));
731 /* Search for a string appearing directly as an element of the keymap.
732 That string is the title of the menu. */
733 prompt
= map_prompt (keymap
);
734 if (NILP (title
) && !NILP (prompt
))
737 /* Make that be the pane title of the first pane. */
738 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
739 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
743 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
745 /* We were given a list of keymaps. */
746 int nmaps
= XFASTINT (Flength (menu
));
748 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
753 /* The first keymap that has a prompt string
754 supplies the menu title. */
755 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
759 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
761 prompt
= map_prompt (keymap
);
762 if (NILP (title
) && !NILP (prompt
))
766 /* Extract the detailed info to make one pane. */
767 keymap_panes (maps
, nmaps
, NILP (position
));
769 /* Make the title be the pane title of the first pane. */
770 if (!NILP (title
) && menu_items_n_panes
>= 0)
771 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
777 /* We were given an old-fashioned menu. */
779 CHECK_STRING (title
, 1);
781 list_of_panes (Fcdr (menu
));
788 discard_menu_items ();
794 /* Display them in a menu. */
797 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
798 keymaps
, title
, &error_name
);
801 discard_menu_items ();
804 #endif /* HAVE_MENUS */
806 if (error_name
) error (error_name
);
812 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
813 "Pop up a dialog box and return user's selection.\n\
814 POSITION specifies which frame to use.\n\
815 This is normally a mouse button event or a window or frame.\n\
816 If POSITION is t, it means to use the frame the mouse is on.\n\
817 The dialog box appears in the middle of the specified frame.\n\
819 CONTENTS specifies the alternatives to display in the dialog box.\n\
820 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
821 Each ITEM is a cons cell (STRING . VALUE).\n\
822 The return value is VALUE from the chosen item.\n\n\
823 An ITEM may also be just a string--that makes a nonselectable item.\n\
824 An ITEM may also be nil--that means to put all preceding items\n\
825 on the left of the dialog box and all following items on the right.\n\
826 \(By default, approximately half appear on each side.)")
828 Lisp_Object position
, contents
;
835 /* Decode the first argument: find the window or frame to use. */
836 if (EQ (position
, Qt
)
837 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
838 || EQ (XCAR (position
), Qtool_bar
))))
840 #if 0 /* Using the frame the mouse is on may not be right. */
841 /* Use the mouse's current position. */
842 FRAME_PTR new_f
= SELECTED_FRAME ();
843 Lisp_Object bar_window
;
844 enum scroll_bar_part part
;
848 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
851 XSETFRAME (window
, new_f
);
853 window
= selected_window
;
855 window
= selected_window
;
857 else if (CONSP (position
))
860 tem
= Fcar (position
);
862 window
= Fcar (Fcdr (position
));
865 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
866 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
869 else if (WINDOWP (position
) || FRAMEP (position
))
874 /* Decode where to put the menu. */
878 else if (WINDOWP (window
))
880 CHECK_LIVE_WINDOW (window
, 0);
881 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
884 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
885 but I don't want to make one now. */
886 CHECK_WINDOW (window
, 0);
889 /* Display a menu with these alternatives
890 in the middle of frame F. */
892 Lisp_Object x
, y
, frame
, newpos
;
893 XSETFRAME (frame
, f
);
894 XSETINT (x
, x_pixel_width (f
) / 2);
895 XSETINT (y
, x_pixel_height (f
) / 2);
896 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
898 return Fx_popup_menu (newpos
,
899 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
901 #else /* HAVE_DIALOGS */
905 Lisp_Object selection
;
907 /* Decode the dialog items from what was specified. */
908 title
= Fcar (contents
);
909 CHECK_STRING (title
, 1);
911 list_of_panes (Fcons (contents
, Qnil
));
913 /* Display them in a dialog box. */
915 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
918 discard_menu_items ();
920 if (error_name
) error (error_name
);
923 #endif /* HAVE_DIALOGS */
926 /* Activate the menu bar of frame F.
927 This is called from keyboard.c when it gets the
928 menu_bar_activate_event out of the Emacs event queue.
930 To activate the menu bar, we signal to the input thread that it can
931 return from the WM_INITMENU message, allowing the normal Windows
932 processing of the menus.
934 But first we recompute the menu bar contents (the whole tree).
936 This way we can safely execute Lisp code. */
939 x_activate_menubar (f
)
942 set_frame_menubar (f
, 0, 1);
944 /* Lock out further menubar changes while active. */
945 f
->output_data
.w32
->menubar_active
= 1;
947 /* Signal input thread to return from WM_INITMENU. */
948 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
951 /* This callback is called from the menu bar pulldown menu
952 when the user makes a selection.
953 Figure out what the user chose
954 and put the appropriate events into the keyboard buffer. */
957 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
959 Lisp_Object prefix
, entry
;
961 Lisp_Object
*subprefix_stack
;
962 int submenu_depth
= 0;
967 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
968 vector
= f
->menu_bar_vector
;
971 while (i
< f
->menu_bar_items_used
)
973 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
975 subprefix_stack
[submenu_depth
++] = prefix
;
979 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
981 prefix
= subprefix_stack
[--submenu_depth
];
984 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
986 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
987 i
+= MENU_ITEMS_PANE_LENGTH
;
991 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
992 /* The EMACS_INT cast avoids a warning. There's no problem
993 as long as pointers have enough bits to hold small integers. */
994 if ((int) (EMACS_INT
) client_data
== i
)
997 struct input_event buf
;
1000 XSETFRAME (frame
, f
);
1001 buf
.kind
= MENU_BAR_EVENT
;
1002 buf
.frame_or_window
= frame
;
1004 kbd_buffer_store_event (&buf
);
1006 for (j
= 0; j
< submenu_depth
; j
++)
1007 if (!NILP (subprefix_stack
[j
]))
1009 buf
.kind
= MENU_BAR_EVENT
;
1010 buf
.frame_or_window
= frame
;
1011 buf
.arg
= subprefix_stack
[j
];
1012 kbd_buffer_store_event (&buf
);
1017 buf
.kind
= MENU_BAR_EVENT
;
1018 buf
.frame_or_window
= frame
;
1020 kbd_buffer_store_event (&buf
);
1023 buf
.kind
= MENU_BAR_EVENT
;
1024 buf
.frame_or_window
= frame
;
1026 kbd_buffer_store_event (&buf
);
1030 i
+= MENU_ITEMS_ITEM_LENGTH
;
1035 /* Allocate a widget_value, blocking input. */
1038 xmalloc_widget_value ()
1040 widget_value
*value
;
1043 value
= malloc_widget_value ();
1049 /* This recursively calls free_widget_value on the tree of widgets.
1050 It must free all data that was malloc'ed for these widget_values.
1051 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1052 must be left alone. */
1055 free_menubar_widget_value_tree (wv
)
1060 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1062 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1064 free_menubar_widget_value_tree (wv
->contents
);
1065 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1069 free_menubar_widget_value_tree (wv
->next
);
1070 wv
->next
= (widget_value
*) 0xDEADBEEF;
1073 free_widget_value (wv
);
1077 /* Return a tree of widget_value structures for a menu bar item
1078 whose event type is ITEM_KEY (with string ITEM_NAME)
1079 and whose contents come from the list of keymaps MAPS. */
1081 static widget_value
*
1082 single_submenu (item_key
, item_name
, maps
)
1083 Lisp_Object item_key
, item_name
, maps
;
1085 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1087 int submenu_depth
= 0;
1090 Lisp_Object
*mapvec
;
1091 widget_value
**submenu_stack
;
1092 int previous_items
= menu_items_used
;
1093 int top_level_items
= 0;
1095 length
= Flength (maps
);
1096 len
= XINT (length
);
1098 /* Convert the list MAPS into a vector MAPVEC. */
1099 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1100 for (i
= 0; i
< len
; i
++)
1102 mapvec
[i
] = Fcar (maps
);
1106 menu_items_n_panes
= 0;
1108 /* Loop over the given keymaps, making a pane for each map.
1109 But don't make a pane that is empty--ignore that map instead. */
1110 for (i
= 0; i
< len
; i
++)
1112 if (SYMBOLP (mapvec
[i
])
1113 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1115 /* Here we have a command at top level in the menu bar
1116 as opposed to a submenu. */
1117 top_level_items
= 1;
1118 push_menu_pane (Qnil
, Qnil
);
1119 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1120 Qnil
, Qnil
, Qnil
, Qnil
);
1123 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1126 /* Create a tree of widget_value objects
1127 representing the panes and their items. */
1130 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1131 wv
= xmalloc_widget_value ();
1135 wv
->button_type
= BUTTON_TYPE_NONE
;
1140 /* Loop over all panes and items made during this call
1141 and construct a tree of widget_value objects.
1142 Ignore the panes and items made by previous calls to
1143 single_submenu, even though those are also in menu_items. */
1145 while (i
< menu_items_used
)
1147 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1149 submenu_stack
[submenu_depth
++] = save_wv
;
1154 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1157 save_wv
= submenu_stack
[--submenu_depth
];
1160 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1161 && submenu_depth
!= 0)
1162 i
+= MENU_ITEMS_PANE_LENGTH
;
1163 /* Ignore a nil in the item list.
1164 It's meaningful only for dialog boxes. */
1165 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1167 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1169 /* Create a new pane. */
1170 Lisp_Object pane_name
, prefix
;
1172 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1173 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1174 #ifndef HAVE_MULTILINGUAL_MENU
1175 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1176 pane_name
= ENCODE_SYSTEM (pane_name
);
1178 pane_string
= (NILP (pane_name
)
1179 ? "" : (char *) XSTRING (pane_name
)->data
);
1180 /* If there is just one top-level pane, put all its items directly
1181 under the top-level menu. */
1182 if (menu_items_n_panes
== 1)
1185 /* If the pane has a meaningful name,
1186 make the pane a top-level menu item
1187 with its items as a submenu beneath it. */
1188 if (strcmp (pane_string
, ""))
1190 wv
= xmalloc_widget_value ();
1194 first_wv
->contents
= wv
;
1195 wv
->name
= pane_string
;
1196 /* Ignore the @ that means "separate pane".
1197 This is a kludge, but this isn't worth more time. */
1198 if (!NILP (prefix
) && wv
->name
[0] == '@')
1202 wv
->button_type
= BUTTON_TYPE_NONE
;
1206 i
+= MENU_ITEMS_PANE_LENGTH
;
1210 /* Create a new item within current pane. */
1211 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1214 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1215 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1217 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1218 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1219 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1220 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1221 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1223 #ifndef HAVE_MULTILINGUAL_MENU
1224 if (STRING_MULTIBYTE (item_name
))
1225 item_name
= ENCODE_SYSTEM (item_name
);
1226 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1227 descrip
= ENCODE_SYSTEM (descrip
);
1230 wv
= xmalloc_widget_value ();
1234 save_wv
->contents
= wv
;
1236 wv
->name
= (char *) XSTRING (item_name
)->data
;
1237 if (!NILP (descrip
))
1238 wv
->key
= (char *) XSTRING (descrip
)->data
;
1240 /* The EMACS_INT cast avoids a warning. There's no problem
1241 as long as pointers have enough bits to hold small integers. */
1242 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1243 wv
->enabled
= !NILP (enable
);
1246 wv
->button_type
= BUTTON_TYPE_NONE
;
1247 else if (EQ (type
, QCradio
))
1248 wv
->button_type
= BUTTON_TYPE_RADIO
;
1249 else if (EQ (type
, QCtoggle
))
1250 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1254 wv
->selected
= !NILP (selected
);
1256 wv
->help
= (char *) XSTRING (help
)->data
;
1262 i
+= MENU_ITEMS_ITEM_LENGTH
;
1266 /* If we have just one "menu item"
1267 that was originally a button, return it by itself. */
1268 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1270 wv
= first_wv
->contents
;
1271 free_widget_value (first_wv
);
1278 /* Set the contents of the menubar widgets of frame F.
1279 The argument FIRST_TIME is currently ignored;
1280 it is set the first time this is called, from initialize_frame_menubar. */
1283 set_frame_menubar (f
, first_time
, deep_p
)
1288 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1290 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1293 /* We must not change the menubar when actually in use. */
1294 if (f
->output_data
.w32
->menubar_active
)
1297 XSETFRAME (Vmenu_updating_frame
, f
);
1299 if (! menubar_widget
)
1301 else if (pending_menu_activation
&& !deep_p
)
1304 wv
= xmalloc_widget_value ();
1305 wv
->name
= "menubar";
1308 wv
->button_type
= BUTTON_TYPE_NONE
;
1313 /* Make a widget-value tree representing the entire menu trees. */
1315 struct buffer
*prev
= current_buffer
;
1317 int specpdl_count
= specpdl_ptr
- specpdl
;
1318 int previous_menu_items_used
= f
->menu_bar_items_used
;
1319 Lisp_Object
*previous_items
1320 = (Lisp_Object
*) alloca (previous_menu_items_used
1321 * sizeof (Lisp_Object
));
1323 /* If we are making a new widget, its contents are empty,
1324 do always reinitialize them. */
1325 if (! menubar_widget
)
1326 previous_menu_items_used
= 0;
1328 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1329 specbind (Qinhibit_quit
, Qt
);
1330 /* Don't let the debugger step into this code
1331 because it is not reentrant. */
1332 specbind (Qdebug_on_next_call
, Qnil
);
1334 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1335 if (NILP (Voverriding_local_map_menu_flag
))
1337 specbind (Qoverriding_terminal_local_map
, Qnil
);
1338 specbind (Qoverriding_local_map
, Qnil
);
1341 set_buffer_internal_1 (XBUFFER (buffer
));
1343 /* Run the Lucid hook. */
1344 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1345 /* If it has changed current-menubar from previous value,
1346 really recompute the menubar from the value. */
1347 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1348 call0 (Qrecompute_lucid_menubar
);
1349 safe_run_hooks (Qmenu_bar_update_hook
);
1350 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1352 items
= FRAME_MENU_BAR_ITEMS (f
);
1354 inhibit_garbage_collection ();
1356 /* Save the frame's previous menu bar contents data. */
1357 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1358 previous_menu_items_used
* sizeof (Lisp_Object
));
1360 /* Fill in the current menu bar contents. */
1361 menu_items
= f
->menu_bar_vector
;
1362 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1364 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1366 Lisp_Object key
, string
, maps
;
1368 key
= XVECTOR (items
)->contents
[i
];
1369 string
= XVECTOR (items
)->contents
[i
+ 1];
1370 maps
= XVECTOR (items
)->contents
[i
+ 2];
1374 wv
= single_submenu (key
, string
, maps
);
1378 first_wv
->contents
= wv
;
1379 /* Don't set wv->name here; GC during the loop might relocate it. */
1381 wv
->button_type
= BUTTON_TYPE_NONE
;
1385 finish_menu_items ();
1387 set_buffer_internal_1 (prev
);
1388 unbind_to (specpdl_count
, Qnil
);
1390 /* If there has been no change in the Lisp-level contents
1391 of the menu bar, skip redisplaying it. Just exit. */
1393 for (i
= 0; i
< previous_menu_items_used
; i
++)
1394 if (menu_items_used
== i
1395 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1397 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1399 free_menubar_widget_value_tree (first_wv
);
1405 /* Now GC cannot happen during the lifetime of the widget_value,
1406 so it's safe to store data from a Lisp_String. */
1407 wv
= first_wv
->contents
;
1408 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1411 string
= XVECTOR (items
)->contents
[i
+ 1];
1414 wv
->name
= (char *) XSTRING (string
)->data
;
1418 f
->menu_bar_vector
= menu_items
;
1419 f
->menu_bar_items_used
= menu_items_used
;
1424 /* Make a widget-value tree containing
1425 just the top level menu bar strings. */
1427 items
= FRAME_MENU_BAR_ITEMS (f
);
1428 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1432 string
= XVECTOR (items
)->contents
[i
+ 1];
1436 wv
= xmalloc_widget_value ();
1437 wv
->name
= (char *) XSTRING (string
)->data
;
1440 wv
->button_type
= BUTTON_TYPE_NONE
;
1441 /* This prevents lwlib from assuming this
1442 menu item is really supposed to be empty. */
1443 /* The EMACS_INT cast avoids a warning.
1444 This value just has to be different from small integers. */
1445 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1450 first_wv
->contents
= wv
;
1454 /* Forget what we thought we knew about what is in the
1455 detailed contents of the menu bar menus.
1456 Changing the top level always destroys the contents. */
1457 f
->menu_bar_items_used
= 0;
1460 /* Create or update the menu bar widget. */
1466 /* Empty current menubar, rather than creating a fresh one. */
1467 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1472 menubar_widget
= CreateMenu ();
1474 fill_in_menu (menubar_widget
, first_wv
->contents
);
1476 free_menubar_widget_value_tree (first_wv
);
1479 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1481 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1482 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1483 /* Causes flicker when menu bar is updated
1484 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1486 /* Force the window size to be recomputed so that the frame's text
1487 area remains the same, if menubar has just been created. */
1488 if (old_widget
== NULL
)
1489 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1495 /* Called from Fx_create_frame to create the initial menubar of a frame
1496 before it is mapped, so that the window is mapped with the menubar already
1497 there instead of us tacking it on later and thrashing the window after it
1501 initialize_frame_menubar (f
)
1504 /* This function is called before the first chance to redisplay
1505 the frame. It has to be, so the frame will have the right size. */
1506 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1507 set_frame_menubar (f
, 1, 1);
1510 /* Get rid of the menu bar of frame F, and free its storage.
1511 This is used when deleting a frame, and when turning off the menu bar. */
1514 free_frame_menubar (f
)
1520 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1521 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1522 f
->output_data
.w32
->menubar_widget
= NULL
;
1530 /* w32_menu_show actually displays a menu using the panes and items in
1531 menu_items and returns the value selected from it; we assume input
1532 is blocked by the caller. */
1534 /* F is the frame the menu is for.
1535 X and Y are the frame-relative specified position,
1536 relative to the inside upper left corner of the frame F.
1537 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1538 KEYMAPS is 1 if this menu was specified with keymaps;
1539 in that case, we return a list containing the chosen item's value
1540 and perhaps also the pane's prefix.
1541 TITLE is the specified menu title.
1542 ERROR is a place to store an error message string in case of failure.
1543 (We return nil on failure, but the value doesn't actually matter.) */
1546 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1556 int menu_item_selection
;
1559 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1560 widget_value
**submenu_stack
1561 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1562 Lisp_Object
*subprefix_stack
1563 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1564 int submenu_depth
= 0;
1569 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1571 *error
= "Empty menu";
1575 /* Create a tree of widget_value objects
1576 representing the panes and their items. */
1577 wv
= xmalloc_widget_value ();
1581 wv
->button_type
= BUTTON_TYPE_NONE
;
1585 /* Loop over all panes and items, filling in the tree. */
1587 while (i
< menu_items_used
)
1589 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1591 submenu_stack
[submenu_depth
++] = save_wv
;
1597 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1600 save_wv
= submenu_stack
[--submenu_depth
];
1604 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1605 && submenu_depth
!= 0)
1606 i
+= MENU_ITEMS_PANE_LENGTH
;
1607 /* Ignore a nil in the item list.
1608 It's meaningful only for dialog boxes. */
1609 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1611 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1613 /* Create a new pane. */
1614 Lisp_Object pane_name
, prefix
;
1616 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1617 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1618 #ifndef HAVE_MULTILINGUAL_MENU
1619 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1620 pane_name
= ENCODE_SYSTEM (pane_name
);
1622 pane_string
= (NILP (pane_name
)
1623 ? "" : (char *) XSTRING (pane_name
)->data
);
1624 /* If there is just one top-level pane, put all its items directly
1625 under the top-level menu. */
1626 if (menu_items_n_panes
== 1)
1629 /* If the pane has a meaningful name,
1630 make the pane a top-level menu item
1631 with its items as a submenu beneath it. */
1632 if (!keymaps
&& strcmp (pane_string
, ""))
1634 wv
= xmalloc_widget_value ();
1638 first_wv
->contents
= wv
;
1639 wv
->name
= pane_string
;
1640 if (keymaps
&& !NILP (prefix
))
1644 wv
->button_type
= BUTTON_TYPE_NONE
;
1648 else if (first_pane
)
1654 i
+= MENU_ITEMS_PANE_LENGTH
;
1658 /* Create a new item within current pane. */
1659 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1661 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1662 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1664 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1665 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1666 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1667 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1668 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1670 #ifndef HAVE_MULTILINGUAL_MENU
1671 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1672 item_name
= ENCODE_SYSTEM (item_name
);
1673 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1674 descrip
= ENCODE_SYSTEM (descrip
);
1677 wv
= xmalloc_widget_value ();
1681 save_wv
->contents
= wv
;
1682 wv
->name
= (char *) XSTRING (item_name
)->data
;
1683 if (!NILP (descrip
))
1684 wv
->key
= (char *) XSTRING (descrip
)->data
;
1686 /* Use the contents index as call_data, since we are
1687 restricted to 16-bits.. */
1688 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1689 wv
->enabled
= !NILP (enable
);
1692 wv
->button_type
= BUTTON_TYPE_NONE
;
1693 else if (EQ (type
, QCtoggle
))
1694 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1695 else if (EQ (type
, QCradio
))
1696 wv
->button_type
= BUTTON_TYPE_RADIO
;
1700 wv
->selected
= !NILP (selected
);
1703 wv
->help
= (char *) XSTRING (help
)->data
;
1709 i
+= MENU_ITEMS_ITEM_LENGTH
;
1713 /* Deal with the title, if it is non-nil. */
1716 widget_value
*wv_title
= xmalloc_widget_value ();
1717 widget_value
*wv_sep
= xmalloc_widget_value ();
1719 /* Maybe replace this separator with a bitmap or owner-draw item
1720 so that it looks better. Having two separators looks odd. */
1721 wv_sep
->name
= "--";
1722 wv_sep
->next
= first_wv
->contents
;
1724 #ifndef HAVE_MULTILINGUAL_MENU
1725 if (STRING_MULTIBYTE (title
))
1726 title
= ENCODE_SYSTEM (title
);
1728 wv_title
->name
= (char *) XSTRING (title
)->data
;
1729 wv_title
->enabled
= TRUE
;
1730 wv_title
->title
= TRUE
;
1731 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1732 wv_title
->next
= wv_sep
;
1733 first_wv
->contents
= wv_title
;
1736 /* Actually create the menu. */
1737 menu
= CreatePopupMenu ();
1738 fill_in_menu (menu
, first_wv
->contents
);
1740 /* Adjust coordinates to be root-window-relative. */
1743 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1745 /* No selection has been chosen yet. */
1746 menu_item_selection
= 0;
1748 /* Display the menu. */
1749 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1750 WM_EMACS_TRACKPOPUPMENU
,
1751 (WPARAM
)menu
, (LPARAM
)&pos
);
1753 /* Clean up extraneous mouse events which might have been generated
1755 discard_mouse_events ();
1757 /* Free the widget_value objects we used to specify the contents. */
1758 free_menubar_widget_value_tree (first_wv
);
1762 /* Find the selected item, and its pane, to return
1763 the proper value. */
1764 if (menu_item_selection
!= 0)
1766 Lisp_Object prefix
, entry
;
1770 while (i
< menu_items_used
)
1772 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1774 subprefix_stack
[submenu_depth
++] = prefix
;
1778 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1780 prefix
= subprefix_stack
[--submenu_depth
];
1783 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1786 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1787 i
+= MENU_ITEMS_PANE_LENGTH
;
1789 /* Ignore a nil in the item list.
1790 It's meaningful only for dialog boxes. */
1791 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1796 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1797 if (menu_item_selection
== i
)
1803 entry
= Fcons (entry
, Qnil
);
1805 entry
= Fcons (prefix
, entry
);
1806 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1807 if (!NILP (subprefix_stack
[j
]))
1808 entry
= Fcons (subprefix_stack
[j
], entry
);
1812 i
+= MENU_ITEMS_ITEM_LENGTH
;
1821 static char * button_names
[] = {
1822 "button1", "button2", "button3", "button4", "button5",
1823 "button6", "button7", "button8", "button9", "button10" };
1826 w32_dialog_show (f
, keymaps
, title
, error
)
1832 int i
, nb_buttons
=0;
1833 char dialog_name
[6];
1834 int menu_item_selection
;
1836 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1838 /* Number of elements seen so far, before boundary. */
1840 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1841 int boundary_seen
= 0;
1845 if (menu_items_n_panes
> 1)
1847 *error
= "Multiple panes in dialog box";
1851 /* Create a tree of widget_value objects
1852 representing the text label and buttons. */
1854 Lisp_Object pane_name
, prefix
;
1856 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1857 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1858 pane_string
= (NILP (pane_name
)
1859 ? "" : (char *) XSTRING (pane_name
)->data
);
1860 prev_wv
= xmalloc_widget_value ();
1861 prev_wv
->value
= pane_string
;
1862 if (keymaps
&& !NILP (prefix
))
1864 prev_wv
->enabled
= 1;
1865 prev_wv
->name
= "message";
1868 /* Loop over all panes and items, filling in the tree. */
1869 i
= MENU_ITEMS_PANE_LENGTH
;
1870 while (i
< menu_items_used
)
1873 /* Create a new item within current pane. */
1874 Lisp_Object item_name
, enable
, descrip
, help
;
1876 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1877 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1879 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1880 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1882 if (NILP (item_name
))
1884 free_menubar_widget_value_tree (first_wv
);
1885 *error
= "Submenu in dialog items";
1888 if (EQ (item_name
, Qquote
))
1890 /* This is the boundary between left-side elts
1891 and right-side elts. Stop incrementing right_count. */
1896 if (nb_buttons
>= 9)
1898 free_menubar_widget_value_tree (first_wv
);
1899 *error
= "Too many dialog items";
1903 wv
= xmalloc_widget_value ();
1905 wv
->name
= (char *) button_names
[nb_buttons
];
1906 if (!NILP (descrip
))
1907 wv
->key
= (char *) XSTRING (descrip
)->data
;
1908 wv
->value
= (char *) XSTRING (item_name
)->data
;
1909 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1910 wv
->enabled
= !NILP (enable
);
1913 if (! boundary_seen
)
1917 i
+= MENU_ITEMS_ITEM_LENGTH
;
1920 /* If the boundary was not specified,
1921 by default put half on the left and half on the right. */
1922 if (! boundary_seen
)
1923 left_count
= nb_buttons
- nb_buttons
/ 2;
1925 wv
= xmalloc_widget_value ();
1926 wv
->name
= dialog_name
;
1928 /* Dialog boxes use a really stupid name encoding
1929 which specifies how many buttons to use
1930 and how many buttons are on the right.
1931 The Q means something also. */
1932 dialog_name
[0] = 'Q';
1933 dialog_name
[1] = '0' + nb_buttons
;
1934 dialog_name
[2] = 'B';
1935 dialog_name
[3] = 'R';
1936 /* Number of buttons to put on the right. */
1937 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1939 wv
->contents
= first_wv
;
1943 /* Actually create the dialog. */
1945 dialog_id
= widget_id_tick
++;
1946 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1947 f
->output_data
.w32
->widget
, 1, 0,
1948 dialog_selection_callback
, 0);
1949 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
1952 /* Free the widget_value objects we used to specify the contents. */
1953 free_menubar_widget_value_tree (first_wv
);
1955 /* No selection has been chosen yet. */
1956 menu_item_selection
= 0;
1958 /* Display the menu. */
1960 lw_pop_up_all_widgets (dialog_id
);
1961 popup_activated_flag
= 1;
1963 /* Process events that apply to the menu. */
1964 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1966 lw_destroy_all_widgets (dialog_id
);
1969 /* Find the selected item, and its pane, to return
1970 the proper value. */
1971 if (menu_item_selection
!= 0)
1977 while (i
< menu_items_used
)
1981 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1984 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1985 i
+= MENU_ITEMS_PANE_LENGTH
;
1990 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1991 if (menu_item_selection
== i
)
1995 entry
= Fcons (entry
, Qnil
);
1997 entry
= Fcons (prefix
, entry
);
2001 i
+= MENU_ITEMS_ITEM_LENGTH
;
2010 /* Is this item a separator? */
2012 name_is_separator (name
)
2015 /* Check if name string consists of only dashes ('-') */
2016 while (*name
== '-') name
++;
2017 return (*name
== '\0');
2021 /* Indicate boundary between left and right. */
2023 add_left_right_boundary (HMENU menu
)
2025 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2029 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2035 if (name_is_separator (wv
->name
))
2036 fuFlags
= MF_SEPARATOR
;
2040 fuFlags
= MF_STRING
;
2042 fuFlags
= MF_STRING
| MF_GRAYED
;
2044 if (wv
->key
!= NULL
)
2046 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2047 strcpy (out_string
, wv
->name
);
2048 strcat (out_string
, "\t");
2049 strcat (out_string
, wv
->key
);
2052 out_string
= wv
->name
;
2056 #if 0 /* no GC while popup menu is active */
2057 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2058 strcpy (out_string
, wv
->name
);
2060 /* NTEMACS_TODO: Why has owner drawing stopped working? */
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
;
2094 /* Set help string for menu item. */
2095 info
.dwItemData
= (DWORD
)wv
->help
;
2097 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2099 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2100 RADIO items, but is not available on NT 3.51 and earlier. */
2101 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2102 info
.fType
= MFT_RADIOCHECK
;
2103 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2105 set_menu_item_info (menu
,
2106 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2110 return return_value
;
2113 /* Construct native Windows menu(bar) based on widget_value tree. */
2115 fill_in_menu (HMENU menu
, widget_value
*wv
)
2117 int items_added
= 0;
2119 for ( ; wv
!= NULL
; wv
= wv
->next
)
2123 HMENU sub_menu
= CreatePopupMenu ();
2125 if (sub_menu
== NULL
)
2128 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2129 !add_menu_item (menu
, wv
, sub_menu
))
2131 DestroyMenu (sub_menu
);
2137 if (!add_menu_item (menu
, wv
, NULL
))
2147 /* popup_activated_flag not actually used on W32 */
2151 /* Display help string for currently pointed to menu item. Not
2152 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2155 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2157 int pane
= 0; /* NTEMACS_TODO: Set this to pane number. */
2159 HMODULE user32
= GetModuleHandle ("user32.dll");
2160 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2162 if (get_menu_item_info
)
2164 extern Lisp_Object Qmenu_item
;
2165 Lisp_Object
*first_item
;
2166 Lisp_Object pane_name
;
2167 Lisp_Object menu_object
;
2170 bzero (&info
, sizeof (info
));
2171 info
.cbSize
= sizeof (info
);
2172 info
.fMask
= MIIM_DATA
;
2173 get_menu_item_info (menu
, item
, FALSE
, &info
);
2175 first_item
= XVECTOR (menu_items
)->contents
;
2176 if (EQ (first_item
[0], Qt
))
2177 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2178 else if (EQ (first_item
[0], Qquote
))
2179 /* This shouldn't happen, see w32_menu_show. */
2180 pane_name
= build_string ("");
2182 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2184 /* (menu-item MENU-NAME PANE-NUMBER) */
2185 menu_object
= Fcons (Qmenu_item
,
2187 Fcons (make_number (pane
), Qnil
)));
2189 show_help_echo (info
.dwItemData
?
2190 build_string ((char *) info
.dwItemData
) : Qnil
,
2191 Qnil
, menu_object
, make_number (item
), 1);
2197 #endif /* HAVE_MENUS */
2201 staticpro (&menu_items
);
2204 Qdebug_on_next_call
= intern ("debug-on-next-call");
2205 staticpro (&Qdebug_on_next_call
);
2207 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2208 "Frame for which we are updating a menu.\n\
2209 The enable predicate for a menu command should check this variable.");
2210 Vmenu_updating_frame
= Qnil
;
2212 defsubr (&Sx_popup_menu
);
2214 defsubr (&Sx_popup_dialog
);