1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
26 #include "termhooks.h"
30 #include "blockinput.h"
35 /* This may include sys/types.h, and that somehow loses
36 if this is not done before the other system files. */
39 /* Load sys/types.h if not already loaded.
40 In some systems loading it twice is suicidal. */
42 #include <sys/types.h>
45 #include "dispextern.h"
47 #undef HAVE_MULTILINGUAL_MENU
48 #undef HAVE_DIALOGS /* NTEMACS_TODO: Implement native dialogs. */
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
53 typedef void * XtPointer
;
66 typedef struct _widget_value
70 /* value (meaning depend on widget type) */
72 /* keyboard equivalent. no implications for XtTranslations */
74 /* Help string or null if none. */
78 /* true if selected */
80 /* The type of a button. */
81 enum button_type button_type
;
82 /* true if menu title */
85 /* true if was edited (maintained by get_value) */
87 /* true if has changed (maintained by lw library) */
89 /* true if this widget itself has changed,
90 but not counting the other widgets found in the `next' field. */
91 change_type this_one_change
;
93 /* Contents of the sub-widgets, also selected slot for checkbox */
94 struct _widget_value
* contents
;
95 /* data passed to callback */
97 /* next one in the list */
98 struct _widget_value
* next
;
100 /* slot for the toolkit dependent part. Always initialize to NULL. */
102 /* tell us if we should free the toolkit data slot when freeing the
103 widget_value itself. */
104 Boolean free_toolkit_data
;
106 /* we resource the widget_value structures; this points to the next
107 one on the free list if this one has been deallocated.
109 struct _widget_value
*free_list
;
113 /* LocalAlloc/Free is a reasonably good allocator. */
114 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
115 #define free_widget_value(wv) LocalFree (wv)
117 /******************************************************************/
119 #define min(x,y) (((x) < (y)) ? (x) : (y))
120 #define max(x,y) (((x) > (y)) ? (x) : (y))
127 Lisp_Object Vmenu_updating_frame
;
129 Lisp_Object Qdebug_on_next_call
;
131 extern Lisp_Object Qmenu_bar
;
132 extern Lisp_Object Qmouse_click
, Qevent_kind
;
134 extern Lisp_Object QCtoggle
, QCradio
;
136 extern Lisp_Object Voverriding_local_map
;
137 extern Lisp_Object Voverriding_local_map_menu_flag
;
139 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
141 extern Lisp_Object Qmenu_bar_update_hook
;
143 void set_frame_menubar ();
145 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
146 Lisp_Object
, Lisp_Object
, Lisp_Object
,
147 Lisp_Object
, Lisp_Object
));
148 static Lisp_Object
w32_dialog_show ();
149 static Lisp_Object
w32_menu_show ();
151 static void keymap_panes ();
152 static void single_keymap_panes ();
153 static void single_menu_item ();
154 static void list_of_panes ();
155 static void list_of_items ();
157 /* This holds a Lisp vector that holds the results of decoding
158 the keymaps or alist-of-alists that specify a menu.
160 It describes the panes and items within the panes.
162 Each pane is described by 3 elements in the vector:
163 t, the pane name, the pane's prefix key.
164 Then follow the pane's items, with 5 elements per item:
165 the item string, the enable flag, the item's value,
166 the definition, and the equivalent keyboard key's description string.
168 In some cases, multiple levels of menus may be described.
169 A single vector slot containing nil indicates the start of a submenu.
170 A single vector slot containing lambda indicates the end of a submenu.
171 The submenu follows a menu item which is the way to reach the submenu.
173 A single vector slot containing quote indicates that the
174 following items should appear on the right of a dialog box.
176 Using a Lisp vector to hold this information while we decode it
177 takes care of protecting all the data from GC. */
179 #define MENU_ITEMS_PANE_NAME 1
180 #define MENU_ITEMS_PANE_PREFIX 2
181 #define MENU_ITEMS_PANE_LENGTH 3
185 MENU_ITEMS_ITEM_NAME
= 0,
186 MENU_ITEMS_ITEM_ENABLE
,
187 MENU_ITEMS_ITEM_VALUE
,
188 MENU_ITEMS_ITEM_EQUIV_KEY
,
189 MENU_ITEMS_ITEM_DEFINITION
,
190 MENU_ITEMS_ITEM_TYPE
,
191 MENU_ITEMS_ITEM_SELECTED
,
192 MENU_ITEMS_ITEM_HELP
,
193 MENU_ITEMS_ITEM_LENGTH
196 static Lisp_Object menu_items
;
198 /* Number of slots currently allocated in menu_items. */
199 static int menu_items_allocated
;
201 /* This is the index in menu_items of the first empty slot. */
202 static int menu_items_used
;
204 /* The number of panes currently recorded in menu_items,
205 excluding those within submenus. */
206 static int menu_items_n_panes
;
208 /* Current depth within submenus. */
209 static int menu_items_submenu_depth
;
211 /* Flag which when set indicates a dialog or menu has been posted by
212 Xt on behalf of one of the widget sets. */
213 static int popup_activated_flag
;
215 static int next_menubar_widget_id
;
217 /* This is set nonzero after the user activates the menu bar, and set
218 to zero again after the menu bars are redisplayed by prepare_menu_bar.
219 While it is nonzero, all calls to set_frame_menubar go deep.
221 I don't understand why this is needed, but it does seem to be
222 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
224 int pending_menu_activation
;
227 /* Return the frame whose ->output_data.w32->menubar_widget equals
230 static struct frame
*
231 menubar_id_to_frame (id
)
234 Lisp_Object tail
, frame
;
237 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
240 if (!GC_FRAMEP (frame
))
243 if (!FRAME_WINDOW_P (f
))
245 if (f
->output_data
.w32
->menubar_widget
== id
)
251 /* Initialize the menu_items structure if we haven't already done so.
252 Also mark it as currently empty. */
257 if (NILP (menu_items
))
259 menu_items_allocated
= 60;
260 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
264 menu_items_n_panes
= 0;
265 menu_items_submenu_depth
= 0;
268 /* Call at the end of generating the data in menu_items.
269 This fills in the number of items in the last pane. */
276 /* Call when finished using the data for the current menu
280 discard_menu_items ()
282 /* Free the structure if it is especially large.
283 Otherwise, hold on to it, to save time. */
284 if (menu_items_allocated
> 200)
287 menu_items_allocated
= 0;
291 /* Make the menu_items vector twice as large. */
297 int old_size
= menu_items_allocated
;
300 menu_items_allocated
*= 2;
301 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
302 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
303 old_size
* sizeof (Lisp_Object
));
306 /* Begin a submenu. */
309 push_submenu_start ()
311 if (menu_items_used
+ 1 > menu_items_allocated
)
314 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qnil
;
315 menu_items_submenu_depth
++;
323 if (menu_items_used
+ 1 > menu_items_allocated
)
326 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qlambda
;
327 menu_items_submenu_depth
--;
330 /* Indicate boundary between left and right. */
333 push_left_right_boundary ()
335 if (menu_items_used
+ 1 > menu_items_allocated
)
338 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qquote
;
341 /* Start a new menu pane in menu_items..
342 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
345 push_menu_pane (name
, prefix_vec
)
346 Lisp_Object name
, prefix_vec
;
348 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
351 if (menu_items_submenu_depth
== 0)
352 menu_items_n_panes
++;
353 XVECTOR (menu_items
)->contents
[menu_items_used
++] = Qt
;
354 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
355 XVECTOR (menu_items
)->contents
[menu_items_used
++] = prefix_vec
;
358 /* Push one menu item into the current pane. NAME is the string to
359 display. ENABLE if non-nil means this item can be selected. KEY
360 is the key generated by choosing this item, or nil if this item
361 doesn't really have a definition. DEF is the definition of this
362 item. EQUIV is the textual description of the keyboard equivalent
363 for this item (or nil if none). TYPE is the type of this menu
364 item, one of nil, `toggle' or `radio'. */
367 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
368 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
370 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
373 XVECTOR (menu_items
)->contents
[menu_items_used
++] = name
;
374 XVECTOR (menu_items
)->contents
[menu_items_used
++] = enable
;
375 XVECTOR (menu_items
)->contents
[menu_items_used
++] = key
;
376 XVECTOR (menu_items
)->contents
[menu_items_used
++] = equiv
;
377 XVECTOR (menu_items
)->contents
[menu_items_used
++] = def
;
378 XVECTOR (menu_items
)->contents
[menu_items_used
++] = type
;
379 XVECTOR (menu_items
)->contents
[menu_items_used
++] = selected
;
380 XVECTOR (menu_items
)->contents
[menu_items_used
++] = help
;
383 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
384 and generate menu panes for them in menu_items.
385 If NOTREAL is nonzero,
386 don't bother really computing whether an item is enabled. */
389 keymap_panes (keymaps
, nmaps
, notreal
)
390 Lisp_Object
*keymaps
;
398 /* Loop over the given keymaps, making a pane for each map.
399 But don't make a pane that is empty--ignore that map instead.
400 P is the number of panes we have made so far. */
401 for (mapno
= 0; mapno
< nmaps
; mapno
++)
402 single_keymap_panes (keymaps
[mapno
], Qnil
, Qnil
, notreal
, 10);
404 finish_menu_items ();
407 /* This is a recursive subroutine of keymap_panes.
408 It handles one keymap, KEYMAP.
409 The other arguments are passed along
410 or point to local variables of the previous function.
411 If NOTREAL is nonzero, only check for equivalent key bindings, don't
412 evaluate expressions in menu items and don't make any menu.
414 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
417 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
419 Lisp_Object pane_name
;
424 Lisp_Object pending_maps
= Qnil
;
425 Lisp_Object tail
, item
;
426 struct gcpro gcpro1
, gcpro2
;
431 push_menu_pane (pane_name
, prefix
);
433 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
435 GCPRO2 (keymap
, pending_maps
);
436 /* Look at each key binding, and if it is a menu item add it
440 single_menu_item (XCAR (item
), XCDR (item
),
441 &pending_maps
, notreal
, maxdepth
);
442 else if (VECTORP (item
))
444 /* Loop over the char values represented in the vector. */
445 int len
= XVECTOR (item
)->size
;
447 for (c
= 0; c
< len
; c
++)
449 Lisp_Object character
;
450 XSETFASTINT (character
, c
);
451 single_menu_item (character
, XVECTOR (item
)->contents
[c
],
452 &pending_maps
, notreal
, maxdepth
);
458 /* Process now any submenus which want to be panes at this level. */
459 while (!NILP (pending_maps
))
461 Lisp_Object elt
, eltcdr
, string
;
462 elt
= Fcar (pending_maps
);
464 string
= XCAR (eltcdr
);
465 /* We no longer discard the @ from the beginning of the string here.
466 Instead, we do this in w32_menu_show. */
467 single_keymap_panes (Fcar (elt
), string
,
468 XCDR (eltcdr
), notreal
, maxdepth
- 1);
469 pending_maps
= Fcdr (pending_maps
);
473 /* This is a subroutine of single_keymap_panes that handles one
475 KEY is a key in a keymap and ITEM is its binding.
476 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
478 If NOTREAL is nonzero, only check for equivalent key bindings, don't
479 evaluate expressions in menu items and don't make any menu.
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
483 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
484 Lisp_Object key
, item
;
485 Lisp_Object
*pending_maps_ptr
;
486 int maxdepth
, notreal
;
488 Lisp_Object map
, item_string
, enabled
;
489 struct gcpro gcpro1
, gcpro2
;
492 /* Parse the menu item and leave the result in item_properties. */
494 res
= parse_menu_item (item
, notreal
, 0);
497 return; /* Not a menu item. */
499 map
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_MAP
];
503 /* We don't want to make a menu, just traverse the keymaps to
504 precompute equivalent key bindings. */
506 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
510 enabled
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_ENABLE
];
511 item_string
= XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_NAME
];
513 if (!NILP (map
) && XSTRING (item_string
)->data
[0] == '@')
516 /* An enabled separate pane. Remember this to handle it later. */
517 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
522 push_menu_item (item_string
, enabled
, key
,
523 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_DEF
],
524 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_KEYEQ
],
525 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_TYPE
],
526 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_SELECTED
],
527 XVECTOR (item_properties
)->contents
[ITEM_PROPERTY_HELP
]);
529 /* Display a submenu using the toolkit. */
530 if (! (NILP (map
) || NILP (enabled
)))
532 push_submenu_start ();
533 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
538 /* Push all the panes and items of a menu described by the
539 alist-of-alists MENU.
540 This handles old-fashioned calls to x-popup-menu. */
550 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
552 Lisp_Object elt
, pane_name
, pane_data
;
554 pane_name
= Fcar (elt
);
555 CHECK_STRING (pane_name
, 0);
556 push_menu_pane (pane_name
, Qnil
);
557 pane_data
= Fcdr (elt
);
558 CHECK_CONS (pane_data
, 0);
559 list_of_items (pane_data
);
562 finish_menu_items ();
565 /* Push the items in a single pane defined by the alist PANE. */
571 Lisp_Object tail
, item
, item1
;
573 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
577 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
578 else if (NILP (item
))
579 push_left_right_boundary ();
582 CHECK_CONS (item
, 0);
584 CHECK_STRING (item1
, 1);
585 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
590 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
591 "Pop up a deck-of-cards menu and return user's selection.\n\
592 POSITION is a position specification. This is either a mouse button event\n\
593 or a list ((XOFFSET YOFFSET) WINDOW)\n\
594 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
595 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
596 This controls the position of the center of the first line\n\
597 in the first pane of the menu, not the top left of the menu as a whole.\n\
598 If POSITION is t, it means to use the current mouse position.\n\
600 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
601 The menu items come from key bindings that have a menu string as well as\n\
602 a definition; actually, the \"definition\" in such a key binding looks like\n\
603 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
604 the keymap as a top-level element.\n\n\
605 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
606 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
608 You can also use a list of keymaps as MENU.\n\
609 Then each keymap makes a separate pane.\n\
610 When MENU is a keymap or a list of keymaps, the return value\n\
611 is a list of events.\n\n\
613 Alternatively, you can specify a menu of multiple panes\n\
614 with a list of the form (TITLE PANE1 PANE2...),\n\
615 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
616 Each ITEM is normally a cons cell (STRING . VALUE);\n\
617 but a string can appear as an item--that makes a nonselectable line\n\
619 With this form of menu, the return value is VALUE from the chosen item.\n\
621 If POSITION is nil, don't display the menu at all, just precalculate the\n\
622 cached information about equivalent key sequences.")
624 Lisp_Object position
, menu
;
626 Lisp_Object keymap
, tem
;
630 Lisp_Object selection
;
632 Lisp_Object x
, y
, window
;
638 if (! NILP (position
))
642 /* Decode the first argument: find the window and the coordinates. */
643 if (EQ (position
, Qt
)
644 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
646 /* Use the mouse's current position. */
647 FRAME_PTR new_f
= SELECTED_FRAME ();
648 Lisp_Object bar_window
;
649 enum scroll_bar_part part
;
652 if (mouse_position_hook
)
653 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
654 &part
, &x
, &y
, &time
);
656 XSETFRAME (window
, new_f
);
659 window
= selected_window
;
666 tem
= Fcar (position
);
669 window
= Fcar (Fcdr (position
));
671 y
= Fcar (Fcdr (tem
));
676 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
677 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
678 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
687 /* Decode where to put the menu. */
695 else if (WINDOWP (window
))
697 CHECK_LIVE_WINDOW (window
, 0);
698 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
700 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
701 * XFASTINT (XWINDOW (window
)->left
));
702 ypos
= (FRAME_LINE_HEIGHT (f
)
703 * XFASTINT (XWINDOW (window
)->top
));
706 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
707 but I don't want to make one now. */
708 CHECK_WINDOW (window
, 0);
713 XSETFRAME (Vmenu_updating_frame
, f
);
715 Vmenu_updating_frame
= Qnil
;
716 #endif /* HAVE_MENUS */
721 /* Decode the menu items from what was specified. */
723 keymap
= Fkeymapp (menu
);
726 tem
= Fkeymapp (Fcar (menu
));
729 /* We were given a keymap. Extract menu info from the keymap. */
731 keymap
= get_keymap (menu
);
733 /* Extract the detailed info to make one pane. */
734 keymap_panes (&menu
, 1, NILP (position
));
736 /* Search for a string appearing directly as an element of the keymap.
737 That string is the title of the menu. */
738 prompt
= map_prompt (keymap
);
739 if (NILP (title
) && !NILP (prompt
))
742 /* Make that be the pane title of the first pane. */
743 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
744 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
748 else if (!NILP (tem
))
750 /* We were given a list of keymaps. */
751 int nmaps
= XFASTINT (Flength (menu
));
753 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
758 /* The first keymap that has a prompt string
759 supplies the menu title. */
760 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
764 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
766 prompt
= map_prompt (keymap
);
767 if (NILP (title
) && !NILP (prompt
))
771 /* Extract the detailed info to make one pane. */
772 keymap_panes (maps
, nmaps
, NILP (position
));
774 /* Make the title be the pane title of the first pane. */
775 if (!NILP (title
) && menu_items_n_panes
>= 0)
776 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
782 /* We were given an old-fashioned menu. */
784 CHECK_STRING (title
, 1);
786 list_of_panes (Fcdr (menu
));
793 discard_menu_items ();
799 /* Display them in a menu. */
802 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
803 keymaps
, title
, &error_name
);
806 discard_menu_items ();
809 #endif /* HAVE_MENUS */
811 if (error_name
) error (error_name
);
817 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
818 "Pop up a dialog box and return user's selection.\n\
819 POSITION specifies which frame to use.\n\
820 This is normally a mouse button event or a window or frame.\n\
821 If POSITION is t, it means to use the frame the mouse is on.\n\
822 The dialog box appears in the middle of the specified frame.\n\
824 CONTENTS specifies the alternatives to display in the dialog box.\n\
825 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
826 Each ITEM is a cons cell (STRING . VALUE).\n\
827 The return value is VALUE from the chosen item.\n\n\
828 An ITEM may also be just a string--that makes a nonselectable item.\n\
829 An ITEM may also be nil--that means to put all preceding items\n\
830 on the left of the dialog box and all following items on the right.\n\
831 \(By default, approximately half appear on each side.)")
833 Lisp_Object position
, contents
;
840 /* Decode the first argument: find the window or frame to use. */
841 if (EQ (position
, Qt
)
842 || (CONSP (position
) && EQ (XCAR (position
), Qmenu_bar
)))
844 #if 0 /* Using the frame the mouse is on may not be right. */
845 /* Use the mouse's current position. */
846 FRAME_PTR new_f
= SELECTED_FRAME ();
847 Lisp_Object bar_window
;
852 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
855 XSETFRAME (window
, new_f
);
857 window
= selected_window
;
859 window
= selected_window
;
861 else if (CONSP (position
))
864 tem
= Fcar (position
);
866 window
= Fcar (Fcdr (position
));
869 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
870 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
873 else if (WINDOWP (position
) || FRAMEP (position
))
878 /* Decode where to put the menu. */
882 else if (WINDOWP (window
))
884 CHECK_LIVE_WINDOW (window
, 0);
885 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
888 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
889 but I don't want to make one now. */
890 CHECK_WINDOW (window
, 0);
893 /* Display a menu with these alternatives
894 in the middle of frame F. */
896 Lisp_Object x
, y
, frame
, newpos
;
897 XSETFRAME (frame
, f
);
898 XSETINT (x
, x_pixel_width (f
) / 2);
899 XSETINT (y
, x_pixel_height (f
) / 2);
900 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
902 return Fx_popup_menu (newpos
,
903 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
905 #else /* HAVE_DIALOGS */
909 Lisp_Object selection
;
911 /* Decode the dialog items from what was specified. */
912 title
= Fcar (contents
);
913 CHECK_STRING (title
, 1);
915 list_of_panes (Fcons (contents
, Qnil
));
917 /* Display them in a dialog box. */
919 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
922 discard_menu_items ();
924 if (error_name
) error (error_name
);
927 #endif /* HAVE_DIALOGS */
930 /* Activate the menu bar of frame F.
931 This is called from keyboard.c when it gets the
932 menu_bar_activate_event out of the Emacs event queue.
934 To activate the menu bar, we signal to the input thread that it can
935 return from the WM_INITMENU message, allowing the normal Windows
936 processing of the menus.
938 But first we recompute the menu bar contents (the whole tree).
940 This way we can safely execute Lisp code. */
943 x_activate_menubar (f
)
946 set_frame_menubar (f
, 0, 1);
948 /* Lock out further menubar changes while active. */
949 f
->output_data
.w32
->menubar_active
= 1;
951 /* Signal input thread to return from WM_INITMENU. */
952 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
955 /* This callback is called from the menu bar pulldown menu
956 when the user makes a selection.
957 Figure out what the user chose
958 and put the appropriate events into the keyboard buffer. */
961 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
963 Lisp_Object prefix
, entry
;
965 Lisp_Object
*subprefix_stack
;
966 int submenu_depth
= 0;
971 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
972 vector
= f
->menu_bar_vector
;
975 while (i
< f
->menu_bar_items_used
)
977 if (EQ (XVECTOR (vector
)->contents
[i
], Qnil
))
979 subprefix_stack
[submenu_depth
++] = prefix
;
983 else if (EQ (XVECTOR (vector
)->contents
[i
], Qlambda
))
985 prefix
= subprefix_stack
[--submenu_depth
];
988 else if (EQ (XVECTOR (vector
)->contents
[i
], Qt
))
990 prefix
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
991 i
+= MENU_ITEMS_PANE_LENGTH
;
995 entry
= XVECTOR (vector
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
996 /* The EMACS_INT cast avoids a warning. There's no problem
997 as long as pointers have enough bits to hold small integers. */
998 if ((int) (EMACS_INT
) client_data
== i
)
1001 struct input_event buf
;
1004 XSETFRAME (frame
, f
);
1005 buf
.kind
= menu_bar_event
;
1006 buf
.frame_or_window
= Fcons (frame
, Fcons (Qmenu_bar
, Qnil
));
1007 kbd_buffer_store_event (&buf
);
1009 for (j
= 0; j
< submenu_depth
; j
++)
1010 if (!NILP (subprefix_stack
[j
]))
1012 buf
.kind
= menu_bar_event
;
1013 buf
.frame_or_window
= Fcons (frame
, subprefix_stack
[j
]);
1014 kbd_buffer_store_event (&buf
);
1019 buf
.kind
= menu_bar_event
;
1020 buf
.frame_or_window
= Fcons (frame
, prefix
);
1021 kbd_buffer_store_event (&buf
);
1024 buf
.kind
= menu_bar_event
;
1025 buf
.frame_or_window
= Fcons (frame
, entry
);
1026 kbd_buffer_store_event (&buf
);
1030 i
+= MENU_ITEMS_ITEM_LENGTH
;
1035 /* Allocate a widget_value, blocking input. */
1038 xmalloc_widget_value ()
1040 widget_value
*value
;
1043 value
= malloc_widget_value ();
1049 /* This recursively calls free_widget_value on the tree of widgets.
1050 It must free all data that was malloc'ed for these widget_values.
1051 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1052 must be left alone. */
1055 free_menubar_widget_value_tree (wv
)
1060 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1062 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1064 free_menubar_widget_value_tree (wv
->contents
);
1065 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1069 free_menubar_widget_value_tree (wv
->next
);
1070 wv
->next
= (widget_value
*) 0xDEADBEEF;
1073 free_widget_value (wv
);
1077 /* Return a tree of widget_value structures for a menu bar item
1078 whose event type is ITEM_KEY (with string ITEM_NAME)
1079 and whose contents come from the list of keymaps MAPS. */
1081 static widget_value
*
1082 single_submenu (item_key
, item_name
, maps
)
1083 Lisp_Object item_key
, item_name
, maps
;
1085 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1087 int submenu_depth
= 0;
1090 Lisp_Object
*mapvec
;
1091 widget_value
**submenu_stack
;
1092 int previous_items
= menu_items_used
;
1093 int top_level_items
= 0;
1095 length
= Flength (maps
);
1096 len
= XINT (length
);
1098 /* Convert the list MAPS into a vector MAPVEC. */
1099 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1100 for (i
= 0; i
< len
; i
++)
1102 mapvec
[i
] = Fcar (maps
);
1106 menu_items_n_panes
= 0;
1108 /* Loop over the given keymaps, making a pane for each map.
1109 But don't make a pane that is empty--ignore that map instead. */
1110 for (i
= 0; i
< len
; i
++)
1112 if (SYMBOLP (mapvec
[i
])
1113 || (CONSP (mapvec
[i
])
1114 && NILP (Fkeymapp (mapvec
[i
]))))
1116 /* Here we have a command at top level in the menu bar
1117 as opposed to a submenu. */
1118 top_level_items
= 1;
1119 push_menu_pane (Qnil
, Qnil
);
1120 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1121 Qnil
, Qnil
, Qnil
, Qnil
);
1124 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1127 /* Create a tree of widget_value objects
1128 representing the panes and their items. */
1131 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1132 wv
= xmalloc_widget_value ();
1136 wv
->button_type
= BUTTON_TYPE_NONE
;
1141 /* Loop over all panes and items made during this call
1142 and construct a tree of widget_value objects.
1143 Ignore the panes and items made by previous calls to
1144 single_submenu, even though those are also in menu_items. */
1146 while (i
< menu_items_used
)
1148 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1150 submenu_stack
[submenu_depth
++] = save_wv
;
1155 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1158 save_wv
= submenu_stack
[--submenu_depth
];
1161 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1162 && submenu_depth
!= 0)
1163 i
+= MENU_ITEMS_PANE_LENGTH
;
1164 /* Ignore a nil in the item list.
1165 It's meaningful only for dialog boxes. */
1166 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1168 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1170 /* Create a new pane. */
1171 Lisp_Object pane_name
, prefix
;
1173 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1174 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1175 #ifndef HAVE_MULTILINGUAL_MENU
1176 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1177 pane_name
= ENCODE_SYSTEM (pane_name
);
1179 pane_string
= (NILP (pane_name
)
1180 ? "" : (char *) XSTRING (pane_name
)->data
);
1181 /* If there is just one top-level pane, put all its items directly
1182 under the top-level menu. */
1183 if (menu_items_n_panes
== 1)
1186 /* If the pane has a meaningful name,
1187 make the pane a top-level menu item
1188 with its items as a submenu beneath it. */
1189 if (strcmp (pane_string
, ""))
1191 wv
= xmalloc_widget_value ();
1195 first_wv
->contents
= wv
;
1196 wv
->name
= pane_string
;
1197 /* Ignore the @ that means "separate pane".
1198 This is a kludge, but this isn't worth more time. */
1199 if (!NILP (prefix
) && wv
->name
[0] == '@')
1203 wv
->button_type
= BUTTON_TYPE_NONE
;
1207 i
+= MENU_ITEMS_PANE_LENGTH
;
1211 /* Create a new item within current pane. */
1212 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1215 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1216 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1218 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1219 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1220 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1221 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1222 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1224 #ifndef HAVE_MULTILINGUAL_MENU
1225 if (STRING_MULTIBYTE (item_name
))
1226 item_name
= ENCODE_SYSTEM (item_name
);
1227 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1228 descrip
= ENCODE_SYSTEM (descrip
);
1231 wv
= xmalloc_widget_value ();
1235 save_wv
->contents
= wv
;
1237 wv
->name
= (char *) XSTRING (item_name
)->data
;
1238 if (!NILP (descrip
))
1239 wv
->key
= (char *) XSTRING (descrip
)->data
;
1241 /* The EMACS_INT cast avoids a warning. There's no problem
1242 as long as pointers have enough bits to hold small integers. */
1243 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1244 wv
->enabled
= !NILP (enable
);
1247 wv
->button_type
= BUTTON_TYPE_NONE
;
1248 else if (EQ (type
, QCradio
))
1249 wv
->button_type
= BUTTON_TYPE_RADIO
;
1250 else if (EQ (type
, QCtoggle
))
1251 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1255 wv
->selected
= !NILP (selected
);
1257 wv
->help
= (char *) XSTRING (help
)->data
;
1263 i
+= MENU_ITEMS_ITEM_LENGTH
;
1267 /* If we have just one "menu item"
1268 that was originally a button, return it by itself. */
1269 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1271 wv
= first_wv
->contents
;
1272 free_widget_value (first_wv
);
1279 /* Set the contents of the menubar widgets of frame F.
1280 The argument FIRST_TIME is currently ignored;
1281 it is set the first time this is called, from initialize_frame_menubar. */
1284 set_frame_menubar (f
, first_time
, deep_p
)
1289 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1291 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1294 /* We must not change the menubar when actually in use. */
1295 if (f
->output_data
.w32
->menubar_active
)
1298 XSETFRAME (Vmenu_updating_frame
, f
);
1300 if (! menubar_widget
)
1302 else if (pending_menu_activation
&& !deep_p
)
1305 wv
= xmalloc_widget_value ();
1306 wv
->name
= "menubar";
1309 wv
->button_type
= BUTTON_TYPE_NONE
;
1314 /* Make a widget-value tree representing the entire menu trees. */
1316 struct buffer
*prev
= current_buffer
;
1318 int specpdl_count
= specpdl_ptr
- specpdl
;
1319 int previous_menu_items_used
= f
->menu_bar_items_used
;
1320 Lisp_Object
*previous_items
1321 = (Lisp_Object
*) alloca (previous_menu_items_used
1322 * sizeof (Lisp_Object
));
1324 /* If we are making a new widget, its contents are empty,
1325 do always reinitialize them. */
1326 if (! menubar_widget
)
1327 previous_menu_items_used
= 0;
1329 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1330 specbind (Qinhibit_quit
, Qt
);
1331 /* Don't let the debugger step into this code
1332 because it is not reentrant. */
1333 specbind (Qdebug_on_next_call
, Qnil
);
1335 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1336 if (NILP (Voverriding_local_map_menu_flag
))
1338 specbind (Qoverriding_terminal_local_map
, Qnil
);
1339 specbind (Qoverriding_local_map
, Qnil
);
1342 set_buffer_internal_1 (XBUFFER (buffer
));
1344 /* Run the Lucid hook. */
1345 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1346 /* If it has changed current-menubar from previous value,
1347 really recompute the menubar from the value. */
1348 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1349 call0 (Qrecompute_lucid_menubar
);
1350 safe_run_hooks (Qmenu_bar_update_hook
);
1351 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1353 items
= FRAME_MENU_BAR_ITEMS (f
);
1355 inhibit_garbage_collection ();
1357 /* Save the frame's previous menu bar contents data. */
1358 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1359 previous_menu_items_used
* sizeof (Lisp_Object
));
1361 /* Fill in the current menu bar contents. */
1362 menu_items
= f
->menu_bar_vector
;
1363 menu_items_allocated
= XVECTOR (menu_items
)->size
;
1365 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1367 Lisp_Object key
, string
, maps
;
1369 key
= XVECTOR (items
)->contents
[i
];
1370 string
= XVECTOR (items
)->contents
[i
+ 1];
1371 maps
= XVECTOR (items
)->contents
[i
+ 2];
1375 wv
= single_submenu (key
, string
, maps
);
1379 first_wv
->contents
= wv
;
1380 /* Don't set wv->name here; GC during the loop might relocate it. */
1382 wv
->button_type
= BUTTON_TYPE_NONE
;
1386 finish_menu_items ();
1388 set_buffer_internal_1 (prev
);
1389 unbind_to (specpdl_count
, Qnil
);
1391 /* If there has been no change in the Lisp-level contents
1392 of the menu bar, skip redisplaying it. Just exit. */
1394 for (i
= 0; i
< previous_menu_items_used
; i
++)
1395 if (menu_items_used
== i
1396 || (!EQ (previous_items
[i
], XVECTOR (menu_items
)->contents
[i
])))
1398 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1400 free_menubar_widget_value_tree (first_wv
);
1406 /* Now GC cannot happen during the lifetime of the widget_value,
1407 so it's safe to store data from a Lisp_String. */
1408 wv
= first_wv
->contents
;
1409 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1412 string
= XVECTOR (items
)->contents
[i
+ 1];
1415 wv
->name
= (char *) XSTRING (string
)->data
;
1419 f
->menu_bar_vector
= menu_items
;
1420 f
->menu_bar_items_used
= menu_items_used
;
1425 /* Make a widget-value tree containing
1426 just the top level menu bar strings. */
1428 items
= FRAME_MENU_BAR_ITEMS (f
);
1429 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1433 string
= XVECTOR (items
)->contents
[i
+ 1];
1437 wv
= xmalloc_widget_value ();
1438 wv
->name
= (char *) XSTRING (string
)->data
;
1441 wv
->button_type
= BUTTON_TYPE_NONE
;
1442 /* This prevents lwlib from assuming this
1443 menu item is really supposed to be empty. */
1444 /* The EMACS_INT cast avoids a warning.
1445 This value just has to be different from small integers. */
1446 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1451 first_wv
->contents
= wv
;
1455 /* Forget what we thought we knew about what is in the
1456 detailed contents of the menu bar menus.
1457 Changing the top level always destroys the contents. */
1458 f
->menu_bar_items_used
= 0;
1461 /* Create or update the menu bar widget. */
1467 /* Empty current menubar, rather than creating a fresh one. */
1468 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1473 menubar_widget
= CreateMenu ();
1475 fill_in_menu (menubar_widget
, first_wv
->contents
);
1477 free_menubar_widget_value_tree (first_wv
);
1480 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1482 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1483 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1484 /* Causes flicker when menu bar is updated
1485 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1487 /* Force the window size to be recomputed so that the frame's text
1488 area remains the same, if menubar has just been created. */
1489 if (old_widget
== NULL
)
1490 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1496 /* Called from Fx_create_frame to create the initial menubar of a frame
1497 before it is mapped, so that the window is mapped with the menubar already
1498 there instead of us tacking it on later and thrashing the window after it
1502 initialize_frame_menubar (f
)
1505 /* This function is called before the first chance to redisplay
1506 the frame. It has to be, so the frame will have the right size. */
1507 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1508 set_frame_menubar (f
, 1, 1);
1511 /* Get rid of the menu bar of frame F, and free its storage.
1512 This is used when deleting a frame, and when turning off the menu bar. */
1515 free_frame_menubar (f
)
1521 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1522 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1523 f
->output_data
.w32
->menubar_widget
= NULL
;
1531 /* w32_menu_show actually displays a menu using the panes and items in
1532 menu_items and returns the value selected from it; we assume input
1533 is blocked by the caller. */
1535 /* F is the frame the menu is for.
1536 X and Y are the frame-relative specified position,
1537 relative to the inside upper left corner of the frame F.
1538 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1539 KEYMAPS is 1 if this menu was specified with keymaps;
1540 in that case, we return a list containing the chosen item's value
1541 and perhaps also the pane's prefix.
1542 TITLE is the specified menu title.
1543 ERROR is a place to store an error message string in case of failure.
1544 (We return nil on failure, but the value doesn't actually matter.) */
1547 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1557 int menu_item_selection
;
1560 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1561 widget_value
**submenu_stack
1562 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1563 Lisp_Object
*subprefix_stack
1564 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1565 int submenu_depth
= 0;
1567 int next_release_must_exit
= 0;
1571 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1573 *error
= "Empty menu";
1577 /* Create a tree of widget_value objects
1578 representing the panes and their items. */
1579 wv
= xmalloc_widget_value ();
1583 wv
->button_type
= BUTTON_TYPE_NONE
;
1587 /* Loop over all panes and items, filling in the tree. */
1589 while (i
< menu_items_used
)
1591 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1593 submenu_stack
[submenu_depth
++] = save_wv
;
1599 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1602 save_wv
= submenu_stack
[--submenu_depth
];
1606 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1607 && submenu_depth
!= 0)
1608 i
+= MENU_ITEMS_PANE_LENGTH
;
1609 /* Ignore a nil in the item list.
1610 It's meaningful only for dialog boxes. */
1611 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1613 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1615 /* Create a new pane. */
1616 Lisp_Object pane_name
, prefix
;
1618 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1619 prefix
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1620 #ifndef HAVE_MULTILINGUAL_MENU
1621 if (!NILP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1622 pane_name
= ENCODE_SYSTEM (pane_name
);
1624 pane_string
= (NILP (pane_name
)
1625 ? "" : (char *) XSTRING (pane_name
)->data
);
1626 /* If there is just one top-level pane, put all its items directly
1627 under the top-level menu. */
1628 if (menu_items_n_panes
== 1)
1631 /* If the pane has a meaningful name,
1632 make the pane a top-level menu item
1633 with its items as a submenu beneath it. */
1634 if (!keymaps
&& strcmp (pane_string
, ""))
1636 wv
= xmalloc_widget_value ();
1640 first_wv
->contents
= wv
;
1641 wv
->name
= pane_string
;
1642 if (keymaps
&& !NILP (prefix
))
1646 wv
->button_type
= BUTTON_TYPE_NONE
;
1650 else if (first_pane
)
1656 i
+= MENU_ITEMS_PANE_LENGTH
;
1660 /* Create a new item within current pane. */
1661 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1663 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1664 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1666 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1667 def
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_DEFINITION
];
1668 type
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_TYPE
];
1669 selected
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_SELECTED
];
1670 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1672 #ifndef HAVE_MULTILINGUAL_MENU
1673 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1674 item_name
= ENCODE_SYSTEM (item_name
);
1675 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1676 descrip
= ENCODE_SYSTEM (descrip
);
1679 wv
= xmalloc_widget_value ();
1683 save_wv
->contents
= wv
;
1684 wv
->name
= (char *) XSTRING (item_name
)->data
;
1685 if (!NILP (descrip
))
1686 wv
->key
= (char *) XSTRING (descrip
)->data
;
1688 /* Use the contents index as call_data, since we are
1689 restricted to 16-bits.. */
1690 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1691 wv
->enabled
= !NILP (enable
);
1694 wv
->button_type
= BUTTON_TYPE_NONE
;
1695 else if (EQ (type
, QCtoggle
))
1696 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1697 else if (EQ (type
, QCradio
))
1698 wv
->button_type
= BUTTON_TYPE_RADIO
;
1702 wv
->selected
= !NILP (selected
);
1705 wv
->help
= (char *) XSTRING (help
)->data
;
1711 i
+= MENU_ITEMS_ITEM_LENGTH
;
1715 /* Deal with the title, if it is non-nil. */
1718 widget_value
*wv_title
= xmalloc_widget_value ();
1719 widget_value
*wv_sep
= xmalloc_widget_value ();
1721 /* Maybe replace this separator with a bitmap or owner-draw item
1722 so that it looks better. Having two separators looks odd. */
1723 wv_sep
->name
= "--";
1724 wv_sep
->next
= first_wv
->contents
;
1726 #ifndef HAVE_MULTILINGUAL_MENU
1727 if (STRING_MULTIBYTE (title
))
1728 title
= ENCODE_SYSTEM (title
);
1730 wv_title
->name
= (char *) XSTRING (title
)->data
;
1731 wv_title
->enabled
= True
;
1732 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1733 wv_title
->next
= wv_sep
;
1734 first_wv
->contents
= wv_title
;
1737 /* Actually create the menu. */
1738 menu
= CreatePopupMenu ();
1739 fill_in_menu (menu
, first_wv
->contents
);
1741 /* Adjust coordinates to be root-window-relative. */
1744 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1746 /* Free the widget_value objects we used to specify the contents. */
1747 free_menubar_widget_value_tree (first_wv
);
1749 /* No selection has been chosen yet. */
1750 menu_item_selection
= 0;
1752 /* Display the menu. */
1753 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1754 WM_EMACS_TRACKPOPUPMENU
,
1755 (WPARAM
)menu
, (LPARAM
)&pos
);
1757 /* Clean up extraneous mouse events which might have been generated
1759 discard_mouse_events ();
1763 /* Find the selected item, and its pane, to return
1764 the proper value. */
1765 if (menu_item_selection
!= 0)
1767 Lisp_Object prefix
, entry
;
1771 while (i
< menu_items_used
)
1773 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1775 subprefix_stack
[submenu_depth
++] = prefix
;
1779 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1781 prefix
= subprefix_stack
[--submenu_depth
];
1784 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1787 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1788 i
+= MENU_ITEMS_PANE_LENGTH
;
1790 /* Ignore a nil in the item list.
1791 It's meaningful only for dialog boxes. */
1792 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1797 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1798 if (menu_item_selection
== i
)
1804 entry
= Fcons (entry
, Qnil
);
1806 entry
= Fcons (prefix
, entry
);
1807 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1808 if (!NILP (subprefix_stack
[j
]))
1809 entry
= Fcons (subprefix_stack
[j
], entry
);
1813 i
+= MENU_ITEMS_ITEM_LENGTH
;
1822 static char * button_names
[] = {
1823 "button1", "button2", "button3", "button4", "button5",
1824 "button6", "button7", "button8", "button9", "button10" };
1827 w32_dialog_show (f
, keymaps
, title
, error
)
1833 int i
, nb_buttons
=0;
1834 char dialog_name
[6];
1835 int menu_item_selection
;
1837 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1839 /* Number of elements seen so far, before boundary. */
1841 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1842 int boundary_seen
= 0;
1846 if (menu_items_n_panes
> 1)
1848 *error
= "Multiple panes in dialog box";
1852 /* Create a tree of widget_value objects
1853 representing the text label and buttons. */
1855 Lisp_Object pane_name
, prefix
;
1857 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1858 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1859 pane_string
= (NILP (pane_name
)
1860 ? "" : (char *) XSTRING (pane_name
)->data
);
1861 prev_wv
= xmalloc_widget_value ();
1862 prev_wv
->value
= pane_string
;
1863 if (keymaps
&& !NILP (prefix
))
1865 prev_wv
->enabled
= 1;
1866 prev_wv
->name
= "message";
1869 /* Loop over all panes and items, filling in the tree. */
1870 i
= MENU_ITEMS_PANE_LENGTH
;
1871 while (i
< menu_items_used
)
1874 /* Create a new item within current pane. */
1875 Lisp_Object item_name
, enable
, descrip
, help
;
1877 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1878 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1880 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1881 help
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_HELP
];
1883 if (NILP (item_name
))
1885 free_menubar_widget_value_tree (first_wv
);
1886 *error
= "Submenu in dialog items";
1889 if (EQ (item_name
, Qquote
))
1891 /* This is the boundary between left-side elts
1892 and right-side elts. Stop incrementing right_count. */
1897 if (nb_buttons
>= 9)
1899 free_menubar_widget_value_tree (first_wv
);
1900 *error
= "Too many dialog items";
1904 wv
= xmalloc_widget_value ();
1906 wv
->name
= (char *) button_names
[nb_buttons
];
1907 if (!NILP (descrip
))
1908 wv
->key
= (char *) XSTRING (descrip
)->data
;
1909 wv
->value
= (char *) XSTRING (item_name
)->data
;
1910 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1911 wv
->enabled
= !NILP (enable
);
1914 if (! boundary_seen
)
1918 i
+= MENU_ITEMS_ITEM_LENGTH
;
1921 /* If the boundary was not specified,
1922 by default put half on the left and half on the right. */
1923 if (! boundary_seen
)
1924 left_count
= nb_buttons
- nb_buttons
/ 2;
1926 wv
= xmalloc_widget_value ();
1927 wv
->name
= dialog_name
;
1929 /* Dialog boxes use a really stupid name encoding
1930 which specifies how many buttons to use
1931 and how many buttons are on the right.
1932 The Q means something also. */
1933 dialog_name
[0] = 'Q';
1934 dialog_name
[1] = '0' + nb_buttons
;
1935 dialog_name
[2] = 'B';
1936 dialog_name
[3] = 'R';
1937 /* Number of buttons to put on the right. */
1938 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1940 wv
->contents
= first_wv
;
1944 /* Actually create the dialog. */
1946 dialog_id
= widget_id_tick
++;
1947 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1948 f
->output_data
.w32
->widget
, 1, 0,
1949 dialog_selection_callback
, 0);
1950 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1953 /* Free the widget_value objects we used to specify the contents. */
1954 free_menubar_widget_value_tree (first_wv
);
1956 /* No selection has been chosen yet. */
1957 menu_item_selection
= 0;
1959 /* Display the menu. */
1961 lw_pop_up_all_widgets (dialog_id
);
1962 popup_activated_flag
= 1;
1964 /* Process events that apply to the menu. */
1965 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
1967 lw_destroy_all_widgets (dialog_id
);
1970 /* Find the selected item, and its pane, to return
1971 the proper value. */
1972 if (menu_item_selection
!= 0)
1978 while (i
< menu_items_used
)
1982 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1985 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1986 i
+= MENU_ITEMS_PANE_LENGTH
;
1991 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1992 if (menu_item_selection
== i
)
1996 entry
= Fcons (entry
, Qnil
);
1998 entry
= Fcons (prefix
, entry
);
2002 i
+= MENU_ITEMS_ITEM_LENGTH
;
2011 /* Is this item a separator? */
2013 name_is_separator (name
)
2016 /* Check if name string consists of only dashes ('-') */
2017 while (*name
== '-') name
++;
2018 return (*name
== '\0');
2022 /* Indicate boundary between left and right. */
2024 add_left_right_boundary (HMENU menu
)
2026 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2030 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2036 if (name_is_separator (wv
->name
))
2037 fuFlags
= MF_SEPARATOR
;
2041 fuFlags
= MF_STRING
;
2043 fuFlags
= MF_STRING
| MF_GRAYED
;
2045 if (wv
->key
!= NULL
)
2047 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2048 strcpy (out_string
, wv
->name
);
2049 strcat (out_string
, "\t");
2050 strcat (out_string
, wv
->key
);
2053 out_string
= wv
->name
;
2055 if (wv
->title
|| wv
->call_data
== 0)
2057 #if 0 /* no GC while popup menu is active */
2058 out_string
= LocalAlloc (0, strlen (wv
->name
) + 1);
2059 strcpy (out_string
, wv
->name
);
2061 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2064 /* Draw radio buttons and tickboxes. */
2066 if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2067 wv
->button_type
== BUTTON_TYPE_RADIO
))
2068 fuFlags
|= MF_CHECKED
;
2070 fuFlags
|= MF_UNCHECKED
;
2079 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2080 (fuFlags
== MF_SEPARATOR
) ? NULL
: out_string
);
2082 /* This must be done after the menu item is created. */
2084 HMODULE user32
= GetModuleHandle ("user32.dll");
2085 FARPROC set_menu_item_info
= GetProcAddress (user32
, "SetMenuItemInfoA");
2087 if (set_menu_item_info
)
2090 bzero (&info
, sizeof (info
));
2091 info
.cbSize
= sizeof (info
);
2092 info
.fMask
= MIIM_DATA
;
2093 /* Set help string for menu item. */
2094 info
.dwItemData
= (DWORD
)wv
->help
;
2096 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2098 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2099 RADIO items, but is not available on NT 3.51 and earlier. */
2100 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2101 info
.fType
= MFT_RADIOCHECK
;
2102 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2104 set_menu_item_info (menu
,
2105 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2109 return return_value
;
2112 /* Construct native Windows menu(bar) based on widget_value tree. */
2114 fill_in_menu (HMENU menu
, widget_value
*wv
)
2116 int items_added
= 0;
2118 for ( ; wv
!= NULL
; wv
= wv
->next
)
2122 HMENU sub_menu
= CreatePopupMenu ();
2124 if (sub_menu
== NULL
)
2127 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2128 !add_menu_item (menu
, wv
, sub_menu
))
2130 DestroyMenu (sub_menu
);
2136 if (!add_menu_item (menu
, wv
, NULL
))
2146 /* popup_activated_flag not actually used on W32 */
2150 /* Display help string for currently pointed to menu item. Not
2151 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2154 w32_menu_display_help (HMENU menu
, UINT item
, UINT flags
)
2156 HMODULE user32
= GetModuleHandle ("user32.dll");
2157 FARPROC get_menu_item_info
= GetProcAddress (user32
, "GetMenuItemInfoA");
2159 if (get_menu_item_info
)
2161 struct gcpro gcpro1
;
2162 extern Lisp_Object Vshow_help_function
;
2166 bzero (&info
, sizeof (info
));
2167 info
.cbSize
= sizeof (info
);
2168 info
.fMask
= MIIM_DATA
;
2169 get_menu_item_info (menu
, item
, FALSE
, &info
);
2171 msg
= info
.dwItemData
? build_string ((char *) info
.dwItemData
) : Qnil
;
2174 if (!NILP (Vshow_help_function
))
2175 call1 (Vshow_help_function
, msg
);
2176 else if (!MINI_WINDOW_P (XWINDOW (selected_window
)))
2179 message3_nolog (msg
, XSTRING (msg
)->size
, STRING_MULTIBYTE (msg
));
2189 #endif /* HAVE_MENUS */
2193 staticpro (&menu_items
);
2196 Qdebug_on_next_call
= intern ("debug-on-next-call");
2197 staticpro (&Qdebug_on_next_call
);
2199 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2200 "Frame for which we are updating a menu.\n\
2201 The enable predicate for a menu command should check this variable.");
2202 Vmenu_updating_frame
= Qnil
;
2204 defsubr (&Sx_popup_menu
);
2206 defsubr (&Sx_popup_dialog
);