1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998 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 /******************************************************************/
46 /* Definitions copied from lwlib.h */
48 typedef void * XtPointer
;
54 typedef enum _change_type
62 typedef struct _widget_value
66 /* value (meaning depend on widget type) */
68 /* keyboard equivalent. no implications for XtTranslations */
72 /* true if selected */
74 /* true if menu title */
77 /* true if was edited (maintained by get_value) */
79 /* true if has changed (maintained by lw library) */
81 /* true if this widget itself has changed,
82 but not counting the other widgets found in the `next' field. */
83 change_type this_one_change
;
85 /* Contents of the sub-widgets, also selected slot for checkbox */
86 struct _widget_value
* contents
;
87 /* data passed to callback */
89 /* next one in the list */
90 struct _widget_value
* next
;
92 /* slot for the toolkit dependent part. Always initialize to NULL. */
94 /* tell us if we should free the toolkit data slot when freeing the
95 widget_value itself. */
96 Boolean free_toolkit_data
;
98 /* we resource the widget_value structures; this points to the next
99 one on the free list if this one has been deallocated.
101 struct _widget_value
*free_list
;
105 /* LocalAlloc/Free is a reasonably good allocator. */
106 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
107 #define free_widget_value(wv) LocalFree (wv)
109 /******************************************************************/
111 #define min(x,y) (((x) < (y)) ? (x) : (y))
112 #define max(x,y) (((x) > (y)) ? (x) : (y))
119 Lisp_Object Vmenu_updating_frame
;
121 Lisp_Object Qdebug_on_next_call
;
123 extern Lisp_Object Qmenu_bar
;
124 extern Lisp_Object Qmouse_click
, Qevent_kind
;
126 extern Lisp_Object QCtoggle
, QCradio
;
128 extern Lisp_Object Voverriding_local_map
;
129 extern Lisp_Object Voverriding_local_map_menu_flag
;
131 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
133 extern Lisp_Object Qmenu_bar_update_hook
;
135 void set_frame_menubar ();
137 static Lisp_Object
w32_menu_show ();
138 static Lisp_Object
w32_dialog_show ();
140 static void keymap_panes ();
141 static void single_keymap_panes ();
142 static void single_menu_item ();
143 static void list_of_panes ();
144 static void list_of_items ();
146 /* This holds a Lisp vector that holds the results of decoding
147 the keymaps or alist-of-alists that specify a menu.
149 It describes the panes and items within the panes.
151 Each pane is described by 3 elements in the vector:
152 t, the pane name, the pane's prefix key.
153 Then follow the pane's items, with 5 elements per item:
154 the item string, the enable flag, the item's value,
155 the definition, and the equivalent keyboard key's description string.
157 In some cases, multiple levels of menus may be described.
158 A single vector slot containing nil indicates the start of a submenu.
159 A single vector slot containing lambda indicates the end of a submenu.
160 The submenu follows a menu item which is the way to reach the submenu.
162 A single vector slot containing quote indicates that the
163 following items should appear on the right of a dialog box.
165 Using a Lisp vector to hold this information while we decode it
166 takes care of protecting all the data from GC. */
168 #define MENU_ITEMS_PANE_NAME 1
169 #define MENU_ITEMS_PANE_PREFIX 2
170 #define MENU_ITEMS_PANE_LENGTH 3
172 #define MENU_ITEMS_ITEM_NAME 0
173 #define MENU_ITEMS_ITEM_ENABLE 1
174 #define MENU_ITEMS_ITEM_VALUE 2
175 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
176 #define MENU_ITEMS_ITEM_DEFINITION 4
177 #define MENU_ITEMS_ITEM_LENGTH 5
179 static Lisp_Object menu_items
;
181 /* Number of slots currently allocated in menu_items. */
182 static int menu_items_allocated
;
184 /* This is the index in menu_items of the first empty slot. */
185 static int menu_items_used
;
187 /* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189 static int menu_items_n_panes
;
191 /* Current depth within submenus. */
192 static int menu_items_submenu_depth
;
194 /* Flag which when set indicates a dialog or menu has been posted by
195 Xt on behalf of one of the widget sets. */
196 static int popup_activated_flag
;
198 /* This is set nonzero after the user activates the menu bar, and set
199 to zero again after the menu bars are redisplayed by prepare_menu_bar.
200 While it is nonzero, all calls to set_frame_menubar go deep.
202 I don't understand why this is needed, but it does seem to be
203 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
205 int pending_menu_activation
;
208 /* Return the frame whose ->output_data.w32->menubar_widget equals
209 MENU, or 0 if none. */
211 static struct frame
*
212 menubar_id_to_frame (HMENU menu
)
214 Lisp_Object tail
, frame
;
217 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
220 if (!GC_FRAMEP (frame
))
223 if (f
->output_data
.nothing
== 1)
225 if (f
->output_data
.w32
->menubar_widget
== menu
)
231 /* Initialize the menu_items structure if we haven't already done so.
232 Also mark it as currently empty. */
237 if (NILP (menu_items
))
239 menu_items_allocated
= 60;
240 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
244 menu_items_n_panes
= 0;
245 menu_items_submenu_depth
= 0;
248 /* Call at the end of generating the data in menu_items.
249 This fills in the number of items in the last pane. */
256 /* Call when finished using the data for the current menu
260 discard_menu_items ()
262 /* Free the structure if it is especially large.
263 Otherwise, hold on to it, to save time. */
264 if (menu_items_allocated
> 200)
267 menu_items_allocated
= 0;
271 /* Make the menu_items vector twice as large. */
277 int old_size
= menu_items_allocated
;
280 menu_items_allocated
*= 2;
281 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
282 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
283 old_size
* sizeof (Lisp_Object
));
286 /* Begin a submenu. */
289 push_submenu_start ()
291 if (menu_items_used
+ 1 > menu_items_allocated
)
294 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
295 menu_items_submenu_depth
++;
303 if (menu_items_used
+ 1 > menu_items_allocated
)
306 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
307 menu_items_submenu_depth
--;
310 /* Indicate boundary between left and right. */
313 push_left_right_boundary ()
315 if (menu_items_used
+ 1 > menu_items_allocated
)
318 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
321 /* Start a new menu pane in menu_items..
322 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
325 push_menu_pane (name
, prefix_vec
)
326 Lisp_Object name
, prefix_vec
;
328 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
331 if (menu_items_submenu_depth
== 0)
332 menu_items_n_panes
++;
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
334 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
335 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
338 /* Push one menu item into the current pane.
339 NAME is the string to display. ENABLE if non-nil means
340 this item can be selected. KEY is the key generated by
341 choosing this item, or nil if this item doesn't really have a definition.
342 DEF is the definition of this item.
343 EQUIV is the textual description of the keyboard equivalent for
344 this item (or nil if none). */
347 push_menu_item (name
, enable
, key
, def
, equiv
)
348 Lisp_Object name
, enable
, key
, def
, equiv
;
350 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
356 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
357 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
360 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
361 and generate menu panes for them in menu_items.
362 If NOTREAL is nonzero,
363 don't bother really computing whether an item is enabled. */
366 keymap_panes (keymaps
, nmaps
, notreal
)
367 Lisp_Object
*keymaps
;
375 /* Loop over the given keymaps, making a pane for each map.
376 But don't make a pane that is empty--ignore that map instead.
377 P is the number of panes we have made so far. */
378 for (mapno
= 0; mapno
< nmaps
; mapno
++)
379 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
381 finish_menu_items ();
384 /* This is a recursive subroutine of keymap_panes.
385 It handles one keymap, KEYMAP.
386 The other arguments are passed along
387 or point to local variables of the previous function.
388 If NOTREAL is nonzero, only check for equivalent key bindings, don't
389 evaluate expressions in menu items and don't make any menu.
391 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
394 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
396 Lisp_Object pane_name
;
401 Lisp_Object pending_maps
= Qnil
;
402 Lisp_Object tail
, item
;
403 struct gcpro gcpro1
, gcpro2
;
409 push_menu_pane (pane_name
, prefix
);
412 /* Remember index for first item in this pane so we can go back and
413 add a prefix when (if) we see the first button. After that, notbuttons
414 is set to 0, to mark that we have seen a button and all non button
415 items need a prefix. */
416 notbuttons
= menu_items_used
;
419 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
421 GCPRO2 (keymap
, pending_maps
);
422 /* Look at each key binding, and if it is a menu item add it
426 single_menu_item (XCAR (item
), XCDR (item
),
427 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
428 else if (VECTORP (item
))
430 /* Loop over the char values represented in the vector. */
431 int len
= XVECTOR (item
)->size
;
433 for (c
= 0; c
< len
; c
++)
435 Lisp_Object character
;
436 XSETFASTINT (character
, c
);
437 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
438 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
444 /* Process now any submenus which want to be panes at this level. */
445 while (!NILP (pending_maps
))
447 Lisp_Object elt
, eltcdr
, string
;
448 elt
= Fcar (pending_maps
);
450 string
= XCAR (eltcdr
);
451 /* We no longer discard the @ from the beginning of the string here.
452 Instead, we do this in w32_menu_show. */
453 single_keymap_panes (Fcar (elt
), string
,
454 XCDR (eltcdr
), notreal
, maxdepth
- 1);
455 pending_maps
= Fcdr (pending_maps
);
459 /* This is a subroutine of single_keymap_panes that handles one
461 KEY is a key in a keymap and ITEM is its binding.
462 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
464 If NOTREAL is nonzero, only check for equivalent key bindings, don't
465 evaluate expressions in menu items and don't make any menu.
466 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
467 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
468 buttons. It points to variable notbuttons in single_keymap_panes,
469 which keeps track of if we have seen a button in this menu or not. */
472 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
474 Lisp_Object key
, item
;
475 Lisp_Object
*pending_maps_ptr
;
476 int maxdepth
, notreal
;
479 Lisp_Object def
, map
, item_string
, enabled
;
480 struct gcpro gcpro1
, gcpro2
;
483 /* Parse the menu item and leave the result in item_properties. */
485 res
= parse_menu_item (item
, notreal
, 0);
488 return; /* Not a menu item. */
490 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
494 /* We don't want to make a menu, just traverse the keymaps to
495 precompute equivalent key bindings. */
497 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
501 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
502 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
504 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
507 /* An enabled separate pane. Remember this to handle it later. */
508 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
514 /* Simulate radio buttons and toggle boxes by putting a prefix in
517 Lisp_Object prefix
= Qnil
;
518 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
522 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
525 /* The first button. Line up previous items in this menu. */
527 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
530 while (index
< menu_items_used
)
533 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
537 submenu
++; /* Skip sub menu. */
539 else if (EQ (tem
, Qlambda
))
542 submenu
--; /* End sub menu. */
544 else if (EQ (tem
, Qt
))
545 index
+= 3; /* Skip new pane marker. */
546 else if (EQ (tem
, Qquote
))
547 index
++; /* Skip a left, right divider. */
550 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
551 && XSTRING (tem
)->data
[0] != '-')
552 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
553 = concat2 (build_string (" "), tem
);
554 index
+= MENU_ITEMS_ITEM_LENGTH
;
560 /* Calculate prefix, if any, for this item. */
561 if (EQ (type
, QCtoggle
))
562 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
563 else if (EQ (type
, QCradio
))
564 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
566 /* Not a button. If we have earlier buttons, then we need a prefix. */
567 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
568 && XSTRING (item_string
)->data
[0] != '-')
569 prefix
= build_string (" ");
572 item_string
= concat2 (prefix
, item_string
);
574 #endif /* not HAVE_BOXES */
578 /* Indicate visually that this is a submenu. */
579 item_string
= concat2 (item_string
, build_string (" >"));
582 push_menu_item (item_string
, enabled
, key
,
583 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
584 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
]);
587 /* Display a submenu using the toolkit. */
588 if (! (NILP (map
) || NILP (enabled
)))
590 push_submenu_start ();
591 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
597 /* Push all the panes and items of a menu described by the
598 alist-of-alists MENU.
599 This handles old-fashioned calls to x-popup-menu. */
609 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
611 Lisp_Object elt
, pane_name
, pane_data
;
613 pane_name
= Fcar (elt
);
614 CHECK_STRING (pane_name
, 0);
615 push_menu_pane (pane_name
, Qnil
);
616 pane_data
= Fcdr (elt
);
617 CHECK_CONS (pane_data
, 0);
618 list_of_items (pane_data
);
621 finish_menu_items ();
624 /* Push the items in a single pane defined by the alist PANE. */
630 Lisp_Object tail
, item
, item1
;
632 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
636 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
637 else if (NILP (item
))
638 push_left_right_boundary ();
641 CHECK_CONS (item
, 0);
643 CHECK_STRING (item1
, 1);
644 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
649 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
650 "Pop up a deck-of-cards menu and return user's selection.\n\
651 POSITION is a position specification. This is either a mouse button event\n\
652 or a list ((XOFFSET YOFFSET) WINDOW)\n\
653 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
654 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
655 This controls the position of the center of the first line\n\
656 in the first pane of the menu, not the top left of the menu as a whole.\n\
657 If POSITION is t, it means to use the current mouse position.\n\
659 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
660 The menu items come from key bindings that have a menu string as well as\n\
661 a definition; actually, the \"definition\" in such a key binding looks like\n\
662 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
663 the keymap as a top-level element.\n\n\
664 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
665 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
667 You can also use a list of keymaps as MENU.\n\
668 Then each keymap makes a separate pane.\n\
669 When MENU is a keymap or a list of keymaps, the return value\n\
670 is a list of events.\n\n\
672 Alternatively, you can specify a menu of multiple panes\n\
673 with a list of the form (TITLE PANE1 PANE2...),\n\
674 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
675 Each ITEM is normally a cons cell (STRING . VALUE);\n\
676 but a string can appear as an item--that makes a nonselectable line\n\
678 With this form of menu, the return value is VALUE from the chosen item.\n\
680 If POSITION is nil, don't display the menu at all, just precalculate the\n\
681 cached information about equivalent key sequences.")
683 Lisp_Object position
, menu
;
685 int number_of_panes
, panes
;
686 Lisp_Object keymap
, tem
;
690 Lisp_Object selection
;
693 Lisp_Object x
, y
, window
;
699 if (! NILP (position
))
703 /* Decode the first argument: find the window and the coordinates. */
704 if (EQ (position
, Qt
)
705 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
707 /* Use the mouse's current position. */
708 FRAME_PTR new_f
= selected_frame
;
709 Lisp_Object bar_window
;
713 if (mouse_position_hook
)
714 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
715 &part
, &x
, &y
, &time
);
717 XSETFRAME (window
, new_f
);
720 window
= selected_window
;
727 tem
= Fcar (position
);
730 window
= Fcar (Fcdr (position
));
732 y
= Fcar (Fcdr (tem
));
737 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
738 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
739 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
748 /* Decode where to put the menu. */
756 else if (WINDOWP (window
))
758 CHECK_LIVE_WINDOW (window
, 0);
759 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
761 xpos
= (FONT_WIDTH (f
->output_data
.w32
->font
)
762 * XFASTINT (XWINDOW (window
)->left
));
763 ypos
= (f
->output_data
.w32
->line_height
764 * XFASTINT (XWINDOW (window
)->top
));
767 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
768 but I don't want to make one now. */
769 CHECK_WINDOW (window
, 0);
774 XSETFRAME (Vmenu_updating_frame
, f
);
776 Vmenu_updating_frame
= Qnil
;
777 #endif /* HAVE_MENUS */
782 /* Decode the menu items from what was specified. */
784 keymap
= Fkeymapp (menu
);
787 tem
= Fkeymapp (Fcar (menu
));
790 /* We were given a keymap. Extract menu info from the keymap. */
792 keymap
= get_keymap (menu
);
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (&menu
, 1, NILP (position
));
797 /* Search for a string appearing directly as an element of the keymap.
798 That string is the title of the menu. */
799 prompt
= map_prompt (keymap
);
800 if (NILP (title
) && !NILP (prompt
))
803 /* Make that be the pane title of the first pane. */
804 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
805 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
809 else if (!NILP (tem
))
811 /* We were given a list of keymaps. */
812 int nmaps
= XFASTINT (Flength (menu
));
814 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
819 /* The first keymap that has a prompt string
820 supplies the menu title. */
821 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
825 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
827 prompt
= map_prompt (keymap
);
828 if (NILP (title
) && !NILP (prompt
))
832 /* Extract the detailed info to make one pane. */
833 keymap_panes (maps
, nmaps
, NILP (position
));
835 /* Make the title be the pane title of the first pane. */
836 if (!NILP (title
) && menu_items_n_panes
>= 0)
837 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
843 /* We were given an old-fashioned menu. */
845 CHECK_STRING (title
, 1);
847 list_of_panes (Fcdr (menu
));
854 discard_menu_items ();
860 /* Display them in a menu. */
863 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
864 keymaps
, title
, &error_name
);
867 discard_menu_items ();
870 #endif /* HAVE_MENUS */
872 if (error_name
) error (error_name
);
878 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
879 "Pop up a dialog box and return user's selection.\n\
880 POSITION specifies which frame to use.\n\
881 This is normally a mouse button event or a window or frame.\n\
882 If POSITION is t, it means to use the frame the mouse is on.\n\
883 The dialog box appears in the middle of the specified frame.\n\
885 CONTENTS specifies the alternatives to display in the dialog box.\n\
886 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
887 Each ITEM is a cons cell (STRING . VALUE).\n\
888 The return value is VALUE from the chosen item.\n\n\
889 An ITEM may also be just a string--that makes a nonselectable item.\n\
890 An ITEM may also be nil--that means to put all preceding items\n\
891 on the left of the dialog box and all following items on the right.\n\
892 \(By default, approximately half appear on each side.)")
894 Lisp_Object position
, contents
;
901 /* Decode the first argument: find the window or frame to use. */
902 if (EQ (position
, Qt
)
903 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
905 #if 0 /* Using the frame the mouse is on may not be right. */
906 /* Use the mouse's current position. */
907 FRAME_PTR new_f
= selected_frame
;
908 Lisp_Object bar_window
;
913 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
916 XSETFRAME (window
, new_f
);
918 window
= selected_window
;
920 window
= selected_window
;
922 else if (CONSP (position
))
925 tem
= Fcar (position
);
927 window
= Fcar (Fcdr (position
));
930 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
931 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
934 else if (WINDOWP (position
) || FRAMEP (position
))
939 /* Decode where to put the menu. */
943 else if (WINDOWP (window
))
945 CHECK_LIVE_WINDOW (window
, 0);
946 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
949 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
950 but I don't want to make one now. */
951 CHECK_WINDOW (window
, 0);
954 /* Display a menu with these alternatives
955 in the middle of frame F. */
957 Lisp_Object x
, y
, frame
, newpos
;
958 XSETFRAME (frame
, f
);
959 XSETINT (x
, x_pixel_width (f
) / 2);
960 XSETINT (y
, x_pixel_height (f
) / 2);
961 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
963 return Fx_popup_menu (newpos
,
964 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
970 Lisp_Object selection
;
972 /* Decode the dialog items from what was specified. */
973 title
= Fcar (contents
);
974 CHECK_STRING (title
, 1);
976 list_of_panes (Fcons (contents
, Qnil
));
978 /* Display them in a dialog box. */
980 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
983 discard_menu_items ();
985 if (error_name
) error (error_name
);
991 /* Activate the menu bar of frame F.
992 This is called from keyboard.c when it gets the
993 menu_bar_activate_event out of the Emacs event queue.
995 To activate the menu bar, we signal to the input thread that it can
996 return from the WM_INITMENU message, allowing the normal Windows
997 processing of the menus.
999 But first we recompute the menu bar contents (the whole tree).
1001 This way we can safely execute Lisp code. */
1003 x_activate_menubar (f
)
1006 set_frame_menubar (f
, 0, 1);
1008 /* Lock out further menubar changes while active. */
1009 f
->output_data
.w32
->menubar_active
= 1;
1011 /* Signal input thread to return from WM_INITMENU. */
1012 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1015 /* This callback is called from the menu bar pulldown menu
1016 when the user makes a selection.
1017 Figure out what the user chose
1018 and put the appropriate events into the keyboard buffer. */
1021 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1023 Lisp_Object prefix
, entry
;
1025 Lisp_Object
*subprefix_stack
;
1026 int submenu_depth
= 0;
1031 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1032 vector
= f
->menu_bar_vector
;
1035 while (i
< f
->menu_bar_items_used
)
1037 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1039 subprefix_stack
[submenu_depth
++] = prefix
;
1043 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1045 prefix
= subprefix_stack
[--submenu_depth
];
1048 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1050 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1051 i
+= MENU_ITEMS_PANE_LENGTH
;
1055 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1056 /* The EMACS_INT cast avoids a warning. There's no problem
1057 as long as pointers have enough bits to hold small integers. */
1058 if ((int) (EMACS_INT
) client_data
== i
)
1061 struct input_event buf
;
1064 XSETFRAME (frame
, f
);
1065 buf
.kind
= menu_bar_event
;
1066 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1067 kbd_buffer_store_event (&buf
);
1069 for (j
= 0; j
< submenu_depth
; j
++)
1070 if (!NILP (subprefix_stack
[j
]))
1072 buf
.kind
= menu_bar_event
;
1073 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1074 kbd_buffer_store_event (&buf
);
1079 buf
.kind
= menu_bar_event
;
1080 buf
.frame_or_window
= Fcons (frame
, prefix
);
1081 kbd_buffer_store_event (&buf
);
1084 buf
.kind
= menu_bar_event
;
1085 buf
.frame_or_window
= Fcons (frame
, entry
);
1086 kbd_buffer_store_event (&buf
);
1090 i
+= MENU_ITEMS_ITEM_LENGTH
;
1095 /* Allocate a widget_value, blocking input. */
1098 xmalloc_widget_value ()
1100 widget_value
*value
;
1103 value
= malloc_widget_value ();
1109 /* This recursively calls free_widget_value on the tree of widgets.
1110 It must free all data that was malloc'ed for these widget_values.
1111 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1112 must be left alone. */
1115 free_menubar_widget_value_tree (wv
)
1120 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1122 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1124 free_menubar_widget_value_tree (wv
->contents
);
1125 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1129 free_menubar_widget_value_tree (wv
->next
);
1130 wv
->next
= (widget_value
*) 0xDEADBEEF;
1133 free_widget_value (wv
);
1137 /* Return a tree of widget_value structures for a menu bar item
1138 whose event type is ITEM_KEY (with string ITEM_NAME)
1139 and whose contents come from the list of keymaps MAPS. */
1141 static widget_value
*
1142 single_submenu (item_key
, item_name
, maps
)
1143 Lisp_Object item_key
, item_name
, maps
;
1145 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1147 int submenu_depth
= 0;
1150 Lisp_Object
*mapvec
;
1151 widget_value
**submenu_stack
;
1153 int previous_items
= menu_items_used
;
1154 int top_level_items
= 0;
1156 length
= Flength (maps
);
1157 len
= XINT (length
);
1159 /* Convert the list MAPS into a vector MAPVEC. */
1160 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1161 for (i
= 0; i
< len
; i
++)
1163 mapvec
[i
] = Fcar (maps
);
1167 menu_items_n_panes
= 0;
1169 /* Loop over the given keymaps, making a pane for each map.
1170 But don't make a pane that is empty--ignore that map instead. */
1171 for (i
= 0; i
< len
; i
++)
1173 if (SYMBOLP (mapvec
[i
])
1174 || (CONSP (mapvec
[i
])
1175 && NILP (Fkeymapp (mapvec
[i
]))))
1177 /* Here we have a command at top level in the menu bar
1178 as opposed to a submenu. */
1179 top_level_items
= 1;
1180 push_menu_pane (Qnil
, Qnil
);
1181 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
], Qnil
);
1184 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1187 /* Create a tree of widget_value objects
1188 representing the panes and their items. */
1191 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1192 wv
= xmalloc_widget_value ();
1200 /* Loop over all panes and items made during this call
1201 and construct a tree of widget_value objects.
1202 Ignore the panes and items made by previous calls to
1203 single_submenu, even though those are also in menu_items. */
1205 while (i
< menu_items_used
)
1207 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1209 submenu_stack
[submenu_depth
++] = save_wv
;
1214 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1217 save_wv
= submenu_stack
[--submenu_depth
];
1220 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1221 && submenu_depth
!= 0)
1222 i
+= MENU_ITEMS_PANE_LENGTH
;
1223 /* Ignore a nil in the item list.
1224 It's meaningful only for dialog boxes. */
1225 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1227 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1229 /* Create a new pane. */
1230 Lisp_Object pane_name
, prefix
;
1232 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1233 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1234 pane_string
= (NILP (pane_name
)
1235 ? "" : (char *) XSTRING (pane_name
)->data
);
1236 /* If there is just one top-level pane, put all its items directly
1237 under the top-level menu. */
1238 if (menu_items_n_panes
== 1)
1241 /* If the pane has a meaningful name,
1242 make the pane a top-level menu item
1243 with its items as a submenu beneath it. */
1244 if (strcmp (pane_string
, ""))
1246 wv
= xmalloc_widget_value ();
1250 first_wv
->contents
= wv
;
1251 wv
->name
= pane_string
;
1252 /* Ignore the @ that means "separate pane".
1253 This is a kludge, but this isn't worth more time. */
1254 if (!NILP (prefix
) && wv
->name
[0] == '@')
1261 i
+= MENU_ITEMS_PANE_LENGTH
;
1265 /* Create a new item within current pane. */
1266 Lisp_Object item_name
, enable
, descrip
, def
;
1267 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1268 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1270 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1271 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1273 wv
= xmalloc_widget_value ();
1277 save_wv
->contents
= wv
;
1279 wv
->name
= (char *) XSTRING (item_name
)->data
;
1280 if (!NILP (descrip
))
1281 wv
->key
= (char *) XSTRING (descrip
)->data
;
1283 /* The EMACS_INT cast avoids a warning. There's no problem
1284 as long as pointers have enough bits to hold small integers. */
1285 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1286 wv
->enabled
= !NILP (enable
);
1289 i
+= MENU_ITEMS_ITEM_LENGTH
;
1293 /* If we have just one "menu item"
1294 that was originally a button, return it by itself. */
1295 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1297 wv
= first_wv
->contents
;
1298 free_widget_value (first_wv
);
1305 /* Set the contents of the menubar widgets of frame F.
1306 The argument FIRST_TIME is currently ignored;
1307 it is set the first time this is called, from initialize_frame_menubar. */
1310 set_frame_menubar (f
, first_time
, deep_p
)
1315 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1316 Lisp_Object tail
, items
, frame
;
1317 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1320 /* We must not change the menubar when actually in use. */
1321 if (f
->output_data
.w32
->menubar_active
)
1324 XSETFRAME (Vmenu_updating_frame
, f
);
1326 if (! menubar_widget
)
1328 else if (pending_menu_activation
&& !deep_p
)
1331 wv
= xmalloc_widget_value ();
1332 wv
->name
= "menubar";
1339 /* Make a widget-value tree representing the entire menu trees. */
1341 struct buffer
*prev
= current_buffer
;
1343 int specpdl_count
= specpdl_ptr
- specpdl
;
1344 int previous_menu_items_used
= f
->menu_bar_items_used
;
1345 Lisp_Object
*previous_items
1346 = (Lisp_Object
*) alloca (previous_menu_items_used
1347 * sizeof (Lisp_Object
));
1349 /* If we are making a new widget, its contents are empty,
1350 do always reinitialize them. */
1351 if (! menubar_widget
)
1352 previous_menu_items_used
= 0;
1354 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1355 specbind (Qinhibit_quit
, Qt
);
1356 /* Don't let the debugger step into this code
1357 because it is not reentrant. */
1358 specbind (Qdebug_on_next_call
, Qnil
);
1360 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1361 if (NILP (Voverriding_local_map_menu_flag
))
1363 specbind (Qoverriding_terminal_local_map
, Qnil
);
1364 specbind (Qoverriding_local_map
, Qnil
);
1367 set_buffer_internal_1 (XBUFFER (buffer
));
1369 /* Run the Lucid hook. */
1370 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1371 /* If it has changed current-menubar from previous value,
1372 really recompute the menubar from the value. */
1373 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1374 call0 (Qrecompute_lucid_menubar
);
1375 safe_run_hooks (Qmenu_bar_update_hook
);
1376 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1378 items
= FRAME_MENU_BAR_ITEMS (f
);
1380 inhibit_garbage_collection ();
1382 /* Save the frame's previous menu bar contents data. */
1383 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1384 previous_menu_items_used
* sizeof (Lisp_Object
));
1386 /* Fill in the current menu bar contents. */
1387 menu_items
= f
->menu_bar_vector
;
1388 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1390 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1392 Lisp_Object key
, string
, maps
;
1394 key
= XVECTOR (items
)->contents
[i
];
1395 string
= XVECTOR (items
)->contents
[i
+ 1];
1396 maps
= XVECTOR (items
)->contents
[i
+ 2];
1400 wv
= single_submenu (key
, string
, maps
);
1404 first_wv
->contents
= wv
;
1405 /* Don't set wv->name here; GC during the loop might relocate it. */
1410 finish_menu_items ();
1412 set_buffer_internal_1 (prev
);
1413 unbind_to (specpdl_count
, Qnil
);
1415 /* If there has been no change in the Lisp-level contents
1416 of the menu bar, skip redisplaying it. Just exit. */
1418 for (i
= 0; i
< previous_menu_items_used
; i
++)
1419 if (menu_items_used
== i
1420 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1422 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1424 free_menubar_widget_value_tree (first_wv
);
1430 /* Now GC cannot happen during the lifetime of the widget_value,
1431 so it's safe to store data from a Lisp_String. */
1432 wv
= first_wv
->contents
;
1433 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1436 string
= XVECTOR (items
)->contents
[i
+ 1];
1439 wv
->name
= (char *) XSTRING (string
)->data
;
1443 f
->menu_bar_vector
= menu_items
;
1444 f
->menu_bar_items_used
= menu_items_used
;
1449 /* Make a widget-value tree containing
1450 just the top level menu bar strings.
1452 It turns out to be worth comparing the new contents with the
1453 previous contents to avoid unnecessary rebuilding even of just
1454 the top-level menu bar, which turns out to be fairly slow. We
1455 co-opt f->menu_bar_vector for this purpose, since its contents
1456 are effectively discarded at this point anyway.
1458 Note that the lisp-level hooks have already been run by
1459 update_menu_bar - it's kinda a shame the code is duplicated
1460 above as well for deep_p, but there we are. */
1462 items
= FRAME_MENU_BAR_ITEMS (f
);
1464 /* If there has been no change in the Lisp-level contents of just
1465 the menu bar itself, skip redisplaying it. Just exit. */
1466 for (i
= 0; i
< f
->menu_bar_items_used
; i
+= 4)
1467 if (i
== XVECTOR (items
)->size
1468 || (XVECTOR (f
->menu_bar_vector
)->contents
[i
]
1469 != XVECTOR (items
)->contents
[i
]))
1471 if (i
== XVECTOR (items
)->size
&& i
== f
->menu_bar_items_used
&& i
!= 0)
1474 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1478 string
= XVECTOR (items
)->contents
[i
+ 1];
1482 wv
= xmalloc_widget_value ();
1483 wv
->name
= (char *) XSTRING (string
)->data
;
1486 /* This prevents lwlib from assuming this
1487 menu item is really supposed to be empty. */
1488 /* The EMACS_INT cast avoids a warning.
1489 This value just has to be different from small integers. */
1490 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1495 first_wv
->contents
= wv
;
1499 /* Remember the contents of FRAME_MENU_BAR_ITEMS (f) in
1500 f->menu_bar_vector, so we can check whether the top-level
1501 menubar contents have changed next time. */
1502 if (XVECTOR (f
->menu_bar_vector
)->size
< XVECTOR (items
)->size
)
1504 = Fmake_vector (make_number (XVECTOR (items
)->size
), Qnil
);
1505 bcopy (XVECTOR (items
)->contents
,
1506 XVECTOR (f
->menu_bar_vector
)->contents
,
1507 XVECTOR (items
)->size
* sizeof (Lisp_Object
));
1508 f
->menu_bar_items_used
= XVECTOR (items
)->size
;
1511 /* Create or update the menu bar widget. */
1517 /* Empty current menubar, rather than creating a fresh one. */
1518 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1523 menubar_widget
= CreateMenu ();
1525 fill_in_menu (menubar_widget
, first_wv
->contents
);
1527 free_menubar_widget_value_tree (first_wv
);
1530 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1532 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1533 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1534 /* Causes flicker when menu bar is updated
1535 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1537 /* Force the window size to be recomputed so that the frame's text
1538 area remains the same, if menubar has just been created. */
1539 if (old_widget
== NULL
)
1540 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1546 /* Called from Fx_create_frame to create the initial menubar of a frame
1547 before it is mapped, so that the window is mapped with the menubar already
1548 there instead of us tacking it on later and thrashing the window after it
1552 initialize_frame_menubar (f
)
1555 /* This function is called before the first chance to redisplay
1556 the frame. It has to be, so the frame will have the right size. */
1557 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1558 set_frame_menubar (f
, 1, 1);
1561 /* Get rid of the menu bar of frame F, and free its storage.
1562 This is used when deleting a frame, and when turning off the menu bar. */
1565 free_frame_menubar (f
)
1571 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1572 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1573 f
->output_data
.w32
->menubar_widget
= NULL
;
1581 /* w32_menu_show actually displays a menu using the panes and items in
1582 menu_items and returns the value selected from it; we assume input
1583 is blocked by the caller. */
1585 /* F is the frame the menu is for.
1586 X and Y are the frame-relative specified position,
1587 relative to the inside upper left corner of the frame F.
1588 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1589 KEYMAPS is 1 if this menu was specified with keymaps;
1590 in that case, we return a list containing the chosen item's value
1591 and perhaps also the pane's prefix.
1592 TITLE is the specified menu title.
1593 ERROR is a place to store an error message string in case of failure.
1594 (We return nil on failure, but the value doesn't actually matter.) */
1597 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1607 int menu_item_selection
;
1610 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1611 widget_value
**submenu_stack
1612 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1613 Lisp_Object
*subprefix_stack
1614 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1615 int submenu_depth
= 0;
1618 int next_release_must_exit
= 0;
1622 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1624 *error
= "Empty menu";
1628 /* Create a tree of widget_value objects
1629 representing the panes and their items. */
1630 wv
= xmalloc_widget_value ();
1637 /* Loop over all panes and items, filling in the tree. */
1639 while (i
< menu_items_used
)
1641 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1643 submenu_stack
[submenu_depth
++] = save_wv
;
1649 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1652 save_wv
= submenu_stack
[--submenu_depth
];
1656 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1657 && submenu_depth
!= 0)
1658 i
+= MENU_ITEMS_PANE_LENGTH
;
1659 /* Ignore a nil in the item list.
1660 It's meaningful only for dialog boxes. */
1661 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1663 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1665 /* Create a new pane. */
1666 Lisp_Object pane_name
, prefix
;
1668 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1669 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1670 pane_string
= (NILP (pane_name
)
1671 ? "" : (char *) XSTRING (pane_name
)->data
);
1672 /* If there is just one top-level pane, put all its items directly
1673 under the top-level menu. */
1674 if (menu_items_n_panes
== 1)
1677 /* If the pane has a meaningful name,
1678 make the pane a top-level menu item
1679 with its items as a submenu beneath it. */
1680 if (!keymaps
&& strcmp (pane_string
, ""))
1682 wv
= xmalloc_widget_value ();
1686 first_wv
->contents
= wv
;
1687 wv
->name
= pane_string
;
1688 if (keymaps
&& !NILP (prefix
))
1695 else if (first_pane
)
1701 i
+= MENU_ITEMS_PANE_LENGTH
;
1705 /* Create a new item within current pane. */
1706 Lisp_Object item_name
, enable
, descrip
, def
;
1707 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1708 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1710 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1711 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1713 wv
= xmalloc_widget_value ();
1717 save_wv
->contents
= wv
;
1718 wv
->name
= (char *) XSTRING (item_name
)->data
;
1719 if (!NILP (descrip
))
1720 wv
->key
= (char *) XSTRING (descrip
)->data
;
1722 /* Use the contents index as call_data, since we are
1723 restricted to 16-bits.. */
1724 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1725 wv
->enabled
= !NILP (enable
);
1728 i
+= MENU_ITEMS_ITEM_LENGTH
;
1732 /* Deal with the title, if it is non-nil. */
1735 widget_value
*wv_title
= xmalloc_widget_value ();
1736 widget_value
*wv_sep
= xmalloc_widget_value ();
1738 /* Maybe replace this separator with a bitmap or owner-draw item
1739 so that it looks better. Having two separators looks odd. */
1740 wv_sep
->name
= "--";
1741 wv_sep
->next
= first_wv
->contents
;
1743 wv_title
->name
= (char *) XSTRING (title
)->data
;
1744 /* Handle title specially, so it looks better. */
1745 wv_title
->title
= True
;
1746 wv_title
->next
= wv_sep
;
1747 first_wv
->contents
= wv_title
;
1750 /* Actually create the menu. */
1751 menu
= CreatePopupMenu ();
1752 fill_in_menu (menu
, first_wv
->contents
);
1754 /* Adjust coordinates to be root-window-relative. */
1757 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1759 /* Free the widget_value objects we used to specify the contents. */
1760 free_menubar_widget_value_tree (first_wv
);
1762 /* No selection has been chosen yet. */
1763 menu_item_selection
= 0;
1765 /* Display the menu. */
1766 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1767 WM_EMACS_TRACKPOPUPMENU
,
1768 (WPARAM
)menu
, (LPARAM
)&pos
);
1770 /* Clean up extraneous mouse events which might have been generated
1772 discard_mouse_events ();
1776 /* Find the selected item, and its pane, to return
1777 the proper value. */
1778 if (menu_item_selection
!= 0)
1780 Lisp_Object prefix
, entry
;
1784 while (i
< menu_items_used
)
1786 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1788 subprefix_stack
[submenu_depth
++] = prefix
;
1792 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1794 prefix
= subprefix_stack
[--submenu_depth
];
1797 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1800 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1801 i
+= MENU_ITEMS_PANE_LENGTH
;
1803 /* Ignore a nil in the item list.
1804 It's meaningful only for dialog boxes. */
1805 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1810 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1811 if (menu_item_selection
== i
)
1817 entry
= Fcons (entry
, Qnil
);
1819 entry
= Fcons (prefix
, entry
);
1820 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1821 if (!NILP (subprefix_stack
[j
]))
1822 entry
= Fcons (subprefix_stack
[j
], entry
);
1826 i
+= MENU_ITEMS_ITEM_LENGTH
;
1835 static char * button_names
[] = {
1836 "button1", "button2", "button3", "button4", "button5",
1837 "button6", "button7", "button8", "button9", "button10" };
1840 w32_dialog_show (f
, keymaps
, title
, error
)
1846 int i
, nb_buttons
=0;
1847 char dialog_name
[6];
1848 int menu_item_selection
;
1850 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1852 /* Number of elements seen so far, before boundary. */
1854 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1855 int boundary_seen
= 0;
1859 if (menu_items_n_panes
> 1)
1861 *error
= "Multiple panes in dialog box";
1865 /* Create a tree of widget_value objects
1866 representing the text label and buttons. */
1868 Lisp_Object pane_name
, prefix
;
1870 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1871 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1872 pane_string
= (NILP (pane_name
)
1873 ? "" : (char *) XSTRING (pane_name
)->data
);
1874 prev_wv
= xmalloc_widget_value ();
1875 prev_wv
->value
= pane_string
;
1876 if (keymaps
&& !NILP (prefix
))
1878 prev_wv
->enabled
= 1;
1879 prev_wv
->name
= "message";
1882 /* Loop over all panes and items, filling in the tree. */
1883 i
= MENU_ITEMS_PANE_LENGTH
;
1884 while (i
< menu_items_used
)
1887 /* Create a new item within current pane. */
1888 Lisp_Object item_name
, enable
, descrip
;
1889 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1890 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1892 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1894 if (NILP (item_name
))
1896 free_menubar_widget_value_tree (first_wv
);
1897 *error
= "Submenu in dialog items";
1900 if (EQ (item_name
, Qquote
))
1902 /* This is the boundary between left-side elts
1903 and right-side elts. Stop incrementing right_count. */
1908 if (nb_buttons
>= 9)
1910 free_menubar_widget_value_tree (first_wv
);
1911 *error
= "Too many dialog items";
1915 wv
= xmalloc_widget_value ();
1917 wv
->name
= (char *) button_names
[nb_buttons
];
1918 if (!NILP (descrip
))
1919 wv
->key
= (char *) XSTRING (descrip
)->data
;
1920 wv
->value
= (char *) XSTRING (item_name
)->data
;
1921 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1922 wv
->enabled
= !NILP (enable
);
1925 if (! boundary_seen
)
1929 i
+= MENU_ITEMS_ITEM_LENGTH
;
1932 /* If the boundary was not specified,
1933 by default put half on the left and half on the right. */
1934 if (! boundary_seen
)
1935 left_count
= nb_buttons
- nb_buttons
/ 2;
1937 wv
= xmalloc_widget_value ();
1938 wv
->name
= dialog_name
;
1940 /* Dialog boxes use a really stupid name encoding
1941 which specifies how many buttons to use
1942 and how many buttons are on the right.
1943 The Q means something also. */
1944 dialog_name
[0] = 'Q';
1945 dialog_name
[1] = '0' + nb_buttons
;
1946 dialog_name
[2] = 'B';
1947 dialog_name
[3] = 'R';
1948 /* Number of buttons to put on the right. */
1949 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1951 wv
->contents
= first_wv
;
1955 /* Actually create the dialog. */
1957 dialog_id
= widget_id_tick
++;
1958 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1959 f
->output_data
.w32
->widget
, 1, 0,
1960 dialog_selection_callback
, 0);
1961 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1964 /* Free the widget_value objects we used to specify the contents. */
1965 free_menubar_widget_value_tree (first_wv
);
1967 /* No selection has been chosen yet. */
1968 menu_item_selection
= 0;
1970 /* Display the menu. */
1972 lw_pop_up_all_widgets (dialog_id
);
1973 popup_activated_flag
= 1;
1975 /* Process events that apply to the menu. */
1976 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1978 lw_destroy_all_widgets (dialog_id
);
1981 /* Find the selected item, and its pane, to return
1982 the proper value. */
1983 if (menu_item_selection
!= 0)
1989 while (i
< menu_items_used
)
1993 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1996 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1997 i
+= MENU_ITEMS_PANE_LENGTH
;
2002 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2003 if (menu_item_selection
== i
)
2007 entry
= Fcons (entry
, Qnil
);
2009 entry
= Fcons (prefix
, entry
);
2013 i
+= MENU_ITEMS_ITEM_LENGTH
;
2022 /* Is this item a separator? */
2024 name_is_separator (name
)
2027 /* Check if name string consists of only dashes ('-') */
2028 while (*name
== '-') name
++;
2029 return (*name
== '\0');
2033 /* Indicate boundary between left and right. */
2035 add_left_right_boundary (HMENU menu
)
2037 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2041 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2046 if (name_is_separator (wv
->name
))
2047 fuFlags
= MF_SEPARATOR
;
2051 fuFlags
= MF_STRING
;
2053 fuFlags
= MF_STRING
| MF_GRAYED
;
2055 if (wv
->key
!= NULL
)
2057 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2058 strcpy (out_string
, wv
->name
);
2059 strcat (out_string
, "\t");
2060 strcat (out_string
, wv
->key
);
2063 out_string
= wv
->name
;
2065 if (wv
->title
|| wv
->call_data
== 0)
2067 #if 0 /* no GC while popup menu is active */
2068 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2069 strcpy (out_string
, wv
->name
);
2071 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2078 return AppendMenu (menu
,
2080 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2081 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2084 /* Construct native Windows menu(bar) based on widget_value tree. */
2086 fill_in_menu (HMENU menu
, widget_value
*wv
)
2088 int items_added
= 0;
2090 for ( ; wv
!= NULL
; wv
= wv
->next
)
2094 HMENU sub_menu
= CreatePopupMenu ();
2096 if (sub_menu
== NULL
)
2099 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2100 !add_menu_item (menu
, wv
, sub_menu
))
2102 DestroyMenu (sub_menu
);
2108 if (!add_menu_item (menu
, wv
, NULL
))
2115 #endif /* HAVE_MENUS */
2119 staticpro (&menu_items
);
2122 Qdebug_on_next_call
= intern ("debug-on-next-call");
2123 staticpro (&Qdebug_on_next_call
);
2125 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2126 "Frame for which we are updating a menu.\n\
2127 The enable predicate for a menu command should check this variable.");
2128 Vmenu_updating_frame
= Qnil
;
2130 defsubr (&Sx_popup_menu
);
2132 defsubr (&Sx_popup_dialog
);