1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
26 #include "termhooks.h"
30 #include "blockinput.h"
33 /* This may include sys/types.h, and that somehow loses
34 if this is not done before the other system files. */
37 /* Load sys/types.h if not already loaded.
38 In some systems loading it twice is suicidal. */
40 #include <sys/types.h>
43 #include "dispextern.h"
45 #undef HAVE_MULTILINGUAL_MENU
46 #undef HAVE_BOXES /* NTEMACS_TODO: Fix native checkmarks and radios. */
47 #undef HAVE_DIALOGS /* NTEMACS_TODO: Fix native dialogs. */
49 /******************************************************************/
50 /* Definitions copied from lwlib.h */
52 typedef void * XtPointer
;
58 #if 0 /* Not used below. */
59 typedef enum _change_type
75 typedef struct _widget_value
79 /* value (meaning depend on widget type) */
81 /* keyboard equivalent. no implications for XtTranslations */
83 /* Help string or null if none. */
87 /* true if selected */
89 /* The type of a button. */
90 enum button_type button_type
;
91 /* true if menu title */
94 /* true if was edited (maintained by get_value) */
96 /* true if has changed (maintained by lw library) */
98 /* true if this widget itself has changed,
99 but not counting the other widgets found in the `next' field. */
100 change_type this_one_change
;
102 /* Contents of the sub-widgets, also selected slot for checkbox */
103 struct _widget_value
* contents
;
104 /* data passed to callback */
106 /* next one in the list */
107 struct _widget_value
* next
;
109 /* slot for the toolkit dependent part. Always initialize to NULL. */
111 /* tell us if we should free the toolkit data slot when freeing the
112 widget_value itself. */
113 Boolean free_toolkit_data
;
115 /* we resource the widget_value structures; this points to the next
116 one on the free list if this one has been deallocated.
118 struct _widget_value
*free_list
;
122 /* LocalAlloc/Free is a reasonably good allocator. */
123 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
124 #define free_widget_value(wv) LocalFree (wv)
126 /******************************************************************/
128 #define min(x,y) (((x) < (y)) ? (x) : (y))
129 #define max(x,y) (((x) > (y)) ? (x) : (y))
136 Lisp_Object Vmenu_updating_frame
;
138 Lisp_Object Qdebug_on_next_call
;
140 extern Lisp_Object Qmenu_bar
;
141 extern Lisp_Object Qmouse_click
, Qevent_kind
;
143 extern Lisp_Object QCtoggle
, QCradio
;
145 extern Lisp_Object Voverriding_local_map
;
146 extern Lisp_Object Voverriding_local_map_menu_flag
;
148 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
150 extern Lisp_Object Qmenu_bar_update_hook
;
152 void set_frame_menubar ();
154 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
155 Lisp_Object
, Lisp_Object
, Lisp_Object
,
156 Lisp_Object
, Lisp_Object
));
157 static Lisp_Object
w32_dialog_show ();
158 static Lisp_Object
w32_menu_show ();
160 static void keymap_panes ();
161 static void single_keymap_panes ();
162 static void single_menu_item ();
163 static void list_of_panes ();
164 static void list_of_items ();
166 /* This holds a Lisp vector that holds the results of decoding
167 the keymaps or alist-of-alists that specify a menu.
169 It describes the panes and items within the panes.
171 Each pane is described by 3 elements in the vector:
172 t, the pane name, the pane's prefix key.
173 Then follow the pane's items, with 5 elements per item:
174 the item string, the enable flag, the item's value,
175 the definition, and the equivalent keyboard key's description string.
177 In some cases, multiple levels of menus may be described.
178 A single vector slot containing nil indicates the start of a submenu.
179 A single vector slot containing lambda indicates the end of a submenu.
180 The submenu follows a menu item which is the way to reach the submenu.
182 A single vector slot containing quote indicates that the
183 following items should appear on the right of a dialog box.
185 Using a Lisp vector to hold this information while we decode it
186 takes care of protecting all the data from GC. */
188 #define MENU_ITEMS_PANE_NAME 1
189 #define MENU_ITEMS_PANE_PREFIX 2
190 #define MENU_ITEMS_PANE_LENGTH 3
194 MENU_ITEMS_ITEM_NAME
= 0,
195 MENU_ITEMS_ITEM_ENABLE
,
196 MENU_ITEMS_ITEM_VALUE
,
197 MENU_ITEMS_ITEM_EQUIV_KEY
,
198 MENU_ITEMS_ITEM_DEFINITION
,
199 MENU_ITEMS_ITEM_TYPE
,
200 MENU_ITEMS_ITEM_SELECTED
,
201 MENU_ITEMS_ITEM_HELP
,
202 MENU_ITEMS_ITEM_LENGTH
205 static Lisp_Object menu_items
;
207 /* Number of slots currently allocated in menu_items. */
208 static int menu_items_allocated
;
210 /* This is the index in menu_items of the first empty slot. */
211 static int menu_items_used
;
213 /* The number of panes currently recorded in menu_items,
214 excluding those within submenus. */
215 static int menu_items_n_panes
;
217 /* Current depth within submenus. */
218 static int menu_items_submenu_depth
;
220 /* Flag which when set indicates a dialog or menu has been posted by
221 Xt on behalf of one of the widget sets. */
222 static int popup_activated_flag
;
224 static int next_menubar_widget_id
;
226 /* This is set nonzero after the user activates the menu bar, and set
227 to zero again after the menu bars are redisplayed by prepare_menu_bar.
228 While it is nonzero, all calls to set_frame_menubar go deep.
230 I don't understand why this is needed, but it does seem to be
231 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
233 int pending_menu_activation
;
236 /* Return the frame whose ->output_data.w32->menubar_widget equals
239 static struct frame
*
240 menubar_id_to_frame (id
)
243 Lisp_Object tail
, frame
;
246 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
249 if (!GC_FRAMEP (frame
))
252 if (!FRAME_WINDOW_P (f
))
254 if (f
->output_data
.w32
->menubar_widget
== id
)
260 /* Initialize the menu_items structure if we haven't already done so.
261 Also mark it as currently empty. */
266 if (NILP (menu_items
))
268 menu_items_allocated
= 60;
269 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
273 menu_items_n_panes
= 0;
274 menu_items_submenu_depth
= 0;
277 /* Call at the end of generating the data in menu_items.
278 This fills in the number of items in the last pane. */
285 /* Call when finished using the data for the current menu
289 discard_menu_items ()
291 /* Free the structure if it is especially large.
292 Otherwise, hold on to it, to save time. */
293 if (menu_items_allocated
> 200)
296 menu_items_allocated
= 0;
300 /* Make the menu_items vector twice as large. */
306 int old_size
= menu_items_allocated
;
309 menu_items_allocated
*= 2;
310 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
311 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
312 old_size
* sizeof (Lisp_Object
));
315 /* Begin a submenu. */
318 push_submenu_start ()
320 if (menu_items_used
+ 1 > menu_items_allocated
)
323 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
324 menu_items_submenu_depth
++;
332 if (menu_items_used
+ 1 > menu_items_allocated
)
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
336 menu_items_submenu_depth
--;
339 /* Indicate boundary between left and right. */
342 push_left_right_boundary ()
344 if (menu_items_used
+ 1 > menu_items_allocated
)
347 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
350 /* Start a new menu pane in menu_items..
351 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
354 push_menu_pane (name
, prefix_vec
)
355 Lisp_Object name
, prefix_vec
;
357 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
360 if (menu_items_submenu_depth
== 0)
361 menu_items_n_panes
++;
362 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
363 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
364 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
367 /* Push one menu item into the current pane. NAME is the string to
368 display. ENABLE if non-nil means this item can be selected. KEY
369 is the key generated by choosing this item, or nil if this item
370 doesn't really have a definition. DEF is the definition of this
371 item. EQUIV is the textual description of the keyboard equivalent
372 for this item (or nil if none). TYPE is the type of this menu
373 item, one of nil, `toggle' or `radio'. */
376 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
377 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
379 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
382 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
383 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
384 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
385 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
386 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
387 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
388 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
389 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
392 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
393 and generate menu panes for them in menu_items.
394 If NOTREAL is nonzero,
395 don't bother really computing whether an item is enabled. */
398 keymap_panes (keymaps
, nmaps
, notreal
)
399 Lisp_Object
*keymaps
;
407 /* Loop over the given keymaps, making a pane for each map.
408 But don't make a pane that is empty--ignore that map instead.
409 P is the number of panes we have made so far. */
410 for (mapno
= 0; mapno
< nmaps
; mapno
++)
411 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
413 finish_menu_items ();
416 /* This is a recursive subroutine of keymap_panes.
417 It handles one keymap, KEYMAP.
418 The other arguments are passed along
419 or point to local variables of the previous function.
420 If NOTREAL is nonzero, only check for equivalent key bindings, don't
421 evaluate expressions in menu items and don't make any menu.
423 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
426 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
428 Lisp_Object pane_name
;
433 Lisp_Object pending_maps
= Qnil
;
434 Lisp_Object tail
, item
;
435 struct gcpro gcpro1
, gcpro2
;
441 push_menu_pane (pane_name
, prefix
);
444 /* Remember index for first item in this pane so we can go back and
445 add a prefix when (if) we see the first button. After that, notbuttons
446 is set to 0, to mark that we have seen a button and all non button
447 items need a prefix. */
448 notbuttons
= menu_items_used
;
451 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
453 GCPRO2 (keymap
, pending_maps
);
454 /* Look at each key binding, and if it is a menu item add it
458 single_menu_item (XCAR (item
), XCDR (item
),
459 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
460 else if (VECTORP (item
))
462 /* Loop over the char values represented in the vector. */
463 int len
= XVECTOR (item
)->size
;
465 for (c
= 0; c
< len
; c
++)
467 Lisp_Object character
;
468 XSETFASTINT (character
, c
);
469 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
470 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
476 /* Process now any submenus which want to be panes at this level. */
477 while (!NILP (pending_maps
))
479 Lisp_Object elt
, eltcdr
, string
;
480 elt
= Fcar (pending_maps
);
482 string
= XCAR (eltcdr
);
483 /* We no longer discard the @ from the beginning of the string here.
484 Instead, we do this in w32_menu_show. */
485 single_keymap_panes (Fcar (elt
), string
,
486 XCDR (eltcdr
), notreal
, maxdepth
- 1);
487 pending_maps
= Fcdr (pending_maps
);
491 /* This is a subroutine of single_keymap_panes that handles one
493 KEY is a key in a keymap and ITEM is its binding.
494 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
496 If NOTREAL is nonzero, only check for equivalent key bindings, don't
497 evaluate expressions in menu items and don't make any menu.
498 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
499 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
500 buttons. It points to variable notbuttons in single_keymap_panes,
501 which keeps track of if we have seen a button in this menu or not. */
504 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
506 Lisp_Object key
, item
;
507 Lisp_Object
*pending_maps_ptr
;
508 int maxdepth
, notreal
;
511 Lisp_Object map
, item_string
, enabled
;
512 struct gcpro gcpro1
, gcpro2
;
515 /* Parse the menu item and leave the result in item_properties. */
517 res
= parse_menu_item (item
, notreal
, 0);
520 return; /* Not a menu item. */
522 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
526 /* We don't want to make a menu, just traverse the keymaps to
527 precompute equivalent key bindings. */
529 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
533 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
534 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
536 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
539 /* An enabled separate pane. Remember this to handle it later. */
540 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
546 /* Simulate radio buttons and toggle boxes by putting a prefix in
549 Lisp_Object prefix
= Qnil
;
550 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
554 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
557 /* The first button. Line up previous items in this menu. */
559 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
562 while (index
< menu_items_used
)
565 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
569 submenu
++; /* Skip sub menu. */
571 else if (EQ (tem
, Qlambda
))
574 submenu
--; /* End sub menu. */
576 else if (EQ (tem
, Qt
))
577 index
+= 3; /* Skip new pane marker. */
578 else if (EQ (tem
, Qquote
))
579 index
++; /* Skip a left, right divider. */
582 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
583 && XSTRING (tem
)->data
[0] != '-')
584 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
585 = concat2 (build_string (" "), tem
);
586 index
+= MENU_ITEMS_ITEM_LENGTH
;
592 /* Calculate prefix, if any, for this item. */
593 if (EQ (type
, QCtoggle
))
594 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
595 else if (EQ (type
, QCradio
))
596 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
598 /* Not a button. If we have earlier buttons, then we need a prefix. */
599 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
600 && XSTRING (item_string
)->data
[0] != '-')
601 prefix
= build_string (" ");
604 item_string
= concat2 (prefix
, item_string
);
606 #endif /* HAVE_BOXES */
610 /* Indicate visually that this is a submenu. */
611 item_string
= concat2 (item_string
, build_string (" >"));
614 push_menu_item (item_string
, enabled
, key
,
615 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
616 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
617 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
618 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
619 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
622 /* Display a submenu using the toolkit. */
623 if (! (NILP (map
) || NILP (enabled
)))
625 push_submenu_start ();
626 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
632 /* Push all the panes and items of a menu described by the
633 alist-of-alists MENU.
634 This handles old-fashioned calls to x-popup-menu. */
644 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
646 Lisp_Object elt
, pane_name
, pane_data
;
648 pane_name
= Fcar (elt
);
649 CHECK_STRING (pane_name
, 0);
650 push_menu_pane (pane_name
, Qnil
);
651 pane_data
= Fcdr (elt
);
652 CHECK_CONS (pane_data
, 0);
653 list_of_items (pane_data
);
656 finish_menu_items ();
659 /* Push the items in a single pane defined by the alist PANE. */
665 Lisp_Object tail
, item
, item1
;
667 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
671 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
672 else if (NILP (item
))
673 push_left_right_boundary ();
676 CHECK_CONS (item
, 0);
678 CHECK_STRING (item1
, 1);
679 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
684 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
685 "Pop up a deck-of-cards menu and return user's selection.\n\
686 POSITION is a position specification. This is either a mouse button event\n\
687 or a list ((XOFFSET YOFFSET) WINDOW)\n\
688 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
689 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
690 This controls the position of the center of the first line\n\
691 in the first pane of the menu, not the top left of the menu as a whole.\n\
692 If POSITION is t, it means to use the current mouse position.\n\
694 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
695 The menu items come from key bindings that have a menu string as well as\n\
696 a definition; actually, the \"definition\" in such a key binding looks like\n\
697 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
698 the keymap as a top-level element.\n\n\
699 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
700 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
702 You can also use a list of keymaps as MENU.\n\
703 Then each keymap makes a separate pane.\n\
704 When MENU is a keymap or a list of keymaps, the return value\n\
705 is a list of events.\n\n\
707 Alternatively, you can specify a menu of multiple panes\n\
708 with a list of the form (TITLE PANE1 PANE2...),\n\
709 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
710 Each ITEM is normally a cons cell (STRING . VALUE);\n\
711 but a string can appear as an item--that makes a nonselectable line\n\
713 With this form of menu, the return value is VALUE from the chosen item.\n\
715 If POSITION is nil, don't display the menu at all, just precalculate the\n\
716 cached information about equivalent key sequences.")
718 Lisp_Object position
, menu
;
720 Lisp_Object keymap
, tem
;
724 Lisp_Object selection
;
726 Lisp_Object x
, y
, window
;
732 if (! NILP (position
))
736 /* Decode the first argument: find the window and the coordinates. */
737 if (EQ (position
, Qt
)
738 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
740 /* Use the mouse's current position. */
741 FRAME_PTR new_f
= SELECTED_FRAME ();
742 Lisp_Object bar_window
;
743 enum scroll_bar_part part
;
746 if (mouse_position_hook
)
747 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
748 &part
, &x
, &y
, &time
);
750 XSETFRAME (window
, new_f
);
753 window
= selected_window
;
760 tem
= Fcar (position
);
763 window
= Fcar (Fcdr (position
));
765 y
= Fcar (Fcdr (tem
));
770 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
771 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
772 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
781 /* Decode where to put the menu. */
789 else if (WINDOWP (window
))
791 CHECK_LIVE_WINDOW (window
, 0);
792 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
794 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
795 * XFASTINT (XWINDOW (window
)->left
));
796 ypos
= (FRAME_LINE_HEIGHT (f
)
797 * XFASTINT (XWINDOW (window
)->top
));
800 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
801 but I don't want to make one now. */
802 CHECK_WINDOW (window
, 0);
807 XSETFRAME (Vmenu_updating_frame
, f
);
809 Vmenu_updating_frame
= Qnil
;
810 #endif /* HAVE_MENUS */
815 /* Decode the menu items from what was specified. */
817 keymap
= Fkeymapp (menu
);
820 tem
= Fkeymapp (Fcar (menu
));
823 /* We were given a keymap. Extract menu info from the keymap. */
825 keymap
= get_keymap (menu
);
827 /* Extract the detailed info to make one pane. */
828 keymap_panes (&menu
, 1, NILP (position
));
830 /* Search for a string appearing directly as an element of the keymap.
831 That string is the title of the menu. */
832 prompt
= map_prompt (keymap
);
833 if (NILP (title
) && !NILP (prompt
))
836 /* Make that be the pane title of the first pane. */
837 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
838 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
842 else if (!NILP (tem
))
844 /* We were given a list of keymaps. */
845 int nmaps
= XFASTINT (Flength (menu
));
847 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
852 /* The first keymap that has a prompt string
853 supplies the menu title. */
854 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
858 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
860 prompt
= map_prompt (keymap
);
861 if (NILP (title
) && !NILP (prompt
))
865 /* Extract the detailed info to make one pane. */
866 keymap_panes (maps
, nmaps
, NILP (position
));
868 /* Make the title be the pane title of the first pane. */
869 if (!NILP (title
) && menu_items_n_panes
>= 0)
870 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
876 /* We were given an old-fashioned menu. */
878 CHECK_STRING (title
, 1);
880 list_of_panes (Fcdr (menu
));
887 discard_menu_items ();
893 /* Display them in a menu. */
896 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
897 keymaps
, title
, &error_name
);
900 discard_menu_items ();
903 #endif /* HAVE_MENUS */
905 if (error_name
) error (error_name
);
911 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
912 "Pop up a dialog box and return user's selection.\n\
913 POSITION specifies which frame to use.\n\
914 This is normally a mouse button event or a window or frame.\n\
915 If POSITION is t, it means to use the frame the mouse is on.\n\
916 The dialog box appears in the middle of the specified frame.\n\
918 CONTENTS specifies the alternatives to display in the dialog box.\n\
919 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
920 Each ITEM is a cons cell (STRING . VALUE).\n\
921 The return value is VALUE from the chosen item.\n\n\
922 An ITEM may also be just a string--that makes a nonselectable item.\n\
923 An ITEM may also be nil--that means to put all preceding items\n\
924 on the left of the dialog box and all following items on the right.\n\
925 \(By default, approximately half appear on each side.)")
927 Lisp_Object position
, contents
;
934 /* Decode the first argument: find the window or frame to use. */
935 if (EQ (position
, Qt
)
936 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
938 #if 0 /* Using the frame the mouse is on may not be right. */
939 /* Use the mouse's current position. */
940 FRAME_PTR new_f
= SELECTED_FRAME ();
941 Lisp_Object bar_window
;
946 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
949 XSETFRAME (window
, new_f
);
951 window
= selected_window
;
953 window
= selected_window
;
955 else if (CONSP (position
))
958 tem
= Fcar (position
);
960 window
= Fcar (Fcdr (position
));
963 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
964 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
967 else if (WINDOWP (position
) || FRAMEP (position
))
972 /* Decode where to put the menu. */
976 else if (WINDOWP (window
))
978 CHECK_LIVE_WINDOW (window
, 0);
979 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
982 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
983 but I don't want to make one now. */
984 CHECK_WINDOW (window
, 0);
987 /* Display a menu with these alternatives
988 in the middle of frame F. */
990 Lisp_Object x
, y
, frame
, newpos
;
991 XSETFRAME (frame
, f
);
992 XSETINT (x
, x_pixel_width (f
) / 2);
993 XSETINT (y
, x_pixel_height (f
) / 2);
994 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
996 return Fx_popup_menu (newpos
,
997 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
999 #else /* HAVE_DIALOGS */
1003 Lisp_Object selection
;
1005 /* Decode the dialog items from what was specified. */
1006 title
= Fcar (contents
);
1007 CHECK_STRING (title
, 1);
1009 list_of_panes (Fcons (contents
, Qnil
));
1011 /* Display them in a dialog box. */
1013 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
1016 discard_menu_items ();
1018 if (error_name
) error (error_name
);
1021 #endif /* HAVE_DIALOGS */
1024 /* Activate the menu bar of frame F.
1025 This is called from keyboard.c when it gets the
1026 menu_bar_activate_event out of the Emacs event queue.
1028 To activate the menu bar, we signal to the input thread that it can
1029 return from the WM_INITMENU message, allowing the normal Windows
1030 processing of the menus.
1032 But first we recompute the menu bar contents (the whole tree).
1034 This way we can safely execute Lisp code. */
1037 x_activate_menubar (f
)
1040 set_frame_menubar (f
, 0, 1);
1042 /* Lock out further menubar changes while active. */
1043 f
->output_data
.w32
->menubar_active
= 1;
1045 /* Signal input thread to return from WM_INITMENU. */
1046 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1049 /* This callback is called from the menu bar pulldown menu
1050 when the user makes a selection.
1051 Figure out what the user chose
1052 and put the appropriate events into the keyboard buffer. */
1055 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1057 Lisp_Object prefix
, entry
;
1059 Lisp_Object
*subprefix_stack
;
1060 int submenu_depth
= 0;
1065 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1066 vector
= f
->menu_bar_vector
;
1069 while (i
< f
->menu_bar_items_used
)
1071 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1073 subprefix_stack
[submenu_depth
++] = prefix
;
1077 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1079 prefix
= subprefix_stack
[--submenu_depth
];
1082 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1084 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1085 i
+= MENU_ITEMS_PANE_LENGTH
;
1089 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1090 /* The EMACS_INT cast avoids a warning. There's no problem
1091 as long as pointers have enough bits to hold small integers. */
1092 if ((int) (EMACS_INT
) client_data
== i
)
1095 struct input_event buf
;
1098 XSETFRAME (frame
, f
);
1099 buf
.kind
= menu_bar_event
;
1100 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1101 kbd_buffer_store_event (&buf
);
1103 for (j
= 0; j
< submenu_depth
; j
++)
1104 if (!NILP (subprefix_stack
[j
]))
1106 buf
.kind
= menu_bar_event
;
1107 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1108 kbd_buffer_store_event (&buf
);
1113 buf
.kind
= menu_bar_event
;
1114 buf
.frame_or_window
= Fcons (frame
, prefix
);
1115 kbd_buffer_store_event (&buf
);
1118 buf
.kind
= menu_bar_event
;
1119 buf
.frame_or_window
= Fcons (frame
, entry
);
1120 kbd_buffer_store_event (&buf
);
1124 i
+= MENU_ITEMS_ITEM_LENGTH
;
1129 /* Allocate a widget_value, blocking input. */
1132 xmalloc_widget_value ()
1134 widget_value
*value
;
1137 value
= malloc_widget_value ();
1143 /* This recursively calls free_widget_value on the tree of widgets.
1144 It must free all data that was malloc'ed for these widget_values.
1145 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1146 must be left alone. */
1149 free_menubar_widget_value_tree (wv
)
1154 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1156 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1158 free_menubar_widget_value_tree (wv
->contents
);
1159 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1163 free_menubar_widget_value_tree (wv
->next
);
1164 wv
->next
= (widget_value
*) 0xDEADBEEF;
1167 free_widget_value (wv
);
1171 /* Return a tree of widget_value structures for a menu bar item
1172 whose event type is ITEM_KEY (with string ITEM_NAME)
1173 and whose contents come from the list of keymaps MAPS. */
1175 static widget_value
*
1176 single_submenu (item_key
, item_name
, maps
)
1177 Lisp_Object item_key
, item_name
, maps
;
1179 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1181 int submenu_depth
= 0;
1184 Lisp_Object
*mapvec
;
1185 widget_value
**submenu_stack
;
1186 int previous_items
= menu_items_used
;
1187 int top_level_items
= 0;
1189 length
= Flength (maps
);
1190 len
= XINT (length
);
1192 /* Convert the list MAPS into a vector MAPVEC. */
1193 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1194 for (i
= 0; i
< len
; i
++)
1196 mapvec
[i
] = Fcar (maps
);
1200 menu_items_n_panes
= 0;
1202 /* Loop over the given keymaps, making a pane for each map.
1203 But don't make a pane that is empty--ignore that map instead. */
1204 for (i
= 0; i
< len
; i
++)
1206 if (SYMBOLP (mapvec
[i
])
1207 || (CONSP (mapvec
[i
])
1208 && NILP (Fkeymapp (mapvec
[i
]))))
1210 /* Here we have a command at top level in the menu bar
1211 as opposed to a submenu. */
1212 top_level_items
= 1;
1213 push_menu_pane (Qnil
, Qnil
);
1214 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1215 Qnil
, Qnil
, Qnil
, Qnil
);
1218 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1221 /* Create a tree of widget_value objects
1222 representing the panes and their items. */
1225 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1226 wv
= xmalloc_widget_value ();
1230 wv
->button_type
= BUTTON_TYPE_NONE
;
1235 /* Loop over all panes and items made during this call
1236 and construct a tree of widget_value objects.
1237 Ignore the panes and items made by previous calls to
1238 single_submenu, even though those are also in menu_items. */
1240 while (i
< menu_items_used
)
1242 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1244 submenu_stack
[submenu_depth
++] = save_wv
;
1249 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1252 save_wv
= submenu_stack
[--submenu_depth
];
1255 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1256 && submenu_depth
!= 0)
1257 i
+= MENU_ITEMS_PANE_LENGTH
;
1258 /* Ignore a nil in the item list.
1259 It's meaningful only for dialog boxes. */
1260 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1262 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1264 /* Create a new pane. */
1265 Lisp_Object pane_name
, prefix
;
1267 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1268 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1269 #ifndef HAVE_MULTILINGUAL_MENU
1270 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1271 pane_name
= string_make_unibyte (pane_name
);
1273 pane_string
= (NILP (pane_name
)
1274 ? "" : (char *) XSTRING (pane_name
)->data
);
1275 /* If there is just one top-level pane, put all its items directly
1276 under the top-level menu. */
1277 if (menu_items_n_panes
== 1)
1280 /* If the pane has a meaningful name,
1281 make the pane a top-level menu item
1282 with its items as a submenu beneath it. */
1283 if (strcmp (pane_string
, ""))
1285 wv
= xmalloc_widget_value ();
1289 first_wv
->contents
= wv
;
1290 wv
->name
= pane_string
;
1291 /* Ignore the @ that means "separate pane".
1292 This is a kludge, but this isn't worth more time. */
1293 if (!NILP (prefix
) && wv
->name
[0] == '@')
1297 wv
->button_type
= BUTTON_TYPE_NONE
;
1301 i
+= MENU_ITEMS_PANE_LENGTH
;
1305 /* Create a new item within current pane. */
1306 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1309 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1310 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1312 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1313 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1314 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1315 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1316 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1318 #ifndef HAVE_MULTILINGUAL_MENU
1319 if (STRING_MULTIBYTE (item_name
))
1320 item_name
= string_make_unibyte (item_name
);
1321 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1322 descrip
= string_make_unibyte (descrip
);
1325 wv
= xmalloc_widget_value ();
1329 save_wv
->contents
= wv
;
1331 wv
->name
= (char *) XSTRING (item_name
)->data
;
1332 if (!NILP (descrip
))
1333 wv
->key
= (char *) XSTRING (descrip
)->data
;
1335 /* The EMACS_INT cast avoids a warning. There's no problem
1336 as long as pointers have enough bits to hold small integers. */
1337 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1338 wv
->enabled
= !NILP (enable
);
1341 wv
->button_type
= BUTTON_TYPE_NONE
;
1342 else if (EQ (type
, QCradio
))
1343 wv
->button_type
= BUTTON_TYPE_RADIO
;
1344 else if (EQ (type
, QCtoggle
))
1345 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1349 wv
->selected
= !NILP (selected
);
1351 wv
->help
= XSTRING (help
)->data
;
1355 i
+= MENU_ITEMS_ITEM_LENGTH
;
1359 /* If we have just one "menu item"
1360 that was originally a button, return it by itself. */
1361 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1363 wv
= first_wv
->contents
;
1364 free_widget_value (first_wv
);
1371 /* Set the contents of the menubar widgets of frame F.
1372 The argument FIRST_TIME is currently ignored;
1373 it is set the first time this is called, from initialize_frame_menubar. */
1376 set_frame_menubar (f
, first_time
, deep_p
)
1381 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1383 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1386 /* We must not change the menubar when actually in use. */
1387 if (f
->output_data
.w32
->menubar_active
)
1390 XSETFRAME (Vmenu_updating_frame
, f
);
1392 if (! menubar_widget
)
1394 else if (pending_menu_activation
&& !deep_p
)
1397 wv
= xmalloc_widget_value ();
1398 wv
->name
= "menubar";
1401 wv
->button_type
= BUTTON_TYPE_NONE
;
1406 /* Make a widget-value tree representing the entire menu trees. */
1408 struct buffer
*prev
= current_buffer
;
1410 int specpdl_count
= specpdl_ptr
- specpdl
;
1411 int previous_menu_items_used
= f
->menu_bar_items_used
;
1412 Lisp_Object
*previous_items
1413 = (Lisp_Object
*) alloca (previous_menu_items_used
1414 * sizeof (Lisp_Object
));
1416 /* If we are making a new widget, its contents are empty,
1417 do always reinitialize them. */
1418 if (! menubar_widget
)
1419 previous_menu_items_used
= 0;
1421 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1422 specbind (Qinhibit_quit
, Qt
);
1423 /* Don't let the debugger step into this code
1424 because it is not reentrant. */
1425 specbind (Qdebug_on_next_call
, Qnil
);
1427 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1428 if (NILP (Voverriding_local_map_menu_flag
))
1430 specbind (Qoverriding_terminal_local_map
, Qnil
);
1431 specbind (Qoverriding_local_map
, Qnil
);
1434 set_buffer_internal_1 (XBUFFER (buffer
));
1436 /* Run the Lucid hook. */
1437 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1438 /* If it has changed current-menubar from previous value,
1439 really recompute the menubar from the value. */
1440 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1441 call0 (Qrecompute_lucid_menubar
);
1442 safe_run_hooks (Qmenu_bar_update_hook
);
1443 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1445 items
= FRAME_MENU_BAR_ITEMS (f
);
1447 inhibit_garbage_collection ();
1449 /* Save the frame's previous menu bar contents data. */
1450 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1451 previous_menu_items_used
* sizeof (Lisp_Object
));
1453 /* Fill in the current menu bar contents. */
1454 menu_items
= f
->menu_bar_vector
;
1455 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1457 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1459 Lisp_Object key
, string
, maps
;
1461 key
= XVECTOR (items
)->contents
[i
];
1462 string
= XVECTOR (items
)->contents
[i
+ 1];
1463 maps
= XVECTOR (items
)->contents
[i
+ 2];
1467 wv
= single_submenu (key
, string
, maps
);
1471 first_wv
->contents
= wv
;
1472 /* Don't set wv->name here; GC during the loop might relocate it. */
1474 wv
->button_type
= BUTTON_TYPE_NONE
;
1478 finish_menu_items ();
1480 set_buffer_internal_1 (prev
);
1481 unbind_to (specpdl_count
, Qnil
);
1483 /* If there has been no change in the Lisp-level contents
1484 of the menu bar, skip redisplaying it. Just exit. */
1486 for (i
= 0; i
< previous_menu_items_used
; i
++)
1487 if (menu_items_used
== i
1488 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1490 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1492 free_menubar_widget_value_tree (first_wv
);
1498 /* Now GC cannot happen during the lifetime of the widget_value,
1499 so it's safe to store data from a Lisp_String. */
1500 wv
= first_wv
->contents
;
1501 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1504 string
= XVECTOR (items
)->contents
[i
+ 1];
1507 wv
->name
= (char *) XSTRING (string
)->data
;
1511 f
->menu_bar_vector
= menu_items
;
1512 f
->menu_bar_items_used
= menu_items_used
;
1517 /* Make a widget-value tree containing
1518 just the top level menu bar strings. */
1520 items
= FRAME_MENU_BAR_ITEMS (f
);
1521 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1525 string
= XVECTOR (items
)->contents
[i
+ 1];
1529 wv
= xmalloc_widget_value ();
1530 wv
->name
= (char *) XSTRING (string
)->data
;
1533 wv
->button_type
= BUTTON_TYPE_NONE
;
1534 /* This prevents lwlib from assuming this
1535 menu item is really supposed to be empty. */
1536 /* The EMACS_INT cast avoids a warning.
1537 This value just has to be different from small integers. */
1538 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1543 first_wv
->contents
= wv
;
1547 /* Forget what we thought we knew about what is in the
1548 detailed contents of the menu bar menus.
1549 Changing the top level always destroys the contents. */
1550 f
->menu_bar_items_used
= 0;
1553 /* Create or update the menu bar widget. */
1559 /* Empty current menubar, rather than creating a fresh one. */
1560 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1565 menubar_widget
= CreateMenu ();
1567 fill_in_menu (menubar_widget
, first_wv
->contents
);
1569 free_menubar_widget_value_tree (first_wv
);
1572 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1574 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1575 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1576 /* Causes flicker when menu bar is updated
1577 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1579 /* Force the window size to be recomputed so that the frame's text
1580 area remains the same, if menubar has just been created. */
1581 if (old_widget
== NULL
)
1582 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1588 /* Called from Fx_create_frame to create the initial menubar of a frame
1589 before it is mapped, so that the window is mapped with the menubar already
1590 there instead of us tacking it on later and thrashing the window after it
1594 initialize_frame_menubar (f
)
1597 /* This function is called before the first chance to redisplay
1598 the frame. It has to be, so the frame will have the right size. */
1599 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1600 set_frame_menubar (f
, 1, 1);
1603 /* Get rid of the menu bar of frame F, and free its storage.
1604 This is used when deleting a frame, and when turning off the menu bar. */
1607 free_frame_menubar (f
)
1613 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1614 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1615 f
->output_data
.w32
->menubar_widget
= NULL
;
1623 /* w32_menu_show actually displays a menu using the panes and items in
1624 menu_items and returns the value selected from it; we assume input
1625 is blocked by the caller. */
1627 /* F is the frame the menu is for.
1628 X and Y are the frame-relative specified position,
1629 relative to the inside upper left corner of the frame F.
1630 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1631 KEYMAPS is 1 if this menu was specified with keymaps;
1632 in that case, we return a list containing the chosen item's value
1633 and perhaps also the pane's prefix.
1634 TITLE is the specified menu title.
1635 ERROR is a place to store an error message string in case of failure.
1636 (We return nil on failure, but the value doesn't actually matter.) */
1639 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1649 int menu_item_selection
;
1652 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1653 widget_value
**submenu_stack
1654 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1655 Lisp_Object
*subprefix_stack
1656 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1657 int submenu_depth
= 0;
1659 int next_release_must_exit
= 0;
1663 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1665 *error
= "Empty menu";
1669 /* Create a tree of widget_value objects
1670 representing the panes and their items. */
1671 wv
= xmalloc_widget_value ();
1675 wv
->button_type
= BUTTON_TYPE_NONE
;
1679 /* Loop over all panes and items, filling in the tree. */
1681 while (i
< menu_items_used
)
1683 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1685 submenu_stack
[submenu_depth
++] = save_wv
;
1691 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1694 save_wv
= submenu_stack
[--submenu_depth
];
1698 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1699 && submenu_depth
!= 0)
1700 i
+= MENU_ITEMS_PANE_LENGTH
;
1701 /* Ignore a nil in the item list.
1702 It's meaningful only for dialog boxes. */
1703 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1705 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1707 /* Create a new pane. */
1708 Lisp_Object pane_name
, prefix
;
1710 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1711 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1712 #ifndef HAVE_MULTILINGUAL_MENU
1713 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1714 pane_name
= string_make_unibyte (pane_name
);
1716 pane_string
= (NILP (pane_name
)
1717 ? "" : (char *) XSTRING (pane_name
)->data
);
1718 /* If there is just one top-level pane, put all its items directly
1719 under the top-level menu. */
1720 if (menu_items_n_panes
== 1)
1723 /* If the pane has a meaningful name,
1724 make the pane a top-level menu item
1725 with its items as a submenu beneath it. */
1726 if (!keymaps
&& strcmp (pane_string
, ""))
1728 wv
= xmalloc_widget_value ();
1732 first_wv
->contents
= wv
;
1733 wv
->name
= pane_string
;
1734 if (keymaps
&& !NILP (prefix
))
1738 wv
->button_type
= BUTTON_TYPE_NONE
;
1742 else if (first_pane
)
1748 i
+= MENU_ITEMS_PANE_LENGTH
;
1752 /* Create a new item within current pane. */
1753 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1754 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1755 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1757 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1758 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1759 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1760 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1762 #ifndef HAVE_MULTILINGUAL_MENU
1763 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1764 item_name
= string_make_unibyte (item_name
);
1765 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1766 item_name
= string_make_unibyte (descrip
);
1769 wv
= xmalloc_widget_value ();
1773 save_wv
->contents
= wv
;
1774 wv
->name
= (char *) XSTRING (item_name
)->data
;
1775 if (!NILP (descrip
))
1776 wv
->key
= (char *) XSTRING (descrip
)->data
;
1778 /* Use the contents index as call_data, since we are
1779 restricted to 16-bits.. */
1780 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1781 wv
->enabled
= !NILP (enable
);
1784 wv
->button_type
= BUTTON_TYPE_NONE
;
1785 else if (EQ (type
, QCtoggle
))
1786 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1787 else if (EQ (type
, QCradio
))
1788 wv
->button_type
= BUTTON_TYPE_RADIO
;
1792 wv
->selected
= !NILP (selected
);
1796 i
+= MENU_ITEMS_ITEM_LENGTH
;
1800 /* Deal with the title, if it is non-nil. */
1803 widget_value
*wv_title
= xmalloc_widget_value ();
1804 widget_value
*wv_sep
= xmalloc_widget_value ();
1806 /* Maybe replace this separator with a bitmap or owner-draw item
1807 so that it looks better. Having two separators looks odd. */
1808 wv_sep
->name
= "--";
1809 wv_sep
->next
= first_wv
->contents
;
1811 #ifndef HAVE_MULTILINGUAL_MENU
1812 if (STRING_MULTIBYTE (title
))
1813 title
= string_make_unibyte (title
);
1815 wv_title
->name
= (char *) XSTRING (title
)->data
;
1816 wv_title
->enabled
= True
;
1817 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1818 wv_title
->next
= wv_sep
;
1819 first_wv
->contents
= wv_title
;
1822 /* Actually create the menu. */
1823 menu
= CreatePopupMenu ();
1824 fill_in_menu (menu
, first_wv
->contents
);
1826 /* Adjust coordinates to be root-window-relative. */
1829 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1831 /* Free the widget_value objects we used to specify the contents. */
1832 free_menubar_widget_value_tree (first_wv
);
1834 /* No selection has been chosen yet. */
1835 menu_item_selection
= 0;
1837 /* Display the menu. */
1838 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1839 WM_EMACS_TRACKPOPUPMENU
,
1840 (WPARAM
)menu
, (LPARAM
)&pos
);
1842 /* Clean up extraneous mouse events which might have been generated
1844 discard_mouse_events ();
1848 /* Find the selected item, and its pane, to return
1849 the proper value. */
1850 if (menu_item_selection
!= 0)
1852 Lisp_Object prefix
, entry
;
1856 while (i
< menu_items_used
)
1858 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1860 subprefix_stack
[submenu_depth
++] = prefix
;
1864 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1866 prefix
= subprefix_stack
[--submenu_depth
];
1869 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1872 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1873 i
+= MENU_ITEMS_PANE_LENGTH
;
1875 /* Ignore a nil in the item list.
1876 It's meaningful only for dialog boxes. */
1877 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1882 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1883 if (menu_item_selection
== i
)
1889 entry
= Fcons (entry
, Qnil
);
1891 entry
= Fcons (prefix
, entry
);
1892 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1893 if (!NILP (subprefix_stack
[j
]))
1894 entry
= Fcons (subprefix_stack
[j
], entry
);
1898 i
+= MENU_ITEMS_ITEM_LENGTH
;
1907 static char * button_names
[] = {
1908 "button1", "button2", "button3", "button4", "button5",
1909 "button6", "button7", "button8", "button9", "button10" };
1912 w32_dialog_show (f
, keymaps
, title
, error
)
1918 int i
, nb_buttons
=0;
1919 char dialog_name
[6];
1920 int menu_item_selection
;
1922 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1924 /* Number of elements seen so far, before boundary. */
1926 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1927 int boundary_seen
= 0;
1931 if (menu_items_n_panes
> 1)
1933 *error
= "Multiple panes in dialog box";
1937 /* Create a tree of widget_value objects
1938 representing the text label and buttons. */
1940 Lisp_Object pane_name
, prefix
;
1942 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1943 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1944 pane_string
= (NILP (pane_name
)
1945 ? "" : (char *) XSTRING (pane_name
)->data
);
1946 prev_wv
= xmalloc_widget_value ();
1947 prev_wv
->value
= pane_string
;
1948 if (keymaps
&& !NILP (prefix
))
1950 prev_wv
->enabled
= 1;
1951 prev_wv
->name
= "message";
1954 /* Loop over all panes and items, filling in the tree. */
1955 i
= MENU_ITEMS_PANE_LENGTH
;
1956 while (i
< menu_items_used
)
1959 /* Create a new item within current pane. */
1960 Lisp_Object item_name
, enable
, descrip
;
1961 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1962 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1964 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1966 if (NILP (item_name
))
1968 free_menubar_widget_value_tree (first_wv
);
1969 *error
= "Submenu in dialog items";
1972 if (EQ (item_name
, Qquote
))
1974 /* This is the boundary between left-side elts
1975 and right-side elts. Stop incrementing right_count. */
1980 if (nb_buttons
>= 9)
1982 free_menubar_widget_value_tree (first_wv
);
1983 *error
= "Too many dialog items";
1987 wv
= xmalloc_widget_value ();
1989 wv
->name
= (char *) button_names
[nb_buttons
];
1990 if (!NILP (descrip
))
1991 wv
->key
= (char *) XSTRING (descrip
)->data
;
1992 wv
->value
= (char *) XSTRING (item_name
)->data
;
1993 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1994 wv
->enabled
= !NILP (enable
);
1997 if (! boundary_seen
)
2001 i
+= MENU_ITEMS_ITEM_LENGTH
;
2004 /* If the boundary was not specified,
2005 by default put half on the left and half on the right. */
2006 if (! boundary_seen
)
2007 left_count
= nb_buttons
- nb_buttons
/ 2;
2009 wv
= xmalloc_widget_value ();
2010 wv
->name
= dialog_name
;
2012 /* Dialog boxes use a really stupid name encoding
2013 which specifies how many buttons to use
2014 and how many buttons are on the right.
2015 The Q means something also. */
2016 dialog_name
[0] = 'Q';
2017 dialog_name
[1] = '0' + nb_buttons
;
2018 dialog_name
[2] = 'B';
2019 dialog_name
[3] = 'R';
2020 /* Number of buttons to put on the right. */
2021 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2023 wv
->contents
= first_wv
;
2027 /* Actually create the dialog. */
2029 dialog_id
= widget_id_tick
++;
2030 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2031 f
->output_data
.w32
->widget
, 1, 0,
2032 dialog_selection_callback
, 0);
2033 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2036 /* Free the widget_value objects we used to specify the contents. */
2037 free_menubar_widget_value_tree (first_wv
);
2039 /* No selection has been chosen yet. */
2040 menu_item_selection
= 0;
2042 /* Display the menu. */
2044 lw_pop_up_all_widgets (dialog_id
);
2045 popup_activated_flag
= 1;
2047 /* Process events that apply to the menu. */
2048 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2050 lw_destroy_all_widgets (dialog_id
);
2053 /* Find the selected item, and its pane, to return
2054 the proper value. */
2055 if (menu_item_selection
!= 0)
2061 while (i
< menu_items_used
)
2065 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2068 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2069 i
+= MENU_ITEMS_PANE_LENGTH
;
2074 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2075 if (menu_item_selection
== i
)
2079 entry
= Fcons (entry
, Qnil
);
2081 entry
= Fcons (prefix
, entry
);
2085 i
+= MENU_ITEMS_ITEM_LENGTH
;
2094 /* Is this item a separator? */
2096 name_is_separator (name
)
2099 /* Check if name string consists of only dashes ('-') */
2100 while (*name
== '-') name
++;
2101 return (*name
== '\0');
2105 /* Indicate boundary between left and right. */
2107 add_left_right_boundary (HMENU menu
)
2109 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2113 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2118 if (name_is_separator (wv
->name
))
2119 fuFlags
= MF_SEPARATOR
;
2123 fuFlags
= MF_STRING
;
2125 fuFlags
= MF_STRING
| MF_GRAYED
;
2127 if (wv
->key
!= NULL
)
2129 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2130 strcpy (out_string
, wv
->name
);
2131 strcat (out_string
, "\t");
2132 strcat (out_string
, wv
->key
);
2135 out_string
= wv
->name
;
2137 if (wv
->title
|| wv
->call_data
== 0)
2139 #if 0 /* no GC while popup menu is active */
2140 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2141 strcpy (out_string
, wv
->name
);
2143 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2147 /* Draw radio buttons and tickboxes. */
2149 switch (wv
->button_type
)
2151 case BUTTON_TYPE_TOGGLE
:
2152 CheckMenuItem (menu
, (UINT
)item
,
2153 wv
->selected
? MF_CHECKED
: MF_UNCHECKED
);
2156 case BUTTON_TYPE_RADIO
:
2157 /* CheckMenuRadioItem does not exist on NT 3.51 and
2158 earlier. Fallback on CheckMenuItem. */
2160 HMODULE user32
= GetModuleHandle ("user32.dll");
2161 FARPROC set_menu_item_info
2162 = GetProcAddress (user32
, "SetMenuItemInfo");
2163 if (set_menu_item_info
)
2166 bzero (&info
, sizeof (info
));
2167 info
.cbSize
= sizeof (info
);
2168 info
.fMask
= MIIM_TYPE
| MIIM_STATE
;
2169 info
.fType
= MFT_RADIOCHECK
;
2170 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2172 set_menu_item_info (menu
, item
, FALSE
, &info
);
2175 CheckMenuItem (menu
, (UINT
)item
, wv
->selected
?
2176 MF_CHECKED
: MF_UNCHECKED
);
2181 CheckMenuItem (menu
, (UINT
)item
, MF_UNCHECKED
);
2191 return AppendMenu (menu
,
2193 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2194 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2197 /* Construct native Windows menu(bar) based on widget_value tree. */
2199 fill_in_menu (HMENU menu
, widget_value
*wv
)
2201 int items_added
= 0;
2203 for ( ; wv
!= NULL
; wv
= wv
->next
)
2207 HMENU sub_menu
= CreatePopupMenu ();
2209 if (sub_menu
== NULL
)
2212 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2213 !add_menu_item (menu
, wv
, sub_menu
))
2215 DestroyMenu (sub_menu
);
2221 if (!add_menu_item (menu
, wv
, NULL
))
2231 /* popup_activated_flag not actually used on W32 */
2235 #endif /* HAVE_MENUS */
2239 staticpro (&menu_items
);
2242 Qdebug_on_next_call
= intern ("debug-on-next-call");
2243 staticpro (&Qdebug_on_next_call
);
2245 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2246 "Frame for which we are updating a menu.\n\
2247 The enable predicate for a menu command should check this variable.");
2248 Vmenu_updating_frame
= Qnil
;
2250 defsubr (&Sx_popup_menu
);
2252 defsubr (&Sx_popup_dialog
);