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
;
66 typedef struct _widget_value
70 /* value (meaning depend on widget type) */
72 /* keyboard equivalent. no implications for XtTranslations */
74 /* Help string or null if none. */
78 /* true if selected */
80 /* The type of a button. */
81 enum button_type button_type
;
82 /* true if menu title */
85 /* true if was edited (maintained by get_value) */
87 /* true if has changed (maintained by lw library) */
89 /* true if this widget itself has changed,
90 but not counting the other widgets found in the `next' field. */
91 change_type this_one_change
;
93 /* Contents of the sub-widgets, also selected slot for checkbox */
94 struct _widget_value
* contents
;
95 /* data passed to callback */
97 /* next one in the list */
98 struct _widget_value
* next
;
100 /* slot for the toolkit dependent part. Always initialize to NULL. */
102 /* tell us if we should free the toolkit data slot when freeing the
103 widget_value itself. */
104 Boolean free_toolkit_data
;
106 /* we resource the widget_value structures; this points to the next
107 one on the free list if this one has been deallocated.
109 struct _widget_value
*free_list
;
113 /* LocalAlloc/Free is a reasonably good allocator. */
114 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
115 #define free_widget_value(wv) LocalFree (wv)
117 /******************************************************************/
119 #define min(x,y) (((x) < (y)) ? (x) : (y))
120 #define max(x,y) (((x) > (y)) ? (x) : (y))
127 Lisp_Object Vmenu_updating_frame
;
129 Lisp_Object Qdebug_on_next_call
;
131 extern Lisp_Object Qmenu_bar
;
132 extern Lisp_Object Qmouse_click
, Qevent_kind
;
134 extern Lisp_Object QCtoggle
, QCradio
;
136 extern Lisp_Object Voverriding_local_map
;
137 extern Lisp_Object Voverriding_local_map_menu_flag
;
139 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
141 extern Lisp_Object Qmenu_bar_update_hook
;
143 void set_frame_menubar ();
145 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
146 Lisp_Object
, Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
));
148 static Lisp_Object
w32_dialog_show ();
149 static Lisp_Object
w32_menu_show ();
151 static void keymap_panes ();
152 static void single_keymap_panes ();
153 static void single_menu_item ();
154 static void list_of_panes ();
155 static void list_of_items ();
157 /* This holds a Lisp vector that holds the results of decoding
158 the keymaps or alist-of-alists that specify a menu.
160 It describes the panes and items within the panes.
162 Each pane is described by 3 elements in the vector:
163 t, the pane name, the pane's prefix key.
164 Then follow the pane's items, with 5 elements per item:
165 the item string, the enable flag, the item's value,
166 the definition, and the equivalent keyboard key's description string.
168 In some cases, multiple levels of menus may be described.
169 A single vector slot containing nil indicates the start of a submenu.
170 A single vector slot containing lambda indicates the end of a submenu.
171 The submenu follows a menu item which is the way to reach the submenu.
173 A single vector slot containing quote indicates that the
174 following items should appear on the right of a dialog box.
176 Using a Lisp vector to hold this information while we decode it
177 takes care of protecting all the data from GC. */
179 #define MENU_ITEMS_PANE_NAME 1
180 #define MENU_ITEMS_PANE_PREFIX 2
181 #define MENU_ITEMS_PANE_LENGTH 3
185 MENU_ITEMS_ITEM_NAME
= 0,
186 MENU_ITEMS_ITEM_ENABLE
,
187 MENU_ITEMS_ITEM_VALUE
,
188 MENU_ITEMS_ITEM_EQUIV_KEY
,
189 MENU_ITEMS_ITEM_DEFINITION
,
190 MENU_ITEMS_ITEM_TYPE
,
191 MENU_ITEMS_ITEM_SELECTED
,
192 MENU_ITEMS_ITEM_HELP
,
193 MENU_ITEMS_ITEM_LENGTH
196 static Lisp_Object menu_items
;
198 /* Number of slots currently allocated in menu_items. */
199 static int menu_items_allocated
;
201 /* This is the index in menu_items of the first empty slot. */
202 static int menu_items_used
;
204 /* The number of panes currently recorded in menu_items,
205 excluding those within submenus. */
206 static int menu_items_n_panes
;
208 /* Current depth within submenus. */
209 static int menu_items_submenu_depth
;
211 /* Flag which when set indicates a dialog or menu has been posted by
212 Xt on behalf of one of the widget sets. */
213 static int popup_activated_flag
;
215 static int next_menubar_widget_id
;
217 /* This is set nonzero after the user activates the menu bar, and set
218 to zero again after the menu bars are redisplayed by prepare_menu_bar.
219 While it is nonzero, all calls to set_frame_menubar go deep.
221 I don't understand why this is needed, but it does seem to be
222 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
224 int pending_menu_activation
;
227 /* Return the frame whose ->output_data.w32->menubar_widget equals
230 static struct frame
*
231 menubar_id_to_frame (id
)
234 Lisp_Object tail
, frame
;
237 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
240 if (!GC_FRAMEP (frame
))
243 if (!FRAME_WINDOW_P (f
))
245 if (f
->output_data
.w32
->menubar_widget
== id
)
251 /* Initialize the menu_items structure if we haven't already done so.
252 Also mark it as currently empty. */
257 if (NILP (menu_items
))
259 menu_items_allocated
= 60;
260 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
264 menu_items_n_panes
= 0;
265 menu_items_submenu_depth
= 0;
268 /* Call at the end of generating the data in menu_items.
269 This fills in the number of items in the last pane. */
276 /* Call when finished using the data for the current menu
280 discard_menu_items ()
282 /* Free the structure if it is especially large.
283 Otherwise, hold on to it, to save time. */
284 if (menu_items_allocated
> 200)
287 menu_items_allocated
= 0;
291 /* Make the menu_items vector twice as large. */
297 int old_size
= menu_items_allocated
;
300 menu_items_allocated
*= 2;
301 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
302 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
303 old_size
* sizeof (Lisp_Object
));
306 /* Begin a submenu. */
309 push_submenu_start ()
311 if (menu_items_used
+ 1 > menu_items_allocated
)
314 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
315 menu_items_submenu_depth
++;
323 if (menu_items_used
+ 1 > menu_items_allocated
)
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
327 menu_items_submenu_depth
--;
330 /* Indicate boundary between left and right. */
333 push_left_right_boundary ()
335 if (menu_items_used
+ 1 > menu_items_allocated
)
338 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
341 /* Start a new menu pane in menu_items..
342 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
345 push_menu_pane (name
, prefix_vec
)
346 Lisp_Object name
, prefix_vec
;
348 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
351 if (menu_items_submenu_depth
== 0)
352 menu_items_n_panes
++;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
358 /* Push one menu item into the current pane. NAME is the string to
359 display. ENABLE if non-nil means this item can be selected. KEY
360 is the key generated by choosing this item, or nil if this item
361 doesn't really have a definition. DEF is the definition of this
362 item. EQUIV is the textual description of the keyboard equivalent
363 for this item (or nil if none). TYPE is the type of this menu
364 item, one of nil, `toggle' or `radio'. */
367 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
368 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
370 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
378 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
379 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
380 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
383 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
384 and generate menu panes for them in menu_items.
385 If NOTREAL is nonzero,
386 don't bother really computing whether an item is enabled. */
389 keymap_panes (keymaps
, nmaps
, notreal
)
390 Lisp_Object
*keymaps
;
398 /* Loop over the given keymaps, making a pane for each map.
399 But don't make a pane that is empty--ignore that map instead.
400 P is the number of panes we have made so far. */
401 for (mapno
= 0; mapno
< nmaps
; mapno
++)
402 single_keymap_panes (keymaps
[mapno
],
403 map_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
405 finish_menu_items ();
408 /* This is a recursive subroutine of keymap_panes.
409 It handles one keymap, KEYMAP.
410 The other arguments are passed along
411 or point to local variables of the previous function.
412 If NOTREAL is nonzero, only check for equivalent key bindings, don't
413 evaluate expressions in menu items and don't make any menu.
415 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
418 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
420 Lisp_Object pane_name
;
425 Lisp_Object pending_maps
= Qnil
;
426 Lisp_Object tail
, item
;
427 struct gcpro gcpro1
, gcpro2
;
432 push_menu_pane (pane_name
, prefix
);
434 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
436 GCPRO2 (keymap
, pending_maps
);
437 /* Look at each key binding, and if it is a menu item add it
441 single_menu_item (XCAR (item
), XCDR (item
),
442 &pending_maps
, notreal
, maxdepth
);
443 else if (VECTORP (item
))
445 /* Loop over the char values represented in the vector. */
446 int len
= XVECTOR (item
)->size
;
448 for (c
= 0; c
< len
; c
++)
450 Lisp_Object character
;
451 XSETFASTINT (character
, c
);
452 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
453 &pending_maps
, notreal
, maxdepth
);
459 /* Process now any submenus which want to be panes at this level. */
460 while (!NILP (pending_maps
))
462 Lisp_Object elt
, eltcdr
, string
;
463 elt
= Fcar (pending_maps
);
465 string
= XCAR (eltcdr
);
466 /* We no longer discard the @ from the beginning of the string here.
467 Instead, we do this in w32_menu_show. */
468 single_keymap_panes (Fcar (elt
), string
,
469 XCDR (eltcdr
), notreal
, maxdepth
- 1);
470 pending_maps
= Fcdr (pending_maps
);
474 /* This is a subroutine of single_keymap_panes that handles one
476 KEY is a key in a keymap and ITEM is its binding.
477 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
479 If NOTREAL is nonzero, only check for equivalent key bindings, don't
480 evaluate expressions in menu items and don't make any menu.
481 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
484 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
485 Lisp_Object key
, item
;
486 Lisp_Object
*pending_maps_ptr
;
487 int maxdepth
, notreal
;
489 Lisp_Object map
, item_string
, enabled
;
490 struct gcpro gcpro1
, gcpro2
;
493 /* Parse the menu item and leave the result in item_properties. */
495 res
= parse_menu_item (item
, notreal
, 0);
498 return; /* Not a menu item. */
500 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
504 /* We don't want to make a menu, just traverse the keymaps to
505 precompute equivalent key bindings. */
507 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
511 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
512 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
514 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
517 /* An enabled separate pane. Remember this to handle it later. */
518 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
523 push_menu_item (item_string
, enabled
, key
,
524 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
525 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
526 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
527 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
528 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
530 /* Display a submenu using the toolkit. */
531 if (! (NILP (map
) || NILP (enabled
)))
533 push_submenu_start ();
534 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
539 /* Push all the panes and items of a menu described by the
540 alist-of-alists MENU.
541 This handles old-fashioned calls to x-popup-menu. */
551 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
553 Lisp_Object elt
, pane_name
, pane_data
;
555 pane_name
= Fcar (elt
);
556 CHECK_STRING (pane_name
, 0);
557 push_menu_pane (pane_name
, Qnil
);
558 pane_data
= Fcdr (elt
);
559 CHECK_CONS (pane_data
, 0);
560 list_of_items (pane_data
);
563 finish_menu_items ();
566 /* Push the items in a single pane defined by the alist PANE. */
572 Lisp_Object tail
, item
, item1
;
574 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
578 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
579 else if (NILP (item
))
580 push_left_right_boundary ();
583 CHECK_CONS (item
, 0);
585 CHECK_STRING (item1
, 1);
586 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
591 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
592 "Pop up a deck-of-cards menu and return user's selection.\n\
593 POSITION is a position specification. This is either a mouse button event\n\
594 or a list ((XOFFSET YOFFSET) WINDOW)\n\
595 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
596 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
597 This controls the position of the center of the first line\n\
598 in the first pane of the menu, not the top left of the menu as a whole.\n\
599 If POSITION is t, it means to use the current mouse position.\n\
601 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
602 The menu items come from key bindings that have a menu string as well as\n\
603 a definition; actually, the \"definition\" in such a key binding looks like\n\
604 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
605 the keymap as a top-level element.\n\n\
606 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
607 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
609 You can also use a list of keymaps as MENU.\n\
610 Then each keymap makes a separate pane.\n\
611 When MENU is a keymap or a list of keymaps, the return value\n\
612 is a list of events.\n\n\
614 Alternatively, you can specify a menu of multiple panes\n\
615 with a list of the form (TITLE PANE1 PANE2...),\n\
616 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
617 Each ITEM is normally a cons cell (STRING . VALUE);\n\
618 but a string can appear as an item--that makes a nonselectable line\n\
620 With this form of menu, the return value is VALUE from the chosen item.\n\
622 If POSITION is nil, don't display the menu at all, just precalculate the\n\
623 cached information about equivalent key sequences.")
625 Lisp_Object position
, menu
;
627 Lisp_Object keymap
, tem
;
631 Lisp_Object selection
;
633 Lisp_Object x
, y
, window
;
639 if (! NILP (position
))
643 /* Decode the first argument: find the window and the coordinates. */
644 if (EQ (position
, Qt
)
645 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
647 /* Use the mouse's current position. */
648 FRAME_PTR new_f
= SELECTED_FRAME ();
649 Lisp_Object bar_window
;
650 enum scroll_bar_part part
;
653 if (mouse_position_hook
)
654 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
655 &part
, &x
, &y
, &time
);
657 XSETFRAME (window
, new_f
);
660 window
= selected_window
;
667 tem
= Fcar (position
);
670 window
= Fcar (Fcdr (position
));
672 y
= Fcar (Fcdr (tem
));
677 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
678 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
679 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
688 /* Decode where to put the menu. */
696 else if (WINDOWP (window
))
698 CHECK_LIVE_WINDOW (window
, 0);
699 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
701 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
702 * XFASTINT (XWINDOW (window
)->left
));
703 ypos
= (FRAME_LINE_HEIGHT (f
)
704 * XFASTINT (XWINDOW (window
)->top
));
707 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
708 but I don't want to make one now. */
709 CHECK_WINDOW (window
, 0);
714 XSETFRAME (Vmenu_updating_frame
, f
);
716 Vmenu_updating_frame
= Qnil
;
717 #endif /* HAVE_MENUS */
722 /* Decode the menu items from what was specified. */
724 keymap
= Fkeymapp (menu
);
727 tem
= Fkeymapp (Fcar (menu
));
730 /* We were given a keymap. Extract menu info from the keymap. */
732 keymap
= get_keymap (menu
);
734 /* Extract the detailed info to make one pane. */
735 keymap_panes (&menu
, 1, NILP (position
));
737 /* Search for a string appearing directly as an element of the keymap.
738 That string is the title of the menu. */
739 prompt
= map_prompt (keymap
);
740 if (NILP (title
) && !NILP (prompt
))
743 /* Make that be the pane title of the first pane. */
744 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
745 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
749 else if (!NILP (tem
))
751 /* We were given a list of keymaps. */
752 int nmaps
= XFASTINT (Flength (menu
));
754 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
759 /* The first keymap that has a prompt string
760 supplies the menu title. */
761 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
765 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
767 prompt
= map_prompt (keymap
);
768 if (NILP (title
) && !NILP (prompt
))
772 /* Extract the detailed info to make one pane. */
773 keymap_panes (maps
, nmaps
, NILP (position
));
775 /* Make the title be the pane title of the first pane. */
776 if (!NILP (title
) && menu_items_n_panes
>= 0)
777 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
783 /* We were given an old-fashioned menu. */
785 CHECK_STRING (title
, 1);
787 list_of_panes (Fcdr (menu
));
794 discard_menu_items ();
800 /* Display them in a menu. */
803 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
804 keymaps
, title
, &error_name
);
807 discard_menu_items ();
810 #endif /* HAVE_MENUS */
812 if (error_name
) error (error_name
);
818 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
819 "Pop up a dialog box and return user's selection.\n\
820 POSITION specifies which frame to use.\n\
821 This is normally a mouse button event or a window or frame.\n\
822 If POSITION is t, it means to use the frame the mouse is on.\n\
823 The dialog box appears in the middle of the specified frame.\n\
825 CONTENTS specifies the alternatives to display in the dialog box.\n\
826 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
827 Each ITEM is a cons cell (STRING . VALUE).\n\
828 The return value is VALUE from the chosen item.\n\n\
829 An ITEM may also be just a string--that makes a nonselectable item.\n\
830 An ITEM may also be nil--that means to put all preceding items\n\
831 on the left of the dialog box and all following items on the right.\n\
832 \(By default, approximately half appear on each side.)")
834 Lisp_Object position
, contents
;
841 /* Decode the first argument: find the window or frame to use. */
842 if (EQ (position
, Qt
)
843 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
845 #if 0 /* Using the frame the mouse is on may not be right. */
846 /* Use the mouse's current position. */
847 FRAME_PTR new_f
= SELECTED_FRAME ();
848 Lisp_Object bar_window
;
849 enum scroll_bar_part part
;
853 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
856 XSETFRAME (window
, new_f
);
858 window
= selected_window
;
860 window
= selected_window
;
862 else if (CONSP (position
))
865 tem
= Fcar (position
);
867 window
= Fcar (Fcdr (position
));
870 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
871 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
874 else if (WINDOWP (position
) || FRAMEP (position
))
879 /* Decode where to put the menu. */
883 else if (WINDOWP (window
))
885 CHECK_LIVE_WINDOW (window
, 0);
886 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
889 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
890 but I don't want to make one now. */
891 CHECK_WINDOW (window
, 0);
894 /* Display a menu with these alternatives
895 in the middle of frame F. */
897 Lisp_Object x
, y
, frame
, newpos
;
898 XSETFRAME (frame
, f
);
899 XSETINT (x
, x_pixel_width (f
) / 2);
900 XSETINT (y
, x_pixel_height (f
) / 2);
901 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
903 return Fx_popup_menu (newpos
,
904 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
906 #else /* HAVE_DIALOGS */
910 Lisp_Object selection
;
912 /* Decode the dialog items from what was specified. */
913 title
= Fcar (contents
);
914 CHECK_STRING (title
, 1);
916 list_of_panes (Fcons (contents
, Qnil
));
918 /* Display them in a dialog box. */
920 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
923 discard_menu_items ();
925 if (error_name
) error (error_name
);
928 #endif /* HAVE_DIALOGS */
931 /* Activate the menu bar of frame F.
932 This is called from keyboard.c when it gets the
933 menu_bar_activate_event out of the Emacs event queue.
935 To activate the menu bar, we signal to the input thread that it can
936 return from the WM_INITMENU message, allowing the normal Windows
937 processing of the menus.
939 But first we recompute the menu bar contents (the whole tree).
941 This way we can safely execute Lisp code. */
944 x_activate_menubar (f
)
947 set_frame_menubar (f
, 0, 1);
949 /* Lock out further menubar changes while active. */
950 f
->output_data
.w32
->menubar_active
= 1;
952 /* Signal input thread to return from WM_INITMENU. */
953 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
956 /* This callback is called from the menu bar pulldown menu
957 when the user makes a selection.
958 Figure out what the user chose
959 and put the appropriate events into the keyboard buffer. */
962 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
964 Lisp_Object prefix
, entry
;
966 Lisp_Object
*subprefix_stack
;
967 int submenu_depth
= 0;
972 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
973 vector
= f
->menu_bar_vector
;
976 while (i
< f
->menu_bar_items_used
)
978 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
980 subprefix_stack
[submenu_depth
++] = prefix
;
984 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
986 prefix
= subprefix_stack
[--submenu_depth
];
989 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
991 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
992 i
+= MENU_ITEMS_PANE_LENGTH
;
996 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
997 /* The EMACS_INT cast avoids a warning. There's no problem
998 as long as pointers have enough bits to hold small integers. */
999 if ((int) (EMACS_INT
) client_data
== i
)
1002 struct input_event buf
;
1005 XSETFRAME (frame
, f
);
1006 buf
.kind
= MENU_BAR_EVENT
;
1007 buf
.frame_or_window
= frame
;
1009 kbd_buffer_store_event (&buf
);
1011 for (j
= 0; j
< submenu_depth
; j
++)
1012 if (!NILP (subprefix_stack
[j
]))
1014 buf
.kind
= MENU_BAR_EVENT
;
1015 buf
.frame_or_window
= frame
;
1016 buf
.arg
= subprefix_stack
[j
];
1017 kbd_buffer_store_event (&buf
);
1022 buf
.kind
= MENU_BAR_EVENT
;
1023 buf
.frame_or_window
= frame
;
1025 kbd_buffer_store_event (&buf
);
1028 buf
.kind
= MENU_BAR_EVENT
;
1029 buf
.frame_or_window
= frame
;
1031 kbd_buffer_store_event (&buf
);
1035 i
+= MENU_ITEMS_ITEM_LENGTH
;
1040 /* Allocate a widget_value, blocking input. */
1043 xmalloc_widget_value ()
1045 widget_value
*value
;
1048 value
= malloc_widget_value ();
1054 /* This recursively calls free_widget_value on the tree of widgets.
1055 It must free all data that was malloc'ed for these widget_values.
1056 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1057 must be left alone. */
1060 free_menubar_widget_value_tree (wv
)
1065 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1067 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1069 free_menubar_widget_value_tree (wv
->contents
);
1070 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1074 free_menubar_widget_value_tree (wv
->next
);
1075 wv
->next
= (widget_value
*) 0xDEADBEEF;
1078 free_widget_value (wv
);
1082 /* Return a tree of widget_value structures for a menu bar item
1083 whose event type is ITEM_KEY (with string ITEM_NAME)
1084 and whose contents come from the list of keymaps MAPS. */
1086 static widget_value
*
1087 single_submenu (item_key
, item_name
, maps
)
1088 Lisp_Object item_key
, item_name
, maps
;
1090 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1092 int submenu_depth
= 0;
1095 Lisp_Object
*mapvec
;
1096 widget_value
**submenu_stack
;
1097 int previous_items
= menu_items_used
;
1098 int top_level_items
= 0;
1100 length
= Flength (maps
);
1101 len
= XINT (length
);
1103 /* Convert the list MAPS into a vector MAPVEC. */
1104 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1105 for (i
= 0; i
< len
; i
++)
1107 mapvec
[i
] = Fcar (maps
);
1111 menu_items_n_panes
= 0;
1113 /* Loop over the given keymaps, making a pane for each map.
1114 But don't make a pane that is empty--ignore that map instead. */
1115 for (i
= 0; i
< len
; i
++)
1117 if (SYMBOLP (mapvec
[i
])
1118 || (CONSP (mapvec
[i
])
1119 && NILP (Fkeymapp (mapvec
[i
]))))
1121 /* Here we have a command at top level in the menu bar
1122 as opposed to a submenu. */
1123 top_level_items
= 1;
1124 push_menu_pane (Qnil
, Qnil
);
1125 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1126 Qnil
, Qnil
, Qnil
, Qnil
);
1129 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1132 /* Create a tree of widget_value objects
1133 representing the panes and their items. */
1136 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1137 wv
= xmalloc_widget_value ();
1141 wv
->button_type
= BUTTON_TYPE_NONE
;
1146 /* Loop over all panes and items made during this call
1147 and construct a tree of widget_value objects.
1148 Ignore the panes and items made by previous calls to
1149 single_submenu, even though those are also in menu_items. */
1151 while (i
< menu_items_used
)
1153 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1155 submenu_stack
[submenu_depth
++] = save_wv
;
1160 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1163 save_wv
= submenu_stack
[--submenu_depth
];
1166 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1167 && submenu_depth
!= 0)
1168 i
+= MENU_ITEMS_PANE_LENGTH
;
1169 /* Ignore a nil in the item list.
1170 It's meaningful only for dialog boxes. */
1171 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1173 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1175 /* Create a new pane. */
1176 Lisp_Object pane_name
, prefix
;
1178 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1179 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1180 #ifndef HAVE_MULTILINGUAL_MENU
1181 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1182 pane_name
= ENCODE_SYSTEM (pane_name
);
1184 pane_string
= (NILP (pane_name
)
1185 ? "" : (char *) XSTRING (pane_name
)->data
);
1186 /* If there is just one top-level pane, put all its items directly
1187 under the top-level menu. */
1188 if (menu_items_n_panes
== 1)
1191 /* If the pane has a meaningful name,
1192 make the pane a top-level menu item
1193 with its items as a submenu beneath it. */
1194 if (strcmp (pane_string
, ""))
1196 wv
= xmalloc_widget_value ();
1200 first_wv
->contents
= wv
;
1201 wv
->name
= pane_string
;
1202 /* Ignore the @ that means "separate pane".
1203 This is a kludge, but this isn't worth more time. */
1204 if (!NILP (prefix
) && wv
->name
[0] == '@')
1208 wv
->button_type
= BUTTON_TYPE_NONE
;
1212 i
+= MENU_ITEMS_PANE_LENGTH
;
1216 /* Create a new item within current pane. */
1217 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1220 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1221 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1223 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1224 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1225 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1226 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1227 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1229 #ifndef HAVE_MULTILINGUAL_MENU
1230 if (STRING_MULTIBYTE (item_name
))
1231 item_name
= ENCODE_SYSTEM (item_name
);
1232 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1233 descrip
= ENCODE_SYSTEM (descrip
);
1236 wv
= xmalloc_widget_value ();
1240 save_wv
->contents
= wv
;
1242 wv
->name
= (char *) XSTRING (item_name
)->data
;
1243 if (!NILP (descrip
))
1244 wv
->key
= (char *) XSTRING (descrip
)->data
;
1246 /* The EMACS_INT cast avoids a warning. There's no problem
1247 as long as pointers have enough bits to hold small integers. */
1248 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1249 wv
->enabled
= !NILP (enable
);
1252 wv
->button_type
= BUTTON_TYPE_NONE
;
1253 else if (EQ (type
, QCradio
))
1254 wv
->button_type
= BUTTON_TYPE_RADIO
;
1255 else if (EQ (type
, QCtoggle
))
1256 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1260 wv
->selected
= !NILP (selected
);
1262 wv
->help
= (char *) XSTRING (help
)->data
;
1268 i
+= MENU_ITEMS_ITEM_LENGTH
;
1272 /* If we have just one "menu item"
1273 that was originally a button, return it by itself. */
1274 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1276 wv
= first_wv
->contents
;
1277 free_widget_value (first_wv
);
1284 /* Set the contents of the menubar widgets of frame F.
1285 The argument FIRST_TIME is currently ignored;
1286 it is set the first time this is called, from initialize_frame_menubar. */
1289 set_frame_menubar (f
, first_time
, deep_p
)
1294 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1296 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1299 /* We must not change the menubar when actually in use. */
1300 if (f
->output_data
.w32
->menubar_active
)
1303 XSETFRAME (Vmenu_updating_frame
, f
);
1305 if (! menubar_widget
)
1307 else if (pending_menu_activation
&& !deep_p
)
1310 wv
= xmalloc_widget_value ();
1311 wv
->name
= "menubar";
1314 wv
->button_type
= BUTTON_TYPE_NONE
;
1319 /* Make a widget-value tree representing the entire menu trees. */
1321 struct buffer
*prev
= current_buffer
;
1323 int specpdl_count
= specpdl_ptr
- specpdl
;
1324 int previous_menu_items_used
= f
->menu_bar_items_used
;
1325 Lisp_Object
*previous_items
1326 = (Lisp_Object
*) alloca (previous_menu_items_used
1327 * sizeof (Lisp_Object
));
1329 /* If we are making a new widget, its contents are empty,
1330 do always reinitialize them. */
1331 if (! menubar_widget
)
1332 previous_menu_items_used
= 0;
1334 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1335 specbind (Qinhibit_quit
, Qt
);
1336 /* Don't let the debugger step into this code
1337 because it is not reentrant. */
1338 specbind (Qdebug_on_next_call
, Qnil
);
1340 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1341 if (NILP (Voverriding_local_map_menu_flag
))
1343 specbind (Qoverriding_terminal_local_map
, Qnil
);
1344 specbind (Qoverriding_local_map
, Qnil
);
1347 set_buffer_internal_1 (XBUFFER (buffer
));
1349 /* Run the Lucid hook. */
1350 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1351 /* If it has changed current-menubar from previous value,
1352 really recompute the menubar from the value. */
1353 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1354 call0 (Qrecompute_lucid_menubar
);
1355 safe_run_hooks (Qmenu_bar_update_hook
);
1356 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1358 items
= FRAME_MENU_BAR_ITEMS (f
);
1360 inhibit_garbage_collection ();
1362 /* Save the frame's previous menu bar contents data. */
1363 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1364 previous_menu_items_used
* sizeof (Lisp_Object
));
1366 /* Fill in the current menu bar contents. */
1367 menu_items
= f
->menu_bar_vector
;
1368 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1370 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1372 Lisp_Object key
, string
, maps
;
1374 key
= XVECTOR (items
)->contents
[i
];
1375 string
= XVECTOR (items
)->contents
[i
+ 1];
1376 maps
= XVECTOR (items
)->contents
[i
+ 2];
1380 wv
= single_submenu (key
, string
, maps
);
1384 first_wv
->contents
= wv
;
1385 /* Don't set wv->name here; GC during the loop might relocate it. */
1387 wv
->button_type
= BUTTON_TYPE_NONE
;
1391 finish_menu_items ();
1393 set_buffer_internal_1 (prev
);
1394 unbind_to (specpdl_count
, Qnil
);
1396 /* If there has been no change in the Lisp-level contents
1397 of the menu bar, skip redisplaying it. Just exit. */
1399 for (i
= 0; i
< previous_menu_items_used
; i
++)
1400 if (menu_items_used
== i
1401 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1403 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1405 free_menubar_widget_value_tree (first_wv
);
1411 /* Now GC cannot happen during the lifetime of the widget_value,
1412 so it's safe to store data from a Lisp_String. */
1413 wv
= first_wv
->contents
;
1414 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1417 string
= XVECTOR (items
)->contents
[i
+ 1];
1420 wv
->name
= (char *) XSTRING (string
)->data
;
1424 f
->menu_bar_vector
= menu_items
;
1425 f
->menu_bar_items_used
= menu_items_used
;
1430 /* Make a widget-value tree containing
1431 just the top level menu bar strings. */
1433 items
= FRAME_MENU_BAR_ITEMS (f
);
1434 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1438 string
= XVECTOR (items
)->contents
[i
+ 1];
1442 wv
= xmalloc_widget_value ();
1443 wv
->name
= (char *) XSTRING (string
)->data
;
1446 wv
->button_type
= BUTTON_TYPE_NONE
;
1447 /* This prevents lwlib from assuming this
1448 menu item is really supposed to be empty. */
1449 /* The EMACS_INT cast avoids a warning.
1450 This value just has to be different from small integers. */
1451 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1456 first_wv
->contents
= wv
;
1460 /* Forget what we thought we knew about what is in the
1461 detailed contents of the menu bar menus.
1462 Changing the top level always destroys the contents. */
1463 f
->menu_bar_items_used
= 0;
1466 /* Create or update the menu bar widget. */
1472 /* Empty current menubar, rather than creating a fresh one. */
1473 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1478 menubar_widget
= CreateMenu ();
1480 fill_in_menu (menubar_widget
, first_wv
->contents
);
1482 free_menubar_widget_value_tree (first_wv
);
1485 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1487 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1488 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1489 /* Causes flicker when menu bar is updated
1490 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1492 /* Force the window size to be recomputed so that the frame's text
1493 area remains the same, if menubar has just been created. */
1494 if (old_widget
== NULL
)
1495 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1501 /* Called from Fx_create_frame to create the initial menubar of a frame
1502 before it is mapped, so that the window is mapped with the menubar already
1503 there instead of us tacking it on later and thrashing the window after it
1507 initialize_frame_menubar (f
)
1510 /* This function is called before the first chance to redisplay
1511 the frame. It has to be, so the frame will have the right size. */
1512 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1513 set_frame_menubar (f
, 1, 1);
1516 /* Get rid of the menu bar of frame F, and free its storage.
1517 This is used when deleting a frame, and when turning off the menu bar. */
1520 free_frame_menubar (f
)
1526 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1527 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1528 f
->output_data
.w32
->menubar_widget
= NULL
;
1536 /* w32_menu_show actually displays a menu using the panes and items in
1537 menu_items and returns the value selected from it; we assume input
1538 is blocked by the caller. */
1540 /* F is the frame the menu is for.
1541 X and Y are the frame-relative specified position,
1542 relative to the inside upper left corner of the frame F.
1543 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1544 KEYMAPS is 1 if this menu was specified with keymaps;
1545 in that case, we return a list containing the chosen item's value
1546 and perhaps also the pane's prefix.
1547 TITLE is the specified menu title.
1548 ERROR is a place to store an error message string in case of failure.
1549 (We return nil on failure, but the value doesn't actually matter.) */
1552 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1562 int menu_item_selection
;
1565 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1566 widget_value
**submenu_stack
1567 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1568 Lisp_Object
*subprefix_stack
1569 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1570 int submenu_depth
= 0;
1572 int next_release_must_exit
= 0;
1576 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1578 *error
= "Empty menu";
1582 /* Create a tree of widget_value objects
1583 representing the panes and their items. */
1584 wv
= xmalloc_widget_value ();
1588 wv
->button_type
= BUTTON_TYPE_NONE
;
1592 /* Loop over all panes and items, filling in the tree. */
1594 while (i
< menu_items_used
)
1596 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1598 submenu_stack
[submenu_depth
++] = save_wv
;
1604 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1607 save_wv
= submenu_stack
[--submenu_depth
];
1611 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1612 && submenu_depth
!= 0)
1613 i
+= MENU_ITEMS_PANE_LENGTH
;
1614 /* Ignore a nil in the item list.
1615 It's meaningful only for dialog boxes. */
1616 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1618 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1620 /* Create a new pane. */
1621 Lisp_Object pane_name
, prefix
;
1623 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1624 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1625 #ifndef HAVE_MULTILINGUAL_MENU
1626 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1627 pane_name
= ENCODE_SYSTEM (pane_name
);
1629 pane_string
= (NILP (pane_name
)
1630 ? "" : (char *) XSTRING (pane_name
)->data
);
1631 /* If there is just one top-level pane, put all its items directly
1632 under the top-level menu. */
1633 if (menu_items_n_panes
== 1)
1636 /* If the pane has a meaningful name,
1637 make the pane a top-level menu item
1638 with its items as a submenu beneath it. */
1639 if (!keymaps
&& strcmp (pane_string
, ""))
1641 wv
= xmalloc_widget_value ();
1645 first_wv
->contents
= wv
;
1646 wv
->name
= pane_string
;
1647 if (keymaps
&& !NILP (prefix
))
1651 wv
->button_type
= BUTTON_TYPE_NONE
;
1655 else if (first_pane
)
1661 i
+= MENU_ITEMS_PANE_LENGTH
;
1665 /* Create a new item within current pane. */
1666 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1668 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1669 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1671 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1672 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1673 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1674 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1675 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1677 #ifndef HAVE_MULTILINGUAL_MENU
1678 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1679 item_name
= ENCODE_SYSTEM (item_name
);
1680 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1681 descrip
= ENCODE_SYSTEM (descrip
);
1684 wv
= xmalloc_widget_value ();
1688 save_wv
->contents
= wv
;
1689 wv
->name
= (char *) XSTRING (item_name
)->data
;
1690 if (!NILP (descrip
))
1691 wv
->key
= (char *) XSTRING (descrip
)->data
;
1693 /* Use the contents index as call_data, since we are
1694 restricted to 16-bits.. */
1695 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1696 wv
->enabled
= !NILP (enable
);
1699 wv
->button_type
= BUTTON_TYPE_NONE
;
1700 else if (EQ (type
, QCtoggle
))
1701 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1702 else if (EQ (type
, QCradio
))
1703 wv
->button_type
= BUTTON_TYPE_RADIO
;
1707 wv
->selected
= !NILP (selected
);
1710 wv
->help
= (char *) XSTRING (help
)->data
;
1716 i
+= MENU_ITEMS_ITEM_LENGTH
;
1720 /* Deal with the title, if it is non-nil. */
1723 widget_value
*wv_title
= xmalloc_widget_value ();
1724 widget_value
*wv_sep
= xmalloc_widget_value ();
1726 /* Maybe replace this separator with a bitmap or owner-draw item
1727 so that it looks better. Having two separators looks odd. */
1728 wv_sep
->name
= "--";
1729 wv_sep
->next
= first_wv
->contents
;
1731 #ifndef HAVE_MULTILINGUAL_MENU
1732 if (STRING_MULTIBYTE (title
))
1733 title
= ENCODE_SYSTEM (title
);
1735 wv_title
->name
= (char *) XSTRING (title
)->data
;
1736 wv_title
->enabled
= True
;
1737 wv_title
->title
= True
;
1738 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1739 wv_title
->next
= wv_sep
;
1740 first_wv
->contents
= wv_title
;
1743 /* Actually create the menu. */
1744 menu
= CreatePopupMenu ();
1745 fill_in_menu (menu
, first_wv
->contents
);
1747 /* Adjust coordinates to be root-window-relative. */
1750 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1752 /* No selection has been chosen yet. */
1753 menu_item_selection
= 0;
1755 /* Display the menu. */
1756 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1757 WM_EMACS_TRACKPOPUPMENU
,
1758 (WPARAM
)menu
, (LPARAM
)&pos
);
1760 /* Clean up extraneous mouse events which might have been generated
1762 discard_mouse_events ();
1764 /* Free the widget_value objects we used to specify the contents. */
1765 free_menubar_widget_value_tree (first_wv
);
1769 /* Find the selected item, and its pane, to return
1770 the proper value. */
1771 if (menu_item_selection
!= 0)
1773 Lisp_Object prefix
, entry
;
1777 while (i
< menu_items_used
)
1779 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1781 subprefix_stack
[submenu_depth
++] = prefix
;
1785 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1787 prefix
= subprefix_stack
[--submenu_depth
];
1790 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1793 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1794 i
+= MENU_ITEMS_PANE_LENGTH
;
1796 /* Ignore a nil in the item list.
1797 It's meaningful only for dialog boxes. */
1798 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1803 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1804 if (menu_item_selection
== i
)
1810 entry
= Fcons (entry
, Qnil
);
1812 entry
= Fcons (prefix
, entry
);
1813 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1814 if (!NILP (subprefix_stack
[j
]))
1815 entry
= Fcons (subprefix_stack
[j
], entry
);
1819 i
+= MENU_ITEMS_ITEM_LENGTH
;
1828 static char * button_names
[] = {
1829 "button1", "button2", "button3", "button4", "button5",
1830 "button6", "button7", "button8", "button9", "button10" };
1833 w32_dialog_show (f
, keymaps
, title
, error
)
1839 int i
, nb_buttons
=0;
1840 char dialog_name
[6];
1841 int menu_item_selection
;
1843 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1845 /* Number of elements seen so far, before boundary. */
1847 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1848 int boundary_seen
= 0;
1852 if (menu_items_n_panes
> 1)
1854 *error
= "Multiple panes in dialog box";
1858 /* Create a tree of widget_value objects
1859 representing the text label and buttons. */
1861 Lisp_Object pane_name
, prefix
;
1863 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1864 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1865 pane_string
= (NILP (pane_name
)
1866 ? "" : (char *) XSTRING (pane_name
)->data
);
1867 prev_wv
= xmalloc_widget_value ();
1868 prev_wv
->value
= pane_string
;
1869 if (keymaps
&& !NILP (prefix
))
1871 prev_wv
->enabled
= 1;
1872 prev_wv
->name
= "message";
1875 /* Loop over all panes and items, filling in the tree. */
1876 i
= MENU_ITEMS_PANE_LENGTH
;
1877 while (i
< menu_items_used
)
1880 /* Create a new item within current pane. */
1881 Lisp_Object item_name
, enable
, descrip
, help
;
1883 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1884 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1886 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1887 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1889 if (NILP (item_name
))
1891 free_menubar_widget_value_tree (first_wv
);
1892 *error
= "Submenu in dialog items";
1895 if (EQ (item_name
, Qquote
))
1897 /* This is the boundary between left-side elts
1898 and right-side elts. Stop incrementing right_count. */
1903 if (nb_buttons
>= 9)
1905 free_menubar_widget_value_tree (first_wv
);
1906 *error
= "Too many dialog items";
1910 wv
= xmalloc_widget_value ();
1912 wv
->name
= (char *) button_names
[nb_buttons
];
1913 if (!NILP (descrip
))
1914 wv
->key
= (char *) XSTRING (descrip
)->data
;
1915 wv
->value
= (char *) XSTRING (item_name
)->data
;
1916 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1917 wv
->enabled
= !NILP (enable
);
1920 if (! boundary_seen
)
1924 i
+= MENU_ITEMS_ITEM_LENGTH
;
1927 /* If the boundary was not specified,
1928 by default put half on the left and half on the right. */
1929 if (! boundary_seen
)
1930 left_count
= nb_buttons
- nb_buttons
/ 2;
1932 wv
= xmalloc_widget_value ();
1933 wv
->name
= dialog_name
;
1935 /* Dialog boxes use a really stupid name encoding
1936 which specifies how many buttons to use
1937 and how many buttons are on the right.
1938 The Q means something also. */
1939 dialog_name
[0] = 'Q';
1940 dialog_name
[1] = '0' + nb_buttons
;
1941 dialog_name
[2] = 'B';
1942 dialog_name
[3] = 'R';
1943 /* Number of buttons to put on the right. */
1944 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1946 wv
->contents
= first_wv
;
1950 /* Actually create the dialog. */
1952 dialog_id
= widget_id_tick
++;
1953 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1954 f
->output_data
.w32
->widget
, 1, 0,
1955 dialog_selection_callback
, 0);
1956 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1959 /* Free the widget_value objects we used to specify the contents. */
1960 free_menubar_widget_value_tree (first_wv
);
1962 /* No selection has been chosen yet. */
1963 menu_item_selection
= 0;
1965 /* Display the menu. */
1967 lw_pop_up_all_widgets (dialog_id
);
1968 popup_activated_flag
= 1;
1970 /* Process events that apply to the menu. */
1971 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1973 lw_destroy_all_widgets (dialog_id
);
1976 /* Find the selected item, and its pane, to return
1977 the proper value. */
1978 if (menu_item_selection
!= 0)
1984 while (i
< menu_items_used
)
1988 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1991 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1992 i
+= MENU_ITEMS_PANE_LENGTH
;
1997 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1998 if (menu_item_selection
== i
)
2002 entry
= Fcons (entry
, Qnil
);
2004 entry
= Fcons (prefix
, entry
);
2008 i
+= MENU_ITEMS_ITEM_LENGTH
;
2017 /* Is this item a separator? */
2019 name_is_separator (name
)
2022 /* Check if name string consists of only dashes ('-') */
2023 while (*name
== '-') name
++;
2024 return (*name
== '\0');
2028 /* Indicate boundary between left and right. */
2030 add_left_right_boundary (HMENU menu
)
2032 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2036 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2042 if (name_is_separator (wv
->name
))
2043 fuFlags
= MF_SEPARATOR
;
2047 fuFlags
= MF_STRING
;
2049 fuFlags
= MF_STRING
| MF_GRAYED
;
2051 if (wv
->key
!= NULL
)
2053 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2054 strcpy (out_string
, wv
->name
);
2055 strcat (out_string
, "\t");
2056 strcat (out_string
, wv
->key
);
2059 out_string
= wv
->name
;
2063 #if 0 /* no GC while popup menu is active */
2064 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2065 strcpy (out_string
, wv
->name
);
2067 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2070 /* Draw radio buttons and tickboxes. */
2072 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2073 wv
->button_type
== BUTTON_TYPE_RADIO
))
2074 fuFlags
|= MF_CHECKED
;
2076 fuFlags
|= MF_UNCHECKED
;
2085 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2086 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2088 /* This must be done after the menu item is created. */
2090 HMODULE user32
= GetModuleHandle ("user32.dll");
2091 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2093 if (set_menu_item_info
)
2096 bzero (&info
, sizeof (info
));
2097 info
.cbSize
= sizeof (info
);
2098 info
.fMask
= MIIM_DATA
;
2099 /* Set help string for menu item. */
2100 info
.dwItemData
= (DWORD
)wv
->help
;
2102 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2104 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2105 RADIO items, but is not available on NT 3.51 and earlier. */
2106 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2107 info
.fType
= MFT_RADIOCHECK
;
2108 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2110 set_menu_item_info (menu
,
2111 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2115 return return_value
;
2118 /* Construct native Windows menu(bar) based on widget_value tree. */
2120 fill_in_menu (HMENU menu
, widget_value
*wv
)
2122 int items_added
= 0;
2124 for ( ; wv
!= NULL
; wv
= wv
->next
)
2128 HMENU sub_menu
= CreatePopupMenu ();
2130 if (sub_menu
== NULL
)
2133 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2134 !add_menu_item (menu
, wv
, sub_menu
))
2136 DestroyMenu (sub_menu
);
2142 if (!add_menu_item (menu
, wv
, NULL
))
2152 /* popup_activated_flag not actually used on W32 */
2156 /* Display help string for currently pointed to menu item. Not
2157 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2160 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2162 int pane
= 0; /* NTEMACS_TODO: Set this to pane number. */
2164 HMODULE user32
= GetModuleHandle ("user32.dll");
2165 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2167 if (get_menu_item_info
)
2169 extern Lisp_Object Qmenu_item
;
2170 Lisp_Object
*first_item
;
2171 Lisp_Object pane_name
;
2172 Lisp_Object menu_object
;
2175 bzero (&info
, sizeof (info
));
2176 info
.cbSize
= sizeof (info
);
2177 info
.fMask
= MIIM_DATA
;
2178 get_menu_item_info (menu
, item
, FALSE
, &info
);
2180 first_item
= XVECTOR (menu_items
)->contents
;
2181 if (EQ (first_item
[0], Qt
))
2182 pane_name
= first_item
[MENU_ITEMS_PANE_NAME
];
2183 else if (EQ (first_item
[0], Qquote
))
2184 /* This shouldn't happen, see w32_menu_show. */
2185 pane_name
= build_string ("");
2187 pane_name
= first_item
[MENU_ITEMS_ITEM_NAME
];
2189 /* (menu-item MENU-NAME PANE-NUMBER) */
2190 menu_object
= Fcons (Qmenu_item
,
2192 Fcons (make_number (pane
), Qnil
)));
2194 show_help_echo (info
.dwItemData
?
2195 build_string ((char *) info
.dwItemData
) : Qnil
,
2196 Qnil
, menu_object
, make_number (item
), 1);
2202 #endif /* HAVE_MENUS */
2206 staticpro (&menu_items
);
2209 Qdebug_on_next_call
= intern ("debug-on-next-call");
2210 staticpro (&Qdebug_on_next_call
);
2212 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2213 "Frame for which we are updating a menu.\n\
2214 The enable predicate for a menu command should check this variable.");
2215 Vmenu_updating_frame
= Qnil
;
2217 defsubr (&Sx_popup_menu
);
2219 defsubr (&Sx_popup_dialog
);