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. */
25 #include "termhooks.h"
29 #include "blockinput.h"
32 /* This may include sys/types.h, and that somehow loses
33 if this is not done before the other system files. */
36 /* Load sys/types.h if not already loaded.
37 In some systems loading it twice is suicidal. */
39 #include <sys/types.h>
42 #include "dispextern.h"
44 /******************************************************************/
45 /* Definitions copied from lwlib.h */
47 typedef void * XtPointer
;
53 typedef enum _change_type
61 typedef struct _widget_value
65 /* value (meaning depend on widget type) */
67 /* keyboard equivalent. no implications for XtTranslations */
71 /* true if selected */
73 /* true if menu title */
76 /* true if was edited (maintained by get_value) */
78 /* true if has changed (maintained by lw library) */
80 /* true if this widget itself has changed,
81 but not counting the other widgets found in the `next' field. */
82 change_type this_one_change
;
84 /* Contents of the sub-widgets, also selected slot for checkbox */
85 struct _widget_value
* contents
;
86 /* data passed to callback */
88 /* next one in the list */
89 struct _widget_value
* next
;
91 /* slot for the toolkit dependent part. Always initialize to NULL. */
93 /* tell us if we should free the toolkit data slot when freeing the
94 widget_value itself. */
95 Boolean free_toolkit_data
;
97 /* we resource the widget_value structures; this points to the next
98 one on the free list if this one has been deallocated.
100 struct _widget_value
*free_list
;
104 /* LocalAlloc/Free is a reasonably good allocator. */
105 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
106 #define free_widget_value(wv) LocalFree (wv)
108 /******************************************************************/
110 #define min(x,y) (((x) < (y)) ? (x) : (y))
111 #define max(x,y) (((x) > (y)) ? (x) : (y))
118 Lisp_Object Vmenu_updating_frame
;
120 Lisp_Object Qdebug_on_next_call
;
122 extern Lisp_Object Qmenu_bar
;
123 extern Lisp_Object Qmouse_click
, Qevent_kind
;
125 extern Lisp_Object QCtoggle
, QCradio
;
127 extern Lisp_Object Voverriding_local_map
;
128 extern Lisp_Object Voverriding_local_map_menu_flag
;
130 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
132 extern Lisp_Object Qmenu_bar_update_hook
;
134 void set_frame_menubar ();
136 static Lisp_Object
w32_menu_show ();
137 static Lisp_Object
w32_dialog_show ();
139 static void keymap_panes ();
140 static void single_keymap_panes ();
141 static void single_menu_item ();
142 static void list_of_panes ();
143 static void list_of_items ();
145 /* This holds a Lisp vector that holds the results of decoding
146 the keymaps or alist-of-alists that specify a menu.
148 It describes the panes and items within the panes.
150 Each pane is described by 3 elements in the vector:
151 t, the pane name, the pane's prefix key.
152 Then follow the pane's items, with 5 elements per item:
153 the item string, the enable flag, the item's value,
154 the definition, and the equivalent keyboard key's description string.
156 In some cases, multiple levels of menus may be described.
157 A single vector slot containing nil indicates the start of a submenu.
158 A single vector slot containing lambda indicates the end of a submenu.
159 The submenu follows a menu item which is the way to reach the submenu.
161 A single vector slot containing quote indicates that the
162 following items should appear on the right of a dialog box.
164 Using a Lisp vector to hold this information while we decode it
165 takes care of protecting all the data from GC. */
167 #define MENU_ITEMS_PANE_NAME 1
168 #define MENU_ITEMS_PANE_PREFIX 2
169 #define MENU_ITEMS_PANE_LENGTH 3
171 #define MENU_ITEMS_ITEM_NAME 0
172 #define MENU_ITEMS_ITEM_ENABLE 1
173 #define MENU_ITEMS_ITEM_VALUE 2
174 #define MENU_ITEMS_ITEM_EQUIV_KEY 3
175 #define MENU_ITEMS_ITEM_DEFINITION 4
176 #define MENU_ITEMS_ITEM_LENGTH 5
178 static Lisp_Object menu_items
;
180 /* Number of slots currently allocated in menu_items. */
181 static int menu_items_allocated
;
183 /* This is the index in menu_items of the first empty slot. */
184 static int menu_items_used
;
186 /* The number of panes currently recorded in menu_items,
187 excluding those within submenus. */
188 static int menu_items_n_panes
;
190 /* Current depth within submenus. */
191 static int menu_items_submenu_depth
;
193 /* Flag which when set indicates a dialog or menu has been posted by
194 Xt on behalf of one of the widget sets. */
195 static int popup_activated_flag
;
197 /* This is set nonzero after the user activates the menu bar, and set
198 to zero again after the menu bars are redisplayed by prepare_menu_bar.
199 While it is nonzero, all calls to set_frame_menubar go deep.
201 I don't understand why this is needed, but it does seem to be
202 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
204 int pending_menu_activation
;
207 /* Return the frame whose ->output_data.w32->menubar_widget equals
208 MENU, or 0 if none. */
210 static struct frame
*
211 menubar_id_to_frame (HMENU menu
)
213 Lisp_Object tail
, frame
;
216 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
219 if (!GC_FRAMEP (frame
))
222 if (!FRAME_W32_P (f
))
224 if (f
->output_data
.w32
->menubar_widget
== menu
)
230 /* Initialize the menu_items structure if we haven't already done so.
231 Also mark it as currently empty. */
236 if (NILP (menu_items
))
238 menu_items_allocated
= 60;
239 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
243 menu_items_n_panes
= 0;
244 menu_items_submenu_depth
= 0;
247 /* Call at the end of generating the data in menu_items.
248 This fills in the number of items in the last pane. */
255 /* Call when finished using the data for the current menu
259 discard_menu_items ()
261 /* Free the structure if it is especially large.
262 Otherwise, hold on to it, to save time. */
263 if (menu_items_allocated
> 200)
266 menu_items_allocated
= 0;
270 /* Make the menu_items vector twice as large. */
276 int old_size
= menu_items_allocated
;
279 menu_items_allocated
*= 2;
280 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
281 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
282 old_size
* sizeof (Lisp_Object
));
285 /* Begin a submenu. */
288 push_submenu_start ()
290 if (menu_items_used
+ 1 > menu_items_allocated
)
293 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
294 menu_items_submenu_depth
++;
302 if (menu_items_used
+ 1 > menu_items_allocated
)
305 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
306 menu_items_submenu_depth
--;
309 /* Indicate boundary between left and right. */
312 push_left_right_boundary ()
314 if (menu_items_used
+ 1 > menu_items_allocated
)
317 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
320 /* Start a new menu pane in menu_items..
321 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
324 push_menu_pane (name
, prefix_vec
)
325 Lisp_Object name
, prefix_vec
;
327 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
330 if (menu_items_submenu_depth
== 0)
331 menu_items_n_panes
++;
332 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
333 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
334 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
337 /* Push one menu item into the current pane.
338 NAME is the string to display. ENABLE if non-nil means
339 this item can be selected. KEY is the key generated by
340 choosing this item, or nil if this item doesn't really have a definition.
341 DEF is the definition of this item.
342 EQUIV is the textual description of the keyboard equivalent for
343 this item (or nil if none). */
346 push_menu_item (name
, enable
, key
, def
, equiv
)
347 Lisp_Object name
, enable
, key
, def
, equiv
;
349 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
352 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
356 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
359 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
360 and generate menu panes for them in menu_items.
361 If NOTREAL is nonzero,
362 don't bother really computing whether an item is enabled. */
365 keymap_panes (keymaps
, nmaps
, notreal
)
366 Lisp_Object
*keymaps
;
374 /* Loop over the given keymaps, making a pane for each map.
375 But don't make a pane that is empty--ignore that map instead.
376 P is the number of panes we have made so far. */
377 for (mapno
= 0; mapno
< nmaps
; mapno
++)
378 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
380 finish_menu_items ();
383 /* This is a recursive subroutine of keymap_panes.
384 It handles one keymap, KEYMAP.
385 The other arguments are passed along
386 or point to local variables of the previous function.
387 If NOTREAL is nonzero, only check for equivalent key bindings, don't
388 evaluate expressions in menu items and don't make any menu.
390 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
393 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
395 Lisp_Object pane_name
;
400 Lisp_Object pending_maps
= Qnil
;
401 Lisp_Object tail
, item
;
402 struct gcpro gcpro1
, gcpro2
;
408 push_menu_pane (pane_name
, prefix
);
411 /* Remember index for first item in this pane so we can go back and
412 add a prefix when (if) we see the first button. After that, notbuttons
413 is set to 0, to mark that we have seen a button and all non button
414 items need a prefix. */
415 notbuttons
= menu_items_used
;
418 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
420 GCPRO2 (keymap
, pending_maps
);
421 /* Look at each key binding, and if it is a menu item add it
425 single_menu_item (XCAR (item
), XCDR (item
),
426 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
427 else if (VECTORP (item
))
429 /* Loop over the char values represented in the vector. */
430 int len
= XVECTOR (item
)->size
;
432 for (c
= 0; c
< len
; c
++)
434 Lisp_Object character
;
435 XSETFASTINT (character
, c
);
436 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
437 &pending_maps
, notreal
, maxdepth
, ¬buttons
);
443 /* Process now any submenus which want to be panes at this level. */
444 while (!NILP (pending_maps
))
446 Lisp_Object elt
, eltcdr
, string
;
447 elt
= Fcar (pending_maps
);
449 string
= XCAR (eltcdr
);
450 /* We no longer discard the @ from the beginning of the string here.
451 Instead, we do this in w32_menu_show. */
452 single_keymap_panes (Fcar (elt
), string
,
453 XCDR (eltcdr
), notreal
, maxdepth
- 1);
454 pending_maps
= Fcdr (pending_maps
);
458 /* This is a subroutine of single_keymap_panes that handles one
460 KEY is a key in a keymap and ITEM is its binding.
461 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
463 If NOTREAL is nonzero, only check for equivalent key bindings, don't
464 evaluate expressions in menu items and don't make any menu.
465 If we encounter submenus deeper than MAXDEPTH levels, ignore them.
466 NOTBUTTONS_PTR is only used when simulating toggle boxes and radio
467 buttons. It points to variable notbuttons in single_keymap_panes,
468 which keeps track of if we have seen a button in this menu or not. */
471 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
,
473 Lisp_Object key
, item
;
474 Lisp_Object
*pending_maps_ptr
;
475 int maxdepth
, notreal
;
478 Lisp_Object def
, map
, item_string
, enabled
;
479 struct gcpro gcpro1
, gcpro2
;
482 /* Parse the menu item and leave the result in item_properties. */
484 res
= parse_menu_item (item
, notreal
, 0);
487 return; /* Not a menu item. */
489 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
493 /* We don't want to make a menu, just traverse the keymaps to
494 precompute equivalent key bindings. */
496 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
500 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
501 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
503 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
506 /* An enabled separate pane. Remember this to handle it later. */
507 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
513 /* Simulate radio buttons and toggle boxes by putting a prefix in
516 Lisp_Object prefix
= Qnil
;
517 Lisp_Object type
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
];
521 = XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
];
524 /* The first button. Line up previous items in this menu. */
526 int index
= *notbuttons_ptr
; /* Index for first item this menu. */
529 while (index
< menu_items_used
)
532 = XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
];
536 submenu
++; /* Skip sub menu. */
538 else if (EQ (tem
, Qlambda
))
541 submenu
--; /* End sub menu. */
543 else if (EQ (tem
, Qt
))
544 index
+= 3; /* Skip new pane marker. */
545 else if (EQ (tem
, Qquote
))
546 index
++; /* Skip a left, right divider. */
549 if (!submenu
&& XSTRING (tem
)->data
[0] != '\0'
550 && XSTRING (tem
)->data
[0] != '-')
551 XVECTOR (menu_items
)->contents
[index
+ MENU_ITEMS_ITEM_NAME
]
552 = concat2 (build_string (" "), tem
);
553 index
+= MENU_ITEMS_ITEM_LENGTH
;
559 /* Calculate prefix, if any, for this item. */
560 if (EQ (type
, QCtoggle
))
561 prefix
= build_string (NILP (selected
) ? "[ ] " : "[X] ");
562 else if (EQ (type
, QCradio
))
563 prefix
= build_string (NILP (selected
) ? "( ) " : "(*) ");
565 /* Not a button. If we have earlier buttons, then we need a prefix. */
566 else if (!*notbuttons_ptr
&& XSTRING (item_string
)->data
[0] != '\0'
567 && XSTRING (item_string
)->data
[0] != '-')
568 prefix
= build_string (" ");
571 item_string
= concat2 (prefix
, item_string
);
573 #endif /* not HAVE_BOXES */
577 /* Indicate visually that this is a submenu. */
578 item_string
= concat2 (item_string
, build_string (" >"));
581 push_menu_item (item_string
, enabled
, key
,
582 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
583 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
]);
586 /* Display a submenu using the toolkit. */
587 if (! (NILP (map
) || NILP (enabled
)))
589 push_submenu_start ();
590 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
596 /* Push all the panes and items of a menu described by the
597 alist-of-alists MENU.
598 This handles old-fashioned calls to x-popup-menu. */
608 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
610 Lisp_Object elt
, pane_name
, pane_data
;
612 pane_name
= Fcar (elt
);
613 CHECK_STRING (pane_name
, 0);
614 push_menu_pane (pane_name
, Qnil
);
615 pane_data
= Fcdr (elt
);
616 CHECK_CONS (pane_data
, 0);
617 list_of_items (pane_data
);
620 finish_menu_items ();
623 /* Push the items in a single pane defined by the alist PANE. */
629 Lisp_Object tail
, item
, item1
;
631 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
635 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
);
636 else if (NILP (item
))
637 push_left_right_boundary ();
640 CHECK_CONS (item
, 0);
642 CHECK_STRING (item1
, 1);
643 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
);
648 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
649 "Pop up a deck-of-cards menu and return user's selection.\n\
650 POSITION is a position specification. This is either a mouse button event\n\
651 or a list ((XOFFSET YOFFSET) WINDOW)\n\
652 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
653 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
654 This controls the position of the center of the first line\n\
655 in the first pane of the menu, not the top left of the menu as a whole.\n\
656 If POSITION is t, it means to use the current mouse position.\n\
658 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
659 The menu items come from key bindings that have a menu string as well as\n\
660 a definition; actually, the \"definition\" in such a key binding looks like\n\
661 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
662 the keymap as a top-level element.\n\n\
663 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
664 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
666 You can also use a list of keymaps as MENU.\n\
667 Then each keymap makes a separate pane.\n\
668 When MENU is a keymap or a list of keymaps, the return value\n\
669 is a list of events.\n\n\
671 Alternatively, you can specify a menu of multiple panes\n\
672 with a list of the form (TITLE PANE1 PANE2...),\n\
673 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
674 Each ITEM is normally a cons cell (STRING . VALUE);\n\
675 but a string can appear as an item--that makes a nonselectable line\n\
677 With this form of menu, the return value is VALUE from the chosen item.\n\
679 If POSITION is nil, don't display the menu at all, just precalculate the\n\
680 cached information about equivalent key sequences.")
682 Lisp_Object position
, menu
;
684 int number_of_panes
, panes
;
685 Lisp_Object keymap
, tem
;
689 Lisp_Object selection
;
692 Lisp_Object x
, y
, window
;
698 if (! NILP (position
))
702 /* Decode the first argument: find the window and the coordinates. */
703 if (EQ (position
, Qt
)
704 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
706 /* Use the mouse's current position. */
707 FRAME_PTR new_f
= selected_frame
;
708 Lisp_Object bar_window
;
712 if (mouse_position_hook
)
713 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
714 &part
, &x
, &y
, &time
);
716 XSETFRAME (window
, new_f
);
719 window
= selected_window
;
726 tem
= Fcar (position
);
729 window
= Fcar (Fcdr (position
));
731 y
= Fcar (Fcdr (tem
));
736 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
737 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
738 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
747 /* Decode where to put the menu. */
755 else if (WINDOWP (window
))
757 CHECK_LIVE_WINDOW (window
, 0);
758 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
760 xpos
= (FONT_WIDTH (f
->output_data
.w32
->font
)
761 * XFASTINT (XWINDOW (window
)->left
));
762 ypos
= (f
->output_data
.w32
->line_height
763 * XFASTINT (XWINDOW (window
)->top
));
766 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
767 but I don't want to make one now. */
768 CHECK_WINDOW (window
, 0);
773 XSETFRAME (Vmenu_updating_frame
, f
);
775 Vmenu_updating_frame
= Qnil
;
776 #endif /* HAVE_MENUS */
781 /* Decode the menu items from what was specified. */
783 keymap
= Fkeymapp (menu
);
786 tem
= Fkeymapp (Fcar (menu
));
789 /* We were given a keymap. Extract menu info from the keymap. */
791 keymap
= get_keymap (menu
);
793 /* Extract the detailed info to make one pane. */
794 keymap_panes (&menu
, 1, NILP (position
));
796 /* Search for a string appearing directly as an element of the keymap.
797 That string is the title of the menu. */
798 prompt
= map_prompt (keymap
);
799 if (NILP (title
) && !NILP (prompt
))
802 /* Make that be the pane title of the first pane. */
803 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
804 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
808 else if (!NILP (tem
))
810 /* We were given a list of keymaps. */
811 int nmaps
= XFASTINT (Flength (menu
));
813 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
818 /* The first keymap that has a prompt string
819 supplies the menu title. */
820 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
824 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
826 prompt
= map_prompt (keymap
);
827 if (NILP (title
) && !NILP (prompt
))
831 /* Extract the detailed info to make one pane. */
832 keymap_panes (maps
, nmaps
, NILP (position
));
834 /* Make the title be the pane title of the first pane. */
835 if (!NILP (title
) && menu_items_n_panes
>= 0)
836 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
842 /* We were given an old-fashioned menu. */
844 CHECK_STRING (title
, 1);
846 list_of_panes (Fcdr (menu
));
853 discard_menu_items ();
859 /* Display them in a menu. */
862 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
863 keymaps
, title
, &error_name
);
866 discard_menu_items ();
869 #endif /* HAVE_MENUS */
871 if (error_name
) error (error_name
);
877 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
878 "Pop up a dialog box and return user's selection.\n\
879 POSITION specifies which frame to use.\n\
880 This is normally a mouse button event or a window or frame.\n\
881 If POSITION is t, it means to use the frame the mouse is on.\n\
882 The dialog box appears in the middle of the specified frame.\n\
884 CONTENTS specifies the alternatives to display in the dialog box.\n\
885 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
886 Each ITEM is a cons cell (STRING . VALUE).\n\
887 The return value is VALUE from the chosen item.\n\n\
888 An ITEM may also be just a string--that makes a nonselectable item.\n\
889 An ITEM may also be nil--that means to put all preceding items\n\
890 on the left of the dialog box and all following items on the right.\n\
891 \(By default, approximately half appear on each side.)")
893 Lisp_Object position
, contents
;
900 /* Decode the first argument: find the window or frame to use. */
901 if (EQ (position
, Qt
)
902 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
904 #if 0 /* Using the frame the mouse is on may not be right. */
905 /* Use the mouse's current position. */
906 FRAME_PTR new_f
= selected_frame
;
907 Lisp_Object bar_window
;
912 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
915 XSETFRAME (window
, new_f
);
917 window
= selected_window
;
919 window
= selected_window
;
921 else if (CONSP (position
))
924 tem
= Fcar (position
);
926 window
= Fcar (Fcdr (position
));
929 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
930 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
933 else if (WINDOWP (position
) || FRAMEP (position
))
938 /* Decode where to put the menu. */
942 else if (WINDOWP (window
))
944 CHECK_LIVE_WINDOW (window
, 0);
945 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
948 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
949 but I don't want to make one now. */
950 CHECK_WINDOW (window
, 0);
953 /* Display a menu with these alternatives
954 in the middle of frame F. */
956 Lisp_Object x
, y
, frame
, newpos
;
957 XSETFRAME (frame
, f
);
958 XSETINT (x
, x_pixel_width (f
) / 2);
959 XSETINT (y
, x_pixel_height (f
) / 2);
960 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
962 return Fx_popup_menu (newpos
,
963 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
969 Lisp_Object selection
;
971 /* Decode the dialog items from what was specified. */
972 title
= Fcar (contents
);
973 CHECK_STRING (title
, 1);
975 list_of_panes (Fcons (contents
, Qnil
));
977 /* Display them in a dialog box. */
979 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
982 discard_menu_items ();
984 if (error_name
) error (error_name
);
990 /* Activate the menu bar of frame F.
991 This is called from keyboard.c when it gets the
992 menu_bar_activate_event out of the Emacs event queue.
994 To activate the menu bar, we signal to the input thread that it can
995 return from the WM_INITMENU message, allowing the normal Windows
996 processing of the menus.
998 But first we recompute the menu bar contents (the whole tree).
1000 This way we can safely execute Lisp code. */
1002 x_activate_menubar (f
)
1005 set_frame_menubar (f
, 0, 1);
1007 /* Lock out further menubar changes while active. */
1008 f
->output_data
.w32
->menubar_active
= 1;
1010 /* Signal input thread to return from WM_INITMENU. */
1011 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1014 /* This callback is called from the menu bar pulldown menu
1015 when the user makes a selection.
1016 Figure out what the user chose
1017 and put the appropriate events into the keyboard buffer. */
1020 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
1022 Lisp_Object prefix
, entry
;
1024 Lisp_Object
*subprefix_stack
;
1025 int submenu_depth
= 0;
1030 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1031 vector
= f
->menu_bar_vector
;
1034 while (i
< f
->menu_bar_items_used
)
1036 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
1038 subprefix_stack
[submenu_depth
++] = prefix
;
1042 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
1044 prefix
= subprefix_stack
[--submenu_depth
];
1047 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
1049 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1050 i
+= MENU_ITEMS_PANE_LENGTH
;
1054 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1055 /* The EMACS_INT cast avoids a warning. There's no problem
1056 as long as pointers have enough bits to hold small integers. */
1057 if ((int) (EMACS_INT
) client_data
== i
)
1060 struct input_event buf
;
1063 XSETFRAME (frame
, f
);
1064 buf
.kind
= menu_bar_event
;
1065 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1066 kbd_buffer_store_event (&buf
);
1068 for (j
= 0; j
< submenu_depth
; j
++)
1069 if (!NILP (subprefix_stack
[j
]))
1071 buf
.kind
= menu_bar_event
;
1072 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1073 kbd_buffer_store_event (&buf
);
1078 buf
.kind
= menu_bar_event
;
1079 buf
.frame_or_window
= Fcons (frame
, prefix
);
1080 kbd_buffer_store_event (&buf
);
1083 buf
.kind
= menu_bar_event
;
1084 buf
.frame_or_window
= Fcons (frame
, entry
);
1085 kbd_buffer_store_event (&buf
);
1089 i
+= MENU_ITEMS_ITEM_LENGTH
;
1094 /* Allocate a widget_value, blocking input. */
1097 xmalloc_widget_value ()
1099 widget_value
*value
;
1102 value
= malloc_widget_value ();
1108 /* This recursively calls free_widget_value on the tree of widgets.
1109 It must free all data that was malloc'ed for these widget_values.
1110 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1111 must be left alone. */
1114 free_menubar_widget_value_tree (wv
)
1119 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1121 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1123 free_menubar_widget_value_tree (wv
->contents
);
1124 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1128 free_menubar_widget_value_tree (wv
->next
);
1129 wv
->next
= (widget_value
*) 0xDEADBEEF;
1132 free_widget_value (wv
);
1136 /* Return a tree of widget_value structures for a menu bar item
1137 whose event type is ITEM_KEY (with string ITEM_NAME)
1138 and whose contents come from the list of keymaps MAPS. */
1140 static widget_value
*
1141 single_submenu (item_key
, item_name
, maps
)
1142 Lisp_Object item_key
, item_name
, maps
;
1144 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1146 int submenu_depth
= 0;
1149 Lisp_Object
*mapvec
;
1150 widget_value
**submenu_stack
;
1152 int previous_items
= menu_items_used
;
1153 int top_level_items
= 0;
1155 length
= Flength (maps
);
1156 len
= XINT (length
);
1158 /* Convert the list MAPS into a vector MAPVEC. */
1159 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1160 for (i
= 0; i
< len
; i
++)
1162 mapvec
[i
] = Fcar (maps
);
1166 menu_items_n_panes
= 0;
1168 /* Loop over the given keymaps, making a pane for each map.
1169 But don't make a pane that is empty--ignore that map instead. */
1170 for (i
= 0; i
< len
; i
++)
1172 if (SYMBOLP (mapvec
[i
])
1173 || (CONSP (mapvec
[i
])
1174 && NILP (Fkeymapp (mapvec
[i
]))))
1176 /* Here we have a command at top level in the menu bar
1177 as opposed to a submenu. */
1178 top_level_items
= 1;
1179 push_menu_pane (Qnil
, Qnil
);
1180 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
], Qnil
);
1183 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1186 /* Create a tree of widget_value objects
1187 representing the panes and their items. */
1190 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1191 wv
= xmalloc_widget_value ();
1199 /* Loop over all panes and items made during this call
1200 and construct a tree of widget_value objects.
1201 Ignore the panes and items made by previous calls to
1202 single_submenu, even though those are also in menu_items. */
1204 while (i
< menu_items_used
)
1206 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1208 submenu_stack
[submenu_depth
++] = save_wv
;
1213 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1216 save_wv
= submenu_stack
[--submenu_depth
];
1219 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1220 && submenu_depth
!= 0)
1221 i
+= MENU_ITEMS_PANE_LENGTH
;
1222 /* Ignore a nil in the item list.
1223 It's meaningful only for dialog boxes. */
1224 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1226 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1228 /* Create a new pane. */
1229 Lisp_Object pane_name
, prefix
;
1231 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1232 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1233 pane_string
= (NILP (pane_name
)
1234 ? "" : (char *) XSTRING (pane_name
)->data
);
1235 /* If there is just one top-level pane, put all its items directly
1236 under the top-level menu. */
1237 if (menu_items_n_panes
== 1)
1240 /* If the pane has a meaningful name,
1241 make the pane a top-level menu item
1242 with its items as a submenu beneath it. */
1243 if (strcmp (pane_string
, ""))
1245 wv
= xmalloc_widget_value ();
1249 first_wv
->contents
= wv
;
1250 wv
->name
= pane_string
;
1251 /* Ignore the @ that means "separate pane".
1252 This is a kludge, but this isn't worth more time. */
1253 if (!NILP (prefix
) && wv
->name
[0] == '@')
1260 i
+= MENU_ITEMS_PANE_LENGTH
;
1264 /* Create a new item within current pane. */
1265 Lisp_Object item_name
, enable
, descrip
, def
;
1266 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1267 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1269 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1270 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1272 wv
= xmalloc_widget_value ();
1276 save_wv
->contents
= wv
;
1278 wv
->name
= (char *) XSTRING (item_name
)->data
;
1279 if (!NILP (descrip
))
1280 wv
->key
= (char *) XSTRING (descrip
)->data
;
1282 /* The EMACS_INT cast avoids a warning. There's no problem
1283 as long as pointers have enough bits to hold small integers. */
1284 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1285 wv
->enabled
= !NILP (enable
);
1288 i
+= MENU_ITEMS_ITEM_LENGTH
;
1292 /* If we have just one "menu item"
1293 that was originally a button, return it by itself. */
1294 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1296 wv
= first_wv
->contents
;
1297 free_widget_value (first_wv
);
1304 /* Set the contents of the menubar widgets of frame F.
1305 The argument FIRST_TIME is currently ignored;
1306 it is set the first time this is called, from initialize_frame_menubar. */
1309 set_frame_menubar (f
, first_time
, deep_p
)
1314 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1315 Lisp_Object tail
, items
, frame
;
1316 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1319 /* We must not change the menubar when actually in use. */
1320 if (f
->output_data
.w32
->menubar_active
)
1323 XSETFRAME (Vmenu_updating_frame
, f
);
1325 if (! menubar_widget
)
1327 else if (pending_menu_activation
&& !deep_p
)
1330 wv
= xmalloc_widget_value ();
1331 wv
->name
= "menubar";
1338 /* Make a widget-value tree representing the entire menu trees. */
1340 struct buffer
*prev
= current_buffer
;
1342 int specpdl_count
= specpdl_ptr
- specpdl
;
1343 int previous_menu_items_used
= f
->menu_bar_items_used
;
1344 Lisp_Object
*previous_items
1345 = (Lisp_Object
*) alloca (previous_menu_items_used
1346 * sizeof (Lisp_Object
));
1348 /* If we are making a new widget, its contents are empty,
1349 do always reinitialize them. */
1350 if (! menubar_widget
)
1351 previous_menu_items_used
= 0;
1353 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1354 specbind (Qinhibit_quit
, Qt
);
1355 /* Don't let the debugger step into this code
1356 because it is not reentrant. */
1357 specbind (Qdebug_on_next_call
, Qnil
);
1359 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1360 if (NILP (Voverriding_local_map_menu_flag
))
1362 specbind (Qoverriding_terminal_local_map
, Qnil
);
1363 specbind (Qoverriding_local_map
, Qnil
);
1366 set_buffer_internal_1 (XBUFFER (buffer
));
1368 /* Run the Lucid hook. */
1369 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1370 /* If it has changed current-menubar from previous value,
1371 really recompute the menubar from the value. */
1372 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1373 call0 (Qrecompute_lucid_menubar
);
1374 safe_run_hooks (Qmenu_bar_update_hook
);
1375 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1377 items
= FRAME_MENU_BAR_ITEMS (f
);
1379 inhibit_garbage_collection ();
1381 /* Save the frame's previous menu bar contents data. */
1382 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1383 previous_menu_items_used
* sizeof (Lisp_Object
));
1385 /* Fill in the current menu bar contents. */
1386 menu_items
= f
->menu_bar_vector
;
1387 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1389 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1391 Lisp_Object key
, string
, maps
;
1393 key
= XVECTOR (items
)->contents
[i
];
1394 string
= XVECTOR (items
)->contents
[i
+ 1];
1395 maps
= XVECTOR (items
)->contents
[i
+ 2];
1399 wv
= single_submenu (key
, string
, maps
);
1403 first_wv
->contents
= wv
;
1404 /* Don't set wv->name here; GC during the loop might relocate it. */
1409 finish_menu_items ();
1411 set_buffer_internal_1 (prev
);
1412 unbind_to (specpdl_count
, Qnil
);
1414 /* If there has been no change in the Lisp-level contents
1415 of the menu bar, skip redisplaying it. Just exit. */
1417 for (i
= 0; i
< previous_menu_items_used
; i
++)
1418 if (menu_items_used
== i
1419 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1421 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1423 free_menubar_widget_value_tree (first_wv
);
1429 /* Now GC cannot happen during the lifetime of the widget_value,
1430 so it's safe to store data from a Lisp_String. */
1431 wv
= first_wv
->contents
;
1432 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1435 string
= XVECTOR (items
)->contents
[i
+ 1];
1438 wv
->name
= (char *) XSTRING (string
)->data
;
1442 f
->menu_bar_vector
= menu_items
;
1443 f
->menu_bar_items_used
= menu_items_used
;
1448 /* Make a widget-value tree containing
1449 just the top level menu bar strings.
1451 It turns out to be worth comparing the new contents with the
1452 previous contents to avoid unnecessary rebuilding even of just
1453 the top-level menu bar, which turns out to be fairly slow. We
1454 co-opt f->menu_bar_vector for this purpose, since its contents
1455 are effectively discarded at this point anyway.
1457 Note that the lisp-level hooks have already been run by
1458 update_menu_bar - it's kinda a shame the code is duplicated
1459 above as well for deep_p, but there we are. */
1461 items
= FRAME_MENU_BAR_ITEMS (f
);
1463 /* If there has been no change in the Lisp-level contents of just
1464 the menu bar itself, skip redisplaying it. Just exit. */
1465 for (i
= 0; i
< f
->menu_bar_items_used
; i
+= 4)
1466 if (i
== XVECTOR (items
)->size
1467 || (XVECTOR (f
->menu_bar_vector
)->contents
[i
]
1468 != XVECTOR (items
)->contents
[i
]))
1470 if (i
== XVECTOR (items
)->size
&& i
== f
->menu_bar_items_used
&& i
!= 0)
1473 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1477 string
= XVECTOR (items
)->contents
[i
+ 1];
1481 wv
= xmalloc_widget_value ();
1482 wv
->name
= (char *) XSTRING (string
)->data
;
1485 /* This prevents lwlib from assuming this
1486 menu item is really supposed to be empty. */
1487 /* The EMACS_INT cast avoids a warning.
1488 This value just has to be different from small integers. */
1489 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1494 first_wv
->contents
= wv
;
1498 /* Remember the contents of FRAME_MENU_BAR_ITEMS (f) in
1499 f->menu_bar_vector, so we can check whether the top-level
1500 menubar contents have changed next time. */
1501 if (XVECTOR (f
->menu_bar_vector
)->size
< XVECTOR (items
)->size
)
1503 = Fmake_vector (make_number (XVECTOR (items
)->size
), Qnil
);
1504 bcopy (XVECTOR (items
)->contents
,
1505 XVECTOR (f
->menu_bar_vector
)->contents
,
1506 XVECTOR (items
)->size
* sizeof (Lisp_Object
));
1507 f
->menu_bar_items_used
= XVECTOR (items
)->size
;
1510 /* Create or update the menu bar widget. */
1516 /* Empty current menubar, rather than creating a fresh one. */
1517 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1522 menubar_widget
= CreateMenu ();
1524 fill_in_menu (menubar_widget
, first_wv
->contents
);
1526 free_menubar_widget_value_tree (first_wv
);
1529 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1531 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1532 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1533 /* Causes flicker when menu bar is updated
1534 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1536 /* Force the window size to be recomputed so that the frame's text
1537 area remains the same, if menubar has just been created. */
1538 if (old_widget
== NULL
)
1539 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1545 /* Called from Fx_create_frame to create the initial menubar of a frame
1546 before it is mapped, so that the window is mapped with the menubar already
1547 there instead of us tacking it on later and thrashing the window after it
1551 initialize_frame_menubar (f
)
1554 /* This function is called before the first chance to redisplay
1555 the frame. It has to be, so the frame will have the right size. */
1556 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1557 set_frame_menubar (f
, 1, 1);
1560 /* Get rid of the menu bar of frame F, and free its storage.
1561 This is used when deleting a frame, and when turning off the menu bar. */
1564 free_frame_menubar (f
)
1570 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1571 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1572 f
->output_data
.w32
->menubar_widget
= NULL
;
1580 /* w32_menu_show actually displays a menu using the panes and items in
1581 menu_items and returns the value selected from it; we assume input
1582 is blocked by the caller. */
1584 /* F is the frame the menu is for.
1585 X and Y are the frame-relative specified position,
1586 relative to the inside upper left corner of the frame F.
1587 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1588 KEYMAPS is 1 if this menu was specified with keymaps;
1589 in that case, we return a list containing the chosen item's value
1590 and perhaps also the pane's prefix.
1591 TITLE is the specified menu title.
1592 ERROR is a place to store an error message string in case of failure.
1593 (We return nil on failure, but the value doesn't actually matter.) */
1596 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1606 int menu_item_selection
;
1609 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1610 widget_value
**submenu_stack
1611 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1612 Lisp_Object
*subprefix_stack
1613 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1614 int submenu_depth
= 0;
1617 int next_release_must_exit
= 0;
1621 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1623 *error
= "Empty menu";
1627 /* Create a tree of widget_value objects
1628 representing the panes and their items. */
1629 wv
= xmalloc_widget_value ();
1636 /* Loop over all panes and items, filling in the tree. */
1638 while (i
< menu_items_used
)
1640 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1642 submenu_stack
[submenu_depth
++] = save_wv
;
1648 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1651 save_wv
= submenu_stack
[--submenu_depth
];
1655 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1656 && submenu_depth
!= 0)
1657 i
+= MENU_ITEMS_PANE_LENGTH
;
1658 /* Ignore a nil in the item list.
1659 It's meaningful only for dialog boxes. */
1660 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1662 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1664 /* Create a new pane. */
1665 Lisp_Object pane_name
, prefix
;
1667 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1668 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1669 pane_string
= (NILP (pane_name
)
1670 ? "" : (char *) XSTRING (pane_name
)->data
);
1671 /* If there is just one top-level pane, put all its items directly
1672 under the top-level menu. */
1673 if (menu_items_n_panes
== 1)
1676 /* If the pane has a meaningful name,
1677 make the pane a top-level menu item
1678 with its items as a submenu beneath it. */
1679 if (!keymaps
&& strcmp (pane_string
, ""))
1681 wv
= xmalloc_widget_value ();
1685 first_wv
->contents
= wv
;
1686 wv
->name
= pane_string
;
1687 if (keymaps
&& !NILP (prefix
))
1694 else if (first_pane
)
1700 i
+= MENU_ITEMS_PANE_LENGTH
;
1704 /* Create a new item within current pane. */
1705 Lisp_Object item_name
, enable
, descrip
, def
;
1706 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1707 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1709 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1710 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1712 wv
= xmalloc_widget_value ();
1716 save_wv
->contents
= wv
;
1717 wv
->name
= (char *) XSTRING (item_name
)->data
;
1718 if (!NILP (descrip
))
1719 wv
->key
= (char *) XSTRING (descrip
)->data
;
1721 /* Use the contents index as call_data, since we are
1722 restricted to 16-bits.. */
1723 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1724 wv
->enabled
= !NILP (enable
);
1727 i
+= MENU_ITEMS_ITEM_LENGTH
;
1731 /* Deal with the title, if it is non-nil. */
1734 widget_value
*wv_title
= xmalloc_widget_value ();
1735 widget_value
*wv_sep
= xmalloc_widget_value ();
1737 /* Maybe replace this separator with a bitmap or owner-draw item
1738 so that it looks better. Having two separators looks odd. */
1739 wv_sep
->name
= "--";
1740 wv_sep
->next
= first_wv
->contents
;
1742 wv_title
->name
= (char *) XSTRING (title
)->data
;
1743 /* Handle title specially, so it looks better. */
1744 wv_title
->title
= True
;
1745 wv_title
->next
= wv_sep
;
1746 first_wv
->contents
= wv_title
;
1749 /* Actually create the menu. */
1750 menu
= CreatePopupMenu ();
1751 fill_in_menu (menu
, first_wv
->contents
);
1753 /* Adjust coordinates to be root-window-relative. */
1756 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1758 /* Free the widget_value objects we used to specify the contents. */
1759 free_menubar_widget_value_tree (first_wv
);
1761 /* No selection has been chosen yet. */
1762 menu_item_selection
= 0;
1764 /* Display the menu. */
1765 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1766 WM_EMACS_TRACKPOPUPMENU
,
1767 (WPARAM
)menu
, (LPARAM
)&pos
);
1769 /* Clean up extraneous mouse events which might have been generated
1771 discard_mouse_events ();
1775 /* Find the selected item, and its pane, to return
1776 the proper value. */
1777 if (menu_item_selection
!= 0)
1779 Lisp_Object prefix
, entry
;
1783 while (i
< menu_items_used
)
1785 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1787 subprefix_stack
[submenu_depth
++] = prefix
;
1791 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1793 prefix
= subprefix_stack
[--submenu_depth
];
1796 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1799 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1800 i
+= MENU_ITEMS_PANE_LENGTH
;
1802 /* Ignore a nil in the item list.
1803 It's meaningful only for dialog boxes. */
1804 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1809 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1810 if (menu_item_selection
== i
)
1816 entry
= Fcons (entry
, Qnil
);
1818 entry
= Fcons (prefix
, entry
);
1819 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1820 if (!NILP (subprefix_stack
[j
]))
1821 entry
= Fcons (subprefix_stack
[j
], entry
);
1825 i
+= MENU_ITEMS_ITEM_LENGTH
;
1834 static char * button_names
[] = {
1835 "button1", "button2", "button3", "button4", "button5",
1836 "button6", "button7", "button8", "button9", "button10" };
1839 w32_dialog_show (f
, keymaps
, title
, error
)
1845 int i
, nb_buttons
=0;
1846 char dialog_name
[6];
1847 int menu_item_selection
;
1849 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1851 /* Number of elements seen so far, before boundary. */
1853 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1854 int boundary_seen
= 0;
1858 if (menu_items_n_panes
> 1)
1860 *error
= "Multiple panes in dialog box";
1864 /* Create a tree of widget_value objects
1865 representing the text label and buttons. */
1867 Lisp_Object pane_name
, prefix
;
1869 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1870 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1871 pane_string
= (NILP (pane_name
)
1872 ? "" : (char *) XSTRING (pane_name
)->data
);
1873 prev_wv
= xmalloc_widget_value ();
1874 prev_wv
->value
= pane_string
;
1875 if (keymaps
&& !NILP (prefix
))
1877 prev_wv
->enabled
= 1;
1878 prev_wv
->name
= "message";
1881 /* Loop over all panes and items, filling in the tree. */
1882 i
= MENU_ITEMS_PANE_LENGTH
;
1883 while (i
< menu_items_used
)
1886 /* Create a new item within current pane. */
1887 Lisp_Object item_name
, enable
, descrip
;
1888 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1889 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1891 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1893 if (NILP (item_name
))
1895 free_menubar_widget_value_tree (first_wv
);
1896 *error
= "Submenu in dialog items";
1899 if (EQ (item_name
, Qquote
))
1901 /* This is the boundary between left-side elts
1902 and right-side elts. Stop incrementing right_count. */
1907 if (nb_buttons
>= 9)
1909 free_menubar_widget_value_tree (first_wv
);
1910 *error
= "Too many dialog items";
1914 wv
= xmalloc_widget_value ();
1916 wv
->name
= (char *) button_names
[nb_buttons
];
1917 if (!NILP (descrip
))
1918 wv
->key
= (char *) XSTRING (descrip
)->data
;
1919 wv
->value
= (char *) XSTRING (item_name
)->data
;
1920 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1921 wv
->enabled
= !NILP (enable
);
1924 if (! boundary_seen
)
1928 i
+= MENU_ITEMS_ITEM_LENGTH
;
1931 /* If the boundary was not specified,
1932 by default put half on the left and half on the right. */
1933 if (! boundary_seen
)
1934 left_count
= nb_buttons
- nb_buttons
/ 2;
1936 wv
= xmalloc_widget_value ();
1937 wv
->name
= dialog_name
;
1939 /* Dialog boxes use a really stupid name encoding
1940 which specifies how many buttons to use
1941 and how many buttons are on the right.
1942 The Q means something also. */
1943 dialog_name
[0] = 'Q';
1944 dialog_name
[1] = '0' + nb_buttons
;
1945 dialog_name
[2] = 'B';
1946 dialog_name
[3] = 'R';
1947 /* Number of buttons to put on the right. */
1948 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1950 wv
->contents
= first_wv
;
1954 /* Actually create the dialog. */
1956 dialog_id
= widget_id_tick
++;
1957 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1958 f
->output_data
.w32
->widget
, 1, 0,
1959 dialog_selection_callback
, 0);
1960 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1963 /* Free the widget_value objects we used to specify the contents. */
1964 free_menubar_widget_value_tree (first_wv
);
1966 /* No selection has been chosen yet. */
1967 menu_item_selection
= 0;
1969 /* Display the menu. */
1971 lw_pop_up_all_widgets (dialog_id
);
1972 popup_activated_flag
= 1;
1974 /* Process events that apply to the menu. */
1975 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1977 lw_destroy_all_widgets (dialog_id
);
1980 /* Find the selected item, and its pane, to return
1981 the proper value. */
1982 if (menu_item_selection
!= 0)
1988 while (i
< menu_items_used
)
1992 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1995 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1996 i
+= MENU_ITEMS_PANE_LENGTH
;
2001 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2002 if (menu_item_selection
== i
)
2006 entry
= Fcons (entry
, Qnil
);
2008 entry
= Fcons (prefix
, entry
);
2012 i
+= MENU_ITEMS_ITEM_LENGTH
;
2021 /* Is this item a separator? */
2023 name_is_separator (name
)
2026 /* Check if name string consists of only dashes ('-') */
2027 while (*name
== '-') name
++;
2028 return (*name
== '\0');
2032 /* Indicate boundary between left and right. */
2034 add_left_right_boundary (HMENU menu
)
2036 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2040 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2045 if (name_is_separator (wv
->name
))
2046 fuFlags
= MF_SEPARATOR
;
2050 fuFlags
= MF_STRING
;
2052 fuFlags
= MF_STRING
| MF_GRAYED
;
2054 if (wv
->key
!= NULL
)
2056 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2057 strcpy (out_string
, wv
->name
);
2058 strcat (out_string
, "\t");
2059 strcat (out_string
, wv
->key
);
2062 out_string
= wv
->name
;
2064 if (wv
->title
|| wv
->call_data
== 0)
2066 #if 0 /* no GC while popup menu is active */
2067 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2068 strcpy (out_string
, wv
->name
);
2070 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2077 return AppendMenu (menu
,
2079 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2080 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2083 /* Construct native Windows menu(bar) based on widget_value tree. */
2085 fill_in_menu (HMENU menu
, widget_value
*wv
)
2087 int items_added
= 0;
2089 for ( ; wv
!= NULL
; wv
= wv
->next
)
2093 HMENU sub_menu
= CreatePopupMenu ();
2095 if (sub_menu
== NULL
)
2098 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2099 !add_menu_item (menu
, wv
, sub_menu
))
2101 DestroyMenu (sub_menu
);
2107 if (!add_menu_item (menu
, wv
, NULL
))
2114 #endif /* HAVE_MENUS */
2118 staticpro (&menu_items
);
2121 Qdebug_on_next_call
= intern ("debug-on-next-call");
2122 staticpro (&Qdebug_on_next_call
);
2124 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2125 "Frame for which we are updating a menu.\n\
2126 The enable predicate for a menu command should check this variable.");
2127 Vmenu_updating_frame
= Qnil
;
2129 defsubr (&Sx_popup_menu
);
2131 defsubr (&Sx_popup_dialog
);