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"
31 #include "blockinput.h"
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
43 #include <sys/types.h>
46 #include "dispextern.h"
48 #undef HAVE_MULTILINGUAL_MENU
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
54 typedef void * XtPointer
;
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
66 typedef struct _widget_value
70 /* value (meaning depend on widget type) */
72 /* keyboard equivalent. no implications for XtTranslations */
74 /* Help string or nil if none.
75 GC finds this string through the frame's menu_bar_vector
76 or through menu_items. */
80 /* true if selected */
82 /* The type of a button. */
83 enum button_type button_type
;
84 /* true if menu title */
87 /* true if was edited (maintained by get_value) */
89 /* true if has changed (maintained by lw library) */
91 /* true if this widget itself has changed,
92 but not counting the other widgets found in the `next' field. */
93 change_type this_one_change
;
95 /* Contents of the sub-widgets, also selected slot for checkbox */
96 struct _widget_value
* contents
;
97 /* data passed to callback */
99 /* next one in the list */
100 struct _widget_value
* next
;
102 /* slot for the toolkit dependent part. Always initialize to NULL. */
104 /* tell us if we should free the toolkit data slot when freeing the
105 widget_value itself. */
106 Boolean free_toolkit_data
;
108 /* we resource the widget_value structures; this points to the next
109 one on the free list if this one has been deallocated.
111 struct _widget_value
*free_list
;
115 /* Local memory management */
116 #define local_heap (GetProcessHeap ())
117 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
118 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
120 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
121 #define free_widget_value(wv) (local_free ((wv)))
123 /******************************************************************/
130 static HMENU current_popup_menu
;
132 void syms_of_w32menu ();
134 typedef BOOL (WINAPI
* GetMenuItemInfoA_Proc
) (
138 IN OUT LPMENUITEMINFOA
140 typedef BOOL (WINAPI
* SetMenuItemInfoA_Proc
) (
147 GetMenuItemInfoA_Proc get_menu_item_info
=NULL
;
148 SetMenuItemInfoA_Proc set_menu_item_info
=NULL
;
150 Lisp_Object Vmenu_updating_frame
;
152 Lisp_Object Qdebug_on_next_call
;
154 extern Lisp_Object Qmenu_bar
;
155 extern Lisp_Object Qmouse_click
, Qevent_kind
;
157 extern Lisp_Object QCtoggle
, QCradio
;
159 extern Lisp_Object Voverriding_local_map
;
160 extern Lisp_Object Voverriding_local_map_menu_flag
;
162 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
164 extern Lisp_Object Qmenu_bar_update_hook
;
166 void set_frame_menubar ();
168 static void push_menu_item
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
169 Lisp_Object
, Lisp_Object
, Lisp_Object
,
170 Lisp_Object
, Lisp_Object
));
172 static Lisp_Object
w32_dialog_show ();
174 static Lisp_Object
w32_menu_show ();
176 static void keymap_panes ();
177 static void single_keymap_panes ();
178 static void single_menu_item ();
179 static void list_of_panes ();
180 static void list_of_items ();
181 void w32_free_menu_strings (HWND
);
183 /* This holds a Lisp vector that holds the results of decoding
184 the keymaps or alist-of-alists that specify a menu.
186 It describes the panes and items within the panes.
188 Each pane is described by 3 elements in the vector:
189 t, the pane name, the pane's prefix key.
190 Then follow the pane's items, with 5 elements per item:
191 the item string, the enable flag, the item's value,
192 the definition, and the equivalent keyboard key's description string.
194 In some cases, multiple levels of menus may be described.
195 A single vector slot containing nil indicates the start of a submenu.
196 A single vector slot containing lambda indicates the end of a submenu.
197 The submenu follows a menu item which is the way to reach the submenu.
199 A single vector slot containing quote indicates that the
200 following items should appear on the right of a dialog box.
202 Using a Lisp vector to hold this information while we decode it
203 takes care of protecting all the data from GC. */
205 #define MENU_ITEMS_PANE_NAME 1
206 #define MENU_ITEMS_PANE_PREFIX 2
207 #define MENU_ITEMS_PANE_LENGTH 3
211 MENU_ITEMS_ITEM_NAME
= 0,
212 MENU_ITEMS_ITEM_ENABLE
,
213 MENU_ITEMS_ITEM_VALUE
,
214 MENU_ITEMS_ITEM_EQUIV_KEY
,
215 MENU_ITEMS_ITEM_DEFINITION
,
216 MENU_ITEMS_ITEM_TYPE
,
217 MENU_ITEMS_ITEM_SELECTED
,
218 MENU_ITEMS_ITEM_HELP
,
219 MENU_ITEMS_ITEM_LENGTH
222 static Lisp_Object menu_items
;
224 /* Number of slots currently allocated in menu_items. */
225 static int menu_items_allocated
;
227 /* This is the index in menu_items of the first empty slot. */
228 static int menu_items_used
;
230 /* The number of panes currently recorded in menu_items,
231 excluding those within submenus. */
232 static int menu_items_n_panes
;
234 /* Current depth within submenus. */
235 static int menu_items_submenu_depth
;
237 /* Flag which when set indicates a dialog or menu has been posted by
238 Xt on behalf of one of the widget sets. */
239 static int popup_activated_flag
;
241 static int next_menubar_widget_id
;
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
250 int pending_menu_activation
;
253 /* Return the frame whose ->output_data.w32->menubar_widget equals
256 static struct frame
*
257 menubar_id_to_frame (id
)
260 Lisp_Object tail
, frame
;
263 for (tail
= Vframe_list
; GC_CONSP (tail
); tail
= XCDR (tail
))
266 if (!GC_FRAMEP (frame
))
269 if (!FRAME_WINDOW_P (f
))
271 if (f
->output_data
.w32
->menubar_widget
== id
)
277 /* Initialize the menu_items structure if we haven't already done so.
278 Also mark it as currently empty. */
283 if (NILP (menu_items
))
285 menu_items_allocated
= 60;
286 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
290 menu_items_n_panes
= 0;
291 menu_items_submenu_depth
= 0;
294 /* Call at the end of generating the data in menu_items.
295 This fills in the number of items in the last pane. */
302 /* Call when finished using the data for the current menu
306 discard_menu_items ()
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated
> 200)
313 menu_items_allocated
= 0;
317 /* Make the menu_items vector twice as large. */
323 int old_size
= menu_items_allocated
;
326 menu_items_allocated
*= 2;
327 menu_items
= Fmake_vector (make_number (menu_items_allocated
), Qnil
);
328 bcopy (XVECTOR (old
)->contents
, XVECTOR (menu_items
)->contents
,
329 old_size
* sizeof (Lisp_Object
));
332 /* Begin a submenu. */
335 push_submenu_start ()
337 if (menu_items_used
+ 1 > menu_items_allocated
)
340 ASET (menu_items
, menu_items_used
++, Qnil
);
341 menu_items_submenu_depth
++;
349 if (menu_items_used
+ 1 > menu_items_allocated
)
352 ASET (menu_items
, menu_items_used
++, Qlambda
);
353 menu_items_submenu_depth
--;
356 /* Indicate boundary between left and right. */
359 push_left_right_boundary ()
361 if (menu_items_used
+ 1 > menu_items_allocated
)
364 ASET (menu_items
, menu_items_used
++, Qquote
);
367 /* Start a new menu pane in menu_items.
368 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
371 push_menu_pane (name
, prefix_vec
)
372 Lisp_Object name
, prefix_vec
;
374 if (menu_items_used
+ MENU_ITEMS_PANE_LENGTH
> menu_items_allocated
)
377 if (menu_items_submenu_depth
== 0)
378 menu_items_n_panes
++;
379 ASET (menu_items
, menu_items_used
++, Qt
);
380 ASET (menu_items
, menu_items_used
++, name
);
381 ASET (menu_items
, menu_items_used
++, prefix_vec
);
384 /* Push one menu item into the current pane. NAME is the string to
385 display. ENABLE if non-nil means this item can be selected. KEY
386 is the key generated by choosing this item, or nil if this item
387 doesn't really have a definition. DEF is the definition of this
388 item. EQUIV is the textual description of the keyboard equivalent
389 for this item (or nil if none). TYPE is the type of this menu
390 item, one of nil, `toggle' or `radio'. */
393 push_menu_item (name
, enable
, key
, def
, equiv
, type
, selected
, help
)
394 Lisp_Object name
, enable
, key
, def
, equiv
, type
, selected
, help
;
396 if (menu_items_used
+ MENU_ITEMS_ITEM_LENGTH
> menu_items_allocated
)
399 ASET (menu_items
, menu_items_used
++, name
);
400 ASET (menu_items
, menu_items_used
++, enable
);
401 ASET (menu_items
, menu_items_used
++, key
);
402 ASET (menu_items
, menu_items_used
++, equiv
);
403 ASET (menu_items
, menu_items_used
++, def
);
404 ASET (menu_items
, menu_items_used
++, type
);
405 ASET (menu_items
, menu_items_used
++, selected
);
406 ASET (menu_items
, menu_items_used
++, help
);
409 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
410 and generate menu panes for them in menu_items.
411 If NOTREAL is nonzero,
412 don't bother really computing whether an item is enabled. */
415 keymap_panes (keymaps
, nmaps
, notreal
)
416 Lisp_Object
*keymaps
;
424 /* Loop over the given keymaps, making a pane for each map.
425 But don't make a pane that is empty--ignore that map instead.
426 P is the number of panes we have made so far. */
427 for (mapno
= 0; mapno
< nmaps
; mapno
++)
428 single_keymap_panes (keymaps
[mapno
],
429 Fkeymap_prompt (keymaps
[mapno
]), Qnil
, notreal
, 10);
431 finish_menu_items ();
434 /* This is a recursive subroutine of keymap_panes.
435 It handles one keymap, KEYMAP.
436 The other arguments are passed along
437 or point to local variables of the previous function.
438 If NOTREAL is nonzero, only check for equivalent key bindings, don't
439 evaluate expressions in menu items and don't make any menu.
441 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
444 single_keymap_panes (keymap
, pane_name
, prefix
, notreal
, maxdepth
)
446 Lisp_Object pane_name
;
451 Lisp_Object pending_maps
= Qnil
;
452 Lisp_Object tail
, item
;
453 struct gcpro gcpro1
, gcpro2
;
458 push_menu_pane (pane_name
, prefix
);
460 for (tail
= keymap
; CONSP (tail
); tail
= XCDR (tail
))
462 GCPRO2 (keymap
, pending_maps
);
463 /* Look at each key binding, and if it is a menu item add it
467 single_menu_item (XCAR (item
), XCDR (item
),
468 &pending_maps
, notreal
, maxdepth
);
469 else if (VECTORP (item
))
471 /* Loop over the char values represented in the vector. */
472 int len
= ASIZE (item
);
474 for (c
= 0; c
< len
; c
++)
476 Lisp_Object character
;
477 XSETFASTINT (character
, c
);
478 single_menu_item (character
, AREF (item
, c
),
479 &pending_maps
, notreal
, maxdepth
);
485 /* Process now any submenus which want to be panes at this level. */
486 while (!NILP (pending_maps
))
488 Lisp_Object elt
, eltcdr
, string
;
489 elt
= Fcar (pending_maps
);
491 string
= XCAR (eltcdr
);
492 /* We no longer discard the @ from the beginning of the string here.
493 Instead, we do this in w32_menu_show. */
494 single_keymap_panes (Fcar (elt
), string
,
495 XCDR (eltcdr
), notreal
, maxdepth
- 1);
496 pending_maps
= Fcdr (pending_maps
);
500 /* This is a subroutine of single_keymap_panes that handles one
502 KEY is a key in a keymap and ITEM is its binding.
503 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
505 If NOTREAL is nonzero, only check for equivalent key bindings, don't
506 evaluate expressions in menu items and don't make any menu.
507 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
510 single_menu_item (key
, item
, pending_maps_ptr
, notreal
, maxdepth
)
511 Lisp_Object key
, item
;
512 Lisp_Object
*pending_maps_ptr
;
513 int maxdepth
, notreal
;
515 Lisp_Object map
, item_string
, enabled
;
516 struct gcpro gcpro1
, gcpro2
;
519 /* Parse the menu item and leave the result in item_properties. */
521 res
= parse_menu_item (item
, notreal
, 0);
524 return; /* Not a menu item. */
526 map
= AREF (item_properties
, ITEM_PROPERTY_MAP
);
530 /* We don't want to make a menu, just traverse the keymaps to
531 precompute equivalent key bindings. */
533 single_keymap_panes (map
, Qnil
, key
, 1, maxdepth
- 1);
537 enabled
= AREF (item_properties
, ITEM_PROPERTY_ENABLE
);
538 item_string
= AREF (item_properties
, ITEM_PROPERTY_NAME
);
540 if (!NILP (map
) && SREF (item_string
, 0) == '@')
543 /* An enabled separate pane. Remember this to handle it later. */
544 *pending_maps_ptr
= Fcons (Fcons (map
, Fcons (item_string
, key
)),
549 push_menu_item (item_string
, enabled
, key
,
550 AREF (item_properties
, ITEM_PROPERTY_DEF
),
551 AREF (item_properties
, ITEM_PROPERTY_KEYEQ
),
552 AREF (item_properties
, ITEM_PROPERTY_TYPE
),
553 AREF (item_properties
, ITEM_PROPERTY_SELECTED
),
554 AREF (item_properties
, ITEM_PROPERTY_HELP
));
556 /* Display a submenu using the toolkit. */
557 if (! (NILP (map
) || NILP (enabled
)))
559 push_submenu_start ();
560 single_keymap_panes (map
, Qnil
, key
, 0, maxdepth
- 1);
565 /* Push all the panes and items of a menu described by the
566 alist-of-alists MENU.
567 This handles old-fashioned calls to x-popup-menu. */
577 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
579 Lisp_Object elt
, pane_name
, pane_data
;
581 pane_name
= Fcar (elt
);
582 CHECK_STRING (pane_name
);
583 push_menu_pane (pane_name
, Qnil
);
584 pane_data
= Fcdr (elt
);
585 CHECK_CONS (pane_data
);
586 list_of_items (pane_data
);
589 finish_menu_items ();
592 /* Push the items in a single pane defined by the alist PANE. */
598 Lisp_Object tail
, item
, item1
;
600 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
604 push_menu_item (item
, Qnil
, Qnil
, Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
605 else if (NILP (item
))
606 push_left_right_boundary ();
611 CHECK_STRING (item1
);
612 push_menu_item (item1
, Qt
, Fcdr (item
), Qt
, Qnil
, Qnil
, Qnil
, Qnil
);
617 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
618 doc
: /* Pop up a deck-of-cards menu and return user's selection.
619 POSITION is a position specification. This is either a mouse button
620 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
621 are positions in pixels from the top left corner of WINDOW's frame
622 \(WINDOW may be a frame object instead of a window). This controls the
623 position of the center of the first line in the first pane of the
624 menu, not the top left of the menu as a whole. If POSITION is t, it
625 means to use the current mouse position.
627 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
628 The menu items come from key bindings that have a menu string as well as
629 a definition; actually, the \"definition\" in such a key binding looks like
630 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
631 the keymap as a top-level element.
633 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
634 Otherwise, REAL-DEFINITION should be a valid key binding definition.
636 You can also use a list of keymaps as MENU. Then each keymap makes a
637 separate pane. When MENU is a keymap or a list of keymaps, the return
638 value is a list of events.
640 Alternatively, you can specify a menu of multiple panes with a list of
641 the form (TITLE PANE1 PANE2...), where each pane is a list of
642 form (TITLE ITEM1 ITEM2...).
643 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
644 appear as an item--that makes a nonselectable line in the menu.
645 With this form of menu, the return value is VALUE from the chosen item.
647 If POSITION is nil, don't display the menu at all, just precalculate the
648 cached information about equivalent key sequences. */)
650 Lisp_Object position
, menu
;
652 Lisp_Object keymap
, tem
;
653 int xpos
= 0, ypos
= 0;
656 Lisp_Object selection
;
658 Lisp_Object x
, y
, window
;
664 if (! NILP (position
))
668 /* Decode the first argument: find the window and the coordinates. */
669 if (EQ (position
, Qt
)
670 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
671 || EQ (XCAR (position
), Qtool_bar
))))
673 /* Use the mouse's current position. */
674 FRAME_PTR new_f
= SELECTED_FRAME ();
675 Lisp_Object bar_window
;
676 enum scroll_bar_part part
;
679 if (mouse_position_hook
)
680 (*mouse_position_hook
) (&new_f
, 1, &bar_window
,
681 &part
, &x
, &y
, &time
);
683 XSETFRAME (window
, new_f
);
686 window
= selected_window
;
693 tem
= Fcar (position
);
696 window
= Fcar (Fcdr (position
));
698 y
= Fcar (Fcdr (tem
));
703 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
704 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
705 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
714 /* Decode where to put the menu. */
722 else if (WINDOWP (window
))
724 CHECK_LIVE_WINDOW (window
);
725 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
727 xpos
= (FONT_WIDTH (FRAME_FONT (f
))
728 * XFASTINT (XWINDOW (window
)->left
));
729 ypos
= (FRAME_LINE_HEIGHT (f
)
730 * XFASTINT (XWINDOW (window
)->top
));
733 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
734 but I don't want to make one now. */
735 CHECK_WINDOW (window
);
740 XSETFRAME (Vmenu_updating_frame
, f
);
742 Vmenu_updating_frame
= Qnil
;
743 #endif /* HAVE_MENUS */
748 /* Decode the menu items from what was specified. */
750 keymap
= get_keymap (menu
, 0, 0);
753 /* We were given a keymap. Extract menu info from the keymap. */
756 /* Extract the detailed info to make one pane. */
757 keymap_panes (&menu
, 1, NILP (position
));
759 /* Search for a string appearing directly as an element of the keymap.
760 That string is the title of the menu. */
761 prompt
= Fkeymap_prompt (keymap
);
762 if (NILP (title
) && !NILP (prompt
))
765 /* Make that be the pane title of the first pane. */
766 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
767 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, prompt
);
771 else if (CONSP (menu
) && KEYMAPP (XCAR (menu
)))
773 /* We were given a list of keymaps. */
774 int nmaps
= XFASTINT (Flength (menu
));
776 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
781 /* The first keymap that has a prompt string
782 supplies the menu title. */
783 for (tem
= menu
, i
= 0; CONSP (tem
); tem
= Fcdr (tem
))
787 maps
[i
++] = keymap
= get_keymap (Fcar (tem
), 1, 0);
789 prompt
= Fkeymap_prompt (keymap
);
790 if (NILP (title
) && !NILP (prompt
))
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (maps
, nmaps
, NILP (position
));
797 /* Make the title be the pane title of the first pane. */
798 if (!NILP (title
) && menu_items_n_panes
>= 0)
799 ASET (menu_items
, MENU_ITEMS_PANE_NAME
, title
);
805 /* We were given an old-fashioned menu. */
807 CHECK_STRING (title
);
809 list_of_panes (Fcdr (menu
));
816 discard_menu_items ();
822 /* If resources from a previous popup menu exist yet, does nothing
823 until the `menu_free_timer' has freed them (see w32fns.c).
825 if (current_popup_menu
)
827 discard_menu_items ();
832 /* Display them in a menu. */
835 selection
= w32_menu_show (f
, xpos
, ypos
, for_click
,
836 keymaps
, title
, &error_name
);
839 discard_menu_items ();
840 #endif /* HAVE_MENUS */
844 if (error_name
) error (error_name
);
850 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
851 doc
: /* Pop up a dialog box and return user's selection.
852 POSITION specifies which frame to use.
853 This is normally a mouse button event or a window or frame.
854 If POSITION is t, it means to use the frame the mouse is on.
855 The dialog box appears in the middle of the specified frame.
857 CONTENTS specifies the alternatives to display in the dialog box.
858 It is a list of the form (TITLE ITEM1 ITEM2...).
859 Each ITEM is a cons cell (STRING . VALUE).
860 The return value is VALUE from the chosen item.
862 An ITEM may also be just a string--that makes a nonselectable item.
863 An ITEM may also be nil--that means to put all preceding items
864 on the left of the dialog box and all following items on the right.
865 \(By default, approximately half appear on each side.) */)
867 Lisp_Object position
, contents
;
874 /* Decode the first argument: find the window or frame to use. */
875 if (EQ (position
, Qt
)
876 || (CONSP (position
) && (EQ (XCAR (position
), Qmenu_bar
)
877 || EQ (XCAR (position
), Qtool_bar
))))
879 #if 0 /* Using the frame the mouse is on may not be right. */
880 /* Use the mouse's current position. */
881 FRAME_PTR new_f
= SELECTED_FRAME ();
882 Lisp_Object bar_window
;
883 enum scroll_bar_part part
;
887 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
890 XSETFRAME (window
, new_f
);
892 window
= selected_window
;
894 window
= selected_window
;
896 else if (CONSP (position
))
899 tem
= Fcar (position
);
901 window
= Fcar (Fcdr (position
));
904 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
905 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
908 else if (WINDOWP (position
) || FRAMEP (position
))
913 /* Decode where to put the menu. */
917 else if (WINDOWP (window
))
919 CHECK_LIVE_WINDOW (window
);
920 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
923 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
924 but I don't want to make one now. */
925 CHECK_WINDOW (window
);
928 /* Display a menu with these alternatives
929 in the middle of frame F. */
931 Lisp_Object x
, y
, frame
, newpos
;
932 XSETFRAME (frame
, f
);
933 XSETINT (x
, x_pixel_width (f
) / 2);
934 XSETINT (y
, x_pixel_height (f
) / 2);
935 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
937 return Fx_popup_menu (newpos
,
938 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
940 #else /* HAVE_DIALOGS */
944 Lisp_Object selection
;
946 /* Decode the dialog items from what was specified. */
947 title
= Fcar (contents
);
948 CHECK_STRING (title
);
950 list_of_panes (Fcons (contents
, Qnil
));
952 /* Display them in a dialog box. */
954 selection
= w32_dialog_show (f
, 0, title
, &error_name
);
957 discard_menu_items ();
959 if (error_name
) error (error_name
);
962 #endif /* HAVE_DIALOGS */
965 /* Activate the menu bar of frame F.
966 This is called from keyboard.c when it gets the
967 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
969 To activate the menu bar, we signal to the input thread that it can
970 return from the WM_INITMENU message, allowing the normal Windows
971 processing of the menus.
973 But first we recompute the menu bar contents (the whole tree).
975 This way we can safely execute Lisp code. */
978 x_activate_menubar (f
)
981 set_frame_menubar (f
, 0, 1);
983 /* Lock out further menubar changes while active. */
984 f
->output_data
.w32
->menubar_active
= 1;
986 /* Signal input thread to return from WM_INITMENU. */
987 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
990 /* This callback is called from the menu bar pulldown menu
991 when the user makes a selection.
992 Figure out what the user chose
993 and put the appropriate events into the keyboard buffer. */
996 menubar_selection_callback (FRAME_PTR f
, void * client_data
)
998 Lisp_Object prefix
, entry
;
1000 Lisp_Object
*subprefix_stack
;
1001 int submenu_depth
= 0;
1007 subprefix_stack
= (Lisp_Object
*) alloca (f
->menu_bar_items_used
* sizeof (Lisp_Object
));
1008 vector
= f
->menu_bar_vector
;
1011 while (i
< f
->menu_bar_items_used
)
1013 if (EQ (AREF (vector
, i
), Qnil
))
1015 subprefix_stack
[submenu_depth
++] = prefix
;
1019 else if (EQ (AREF (vector
, i
), Qlambda
))
1021 prefix
= subprefix_stack
[--submenu_depth
];
1024 else if (EQ (AREF (vector
, i
), Qt
))
1026 prefix
= AREF (vector
, i
+ MENU_ITEMS_PANE_PREFIX
);
1027 i
+= MENU_ITEMS_PANE_LENGTH
;
1031 entry
= AREF (vector
, i
+ MENU_ITEMS_ITEM_VALUE
);
1032 /* The EMACS_INT cast avoids a warning. There's no problem
1033 as long as pointers have enough bits to hold small integers. */
1034 if ((int) (EMACS_INT
) client_data
== i
)
1037 struct input_event buf
;
1040 XSETFRAME (frame
, f
);
1041 buf
.kind
= MENU_BAR_EVENT
;
1042 buf
.frame_or_window
= frame
;
1044 kbd_buffer_store_event (&buf
);
1046 for (j
= 0; j
< submenu_depth
; j
++)
1047 if (!NILP (subprefix_stack
[j
]))
1049 buf
.kind
= MENU_BAR_EVENT
;
1050 buf
.frame_or_window
= frame
;
1051 buf
.arg
= subprefix_stack
[j
];
1052 kbd_buffer_store_event (&buf
);
1057 buf
.kind
= MENU_BAR_EVENT
;
1058 buf
.frame_or_window
= frame
;
1060 kbd_buffer_store_event (&buf
);
1063 buf
.kind
= MENU_BAR_EVENT
;
1064 buf
.frame_or_window
= frame
;
1066 kbd_buffer_store_event (&buf
);
1068 /* Free memory used by owner-drawn and help-echo strings. */
1069 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1070 f
->output_data
.w32
->menu_command_in_progress
= 0;
1071 f
->output_data
.w32
->menubar_active
= 0;
1074 i
+= MENU_ITEMS_ITEM_LENGTH
;
1077 /* Free memory used by owner-drawn and help-echo strings. */
1078 w32_free_menu_strings (FRAME_W32_WINDOW (f
));
1079 f
->output_data
.w32
->menu_command_in_progress
= 0;
1080 f
->output_data
.w32
->menubar_active
= 0;
1083 /* Allocate a widget_value, blocking input. */
1086 xmalloc_widget_value ()
1088 widget_value
*value
;
1091 value
= malloc_widget_value ();
1097 /* This recursively calls free_widget_value on the tree of widgets.
1098 It must free all data that was malloc'ed for these widget_values.
1099 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1100 must be left alone. */
1103 free_menubar_widget_value_tree (wv
)
1108 wv
->name
= wv
->value
= wv
->key
= (char *) 0xDEADBEEF;
1110 if (wv
->contents
&& (wv
->contents
!= (widget_value
*)1))
1112 free_menubar_widget_value_tree (wv
->contents
);
1113 wv
->contents
= (widget_value
*) 0xDEADBEEF;
1117 free_menubar_widget_value_tree (wv
->next
);
1118 wv
->next
= (widget_value
*) 0xDEADBEEF;
1121 free_widget_value (wv
);
1125 /* Set up data i menu_items for a menu bar item
1126 whose event type is ITEM_KEY (with string ITEM_NAME)
1127 and whose contents come from the list of keymaps MAPS. */
1130 parse_single_submenu (item_key
, item_name
, maps
)
1131 Lisp_Object item_key
, item_name
, maps
;
1135 Lisp_Object
*mapvec
;
1137 int top_level_items
= 0;
1139 length
= Flength (maps
);
1140 len
= XINT (length
);
1142 /* Convert the list MAPS into a vector MAPVEC. */
1143 mapvec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
1144 for (i
= 0; i
< len
; i
++)
1146 mapvec
[i
] = Fcar (maps
);
1150 /* Loop over the given keymaps, making a pane for each map.
1151 But don't make a pane that is empty--ignore that map instead. */
1152 for (i
= 0; i
< len
; i
++)
1154 if (SYMBOLP (mapvec
[i
])
1155 || (CONSP (mapvec
[i
]) && !KEYMAPP (mapvec
[i
])))
1157 /* Here we have a command at top level in the menu bar
1158 as opposed to a submenu. */
1159 top_level_items
= 1;
1160 push_menu_pane (Qnil
, Qnil
);
1161 push_menu_item (item_name
, Qt
, item_key
, mapvec
[i
],
1162 Qnil
, Qnil
, Qnil
, Qnil
);
1165 single_keymap_panes (mapvec
[i
], item_name
, item_key
, 0, 10);
1168 return top_level_items
;
1172 /* Create a tree of widget_value objects
1173 representing the panes and items
1174 in menu_items starting at index START, up to index END. */
1176 static widget_value
*
1177 digest_single_submenu (start
, end
, top_level_items
)
1180 widget_value
*wv
, *prev_wv
, *save_wv
, *first_wv
;
1182 int submenu_depth
= 0;
1183 widget_value
**submenu_stack
;
1186 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1187 wv
= xmalloc_widget_value ();
1191 wv
->button_type
= BUTTON_TYPE_NONE
;
1197 /* Loop over all panes and items made during this call
1198 and construct a tree of widget_value objects.
1199 Ignore the panes and items made by previous calls to
1200 single_submenu, even though those are also in menu_items. */
1204 if (EQ (AREF (menu_items
, i
), Qnil
))
1206 submenu_stack
[submenu_depth
++] = save_wv
;
1211 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1214 save_wv
= submenu_stack
[--submenu_depth
];
1217 else if (EQ (AREF (menu_items
, i
), Qt
)
1218 && submenu_depth
!= 0)
1219 i
+= MENU_ITEMS_PANE_LENGTH
;
1220 /* Ignore a nil in the item list.
1221 It's meaningful only for dialog boxes. */
1222 else if (EQ (AREF (menu_items
, i
), Qquote
))
1224 else if (EQ (AREF (menu_items
, i
), Qt
))
1226 /* Create a new pane. */
1227 Lisp_Object pane_name
, prefix
;
1230 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1231 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1233 #ifndef HAVE_MULTILINGUAL_MENU
1234 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1236 pane_name
= ENCODE_SYSTEM (pane_name
);
1237 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1240 pane_string
= (NILP (pane_name
)
1241 ? "" : (char *) SDATA (pane_name
));
1242 /* If there is just one top-level pane, put all its items directly
1243 under the top-level menu. */
1244 if (menu_items_n_panes
== 1)
1247 /* If the pane has a meaningful name,
1248 make the pane a top-level menu item
1249 with its items as a submenu beneath it. */
1250 if (strcmp (pane_string
, ""))
1252 wv
= xmalloc_widget_value ();
1256 first_wv
->contents
= wv
;
1257 wv
->name
= pane_string
;
1258 /* Ignore the @ that means "separate pane".
1259 This is a kludge, but this isn't worth more time. */
1260 if (!NILP (prefix
) && wv
->name
[0] == '@')
1264 wv
->button_type
= BUTTON_TYPE_NONE
;
1269 i
+= MENU_ITEMS_PANE_LENGTH
;
1273 /* Create a new item within current pane. */
1274 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
;
1277 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1278 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1279 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1280 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1281 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1282 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1283 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1285 #ifndef HAVE_MULTILINGUAL_MENU
1286 if (STRING_MULTIBYTE (item_name
))
1288 item_name
= ENCODE_SYSTEM (item_name
);
1289 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1292 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1294 descrip
= ENCODE_SYSTEM (descrip
);
1295 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1297 #endif /* not HAVE_MULTILINGUAL_MENU */
1299 wv
= xmalloc_widget_value ();
1303 save_wv
->contents
= wv
;
1305 wv
->name
= (char *) SDATA (item_name
);
1306 if (!NILP (descrip
))
1307 wv
->key
= (char *) SDATA (descrip
);
1309 /* The EMACS_INT cast avoids a warning. There's no problem
1310 as long as pointers have enough bits to hold small integers. */
1311 wv
->call_data
= (!NILP (def
) ? (void *) (EMACS_INT
) i
: 0);
1312 wv
->enabled
= !NILP (enable
);
1315 wv
->button_type
= BUTTON_TYPE_NONE
;
1316 else if (EQ (type
, QCradio
))
1317 wv
->button_type
= BUTTON_TYPE_RADIO
;
1318 else if (EQ (type
, QCtoggle
))
1319 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1323 wv
->selected
= !NILP (selected
);
1324 if (!STRINGP (help
))
1331 i
+= MENU_ITEMS_ITEM_LENGTH
;
1335 /* If we have just one "menu item"
1336 that was originally a button, return it by itself. */
1337 if (top_level_items
&& first_wv
->contents
&& first_wv
->contents
->next
== 0)
1339 wv
= first_wv
->contents
;
1340 free_widget_value (first_wv
);
1347 /* Set the contents of the menubar widgets of frame F.
1348 The argument FIRST_TIME is currently ignored;
1349 it is set the first time this is called, from initialize_frame_menubar. */
1352 set_frame_menubar (f
, first_time
, deep_p
)
1357 HMENU menubar_widget
= f
->output_data
.w32
->menubar_widget
;
1359 widget_value
*wv
, *first_wv
, *prev_wv
= 0;
1361 int *submenu_start
, *submenu_end
;
1362 int *submenu_top_level_items
;
1364 /* We must not change the menubar when actually in use. */
1365 if (f
->output_data
.w32
->menubar_active
)
1368 XSETFRAME (Vmenu_updating_frame
, f
);
1370 if (! menubar_widget
)
1372 else if (pending_menu_activation
&& !deep_p
)
1377 /* Make a widget-value tree representing the entire menu trees. */
1379 struct buffer
*prev
= current_buffer
;
1381 int specpdl_count
= SPECPDL_INDEX ();
1382 int previous_menu_items_used
= f
->menu_bar_items_used
;
1383 Lisp_Object
*previous_items
1384 = (Lisp_Object
*) alloca (previous_menu_items_used
1385 * sizeof (Lisp_Object
));
1387 /* If we are making a new widget, its contents are empty,
1388 do always reinitialize them. */
1389 if (! menubar_widget
)
1390 previous_menu_items_used
= 0;
1392 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1393 specbind (Qinhibit_quit
, Qt
);
1394 /* Don't let the debugger step into this code
1395 because it is not reentrant. */
1396 specbind (Qdebug_on_next_call
, Qnil
);
1398 record_unwind_protect (Fset_match_data
, Fmatch_data (Qnil
, Qnil
));
1399 if (NILP (Voverriding_local_map_menu_flag
))
1401 specbind (Qoverriding_terminal_local_map
, Qnil
);
1402 specbind (Qoverriding_local_map
, Qnil
);
1405 set_buffer_internal_1 (XBUFFER (buffer
));
1407 /* Run the Lucid hook. */
1408 safe_run_hooks (Qactivate_menubar_hook
);
1409 /* If it has changed current-menubar from previous value,
1410 really recompute the menubar from the value. */
1411 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1412 call0 (Qrecompute_lucid_menubar
);
1413 safe_run_hooks (Qmenu_bar_update_hook
);
1414 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1416 items
= FRAME_MENU_BAR_ITEMS (f
);
1418 /* Save the frame's previous menu bar contents data. */
1419 if (previous_menu_items_used
)
1420 bcopy (XVECTOR (f
->menu_bar_vector
)->contents
, previous_items
,
1421 previous_menu_items_used
* sizeof (Lisp_Object
));
1423 /* Fill in menu_items with the current menu bar contents.
1424 This can evaluate Lisp code. */
1425 menu_items
= f
->menu_bar_vector
;
1426 menu_items_allocated
= VECTORP (menu_items
) ? ASIZE (menu_items
) : 0;
1427 submenu_start
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1428 submenu_end
= (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1429 submenu_top_level_items
1430 = (int *) alloca (XVECTOR (items
)->size
* sizeof (int *));
1432 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1434 Lisp_Object key
, string
, maps
;
1438 key
= AREF (items
, i
);
1439 string
= AREF (items
, i
+ 1);
1440 maps
= AREF (items
, i
+ 2);
1444 submenu_start
[i
] = menu_items_used
;
1446 menu_items_n_panes
= 0;
1447 submenu_top_level_items
[i
]
1448 = parse_single_submenu (key
, string
, maps
);
1450 submenu_end
[i
] = menu_items_used
;
1453 finish_menu_items ();
1455 /* Convert menu_items into widget_value trees
1456 to display the menu. This cannot evaluate Lisp code. */
1458 wv
= xmalloc_widget_value ();
1459 wv
->name
= "menubar";
1462 wv
->button_type
= BUTTON_TYPE_NONE
;
1466 for (i
= 0; i
< last_i
; i
+= 4)
1468 wv
= digest_single_submenu (submenu_start
[i
], submenu_end
[i
],
1469 submenu_top_level_items
[i
]);
1473 first_wv
->contents
= wv
;
1474 /* Don't set wv->name here; GC during the loop might relocate it. */
1476 wv
->button_type
= BUTTON_TYPE_NONE
;
1480 set_buffer_internal_1 (prev
);
1481 unbind_to (specpdl_count
, Qnil
);
1483 /* If there has been no change in the Lisp-level contents
1484 of the menu bar, skip redisplaying it. Just exit. */
1486 for (i
= 0; i
< previous_menu_items_used
; i
++)
1487 if (menu_items_used
== i
1488 || (!EQ (previous_items
[i
], AREF (menu_items
, i
))))
1490 if (i
== menu_items_used
&& i
== previous_menu_items_used
&& i
!= 0)
1492 free_menubar_widget_value_tree (first_wv
);
1498 /* Now GC cannot happen during the lifetime of the widget_value,
1499 so it's safe to store data from a Lisp_String, as long as
1500 local copies are made when the actual menu is created.
1501 Windows takes care of this for normal string items, but
1502 not for owner-drawn items or additional item-info. */
1503 wv
= first_wv
->contents
;
1504 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1507 string
= AREF (items
, i
+ 1);
1510 wv
->name
= (char *) SDATA (string
);
1514 f
->menu_bar_vector
= menu_items
;
1515 f
->menu_bar_items_used
= menu_items_used
;
1520 /* Make a widget-value tree containing
1521 just the top level menu bar strings. */
1523 wv
= xmalloc_widget_value ();
1524 wv
->name
= "menubar";
1527 wv
->button_type
= BUTTON_TYPE_NONE
;
1531 items
= FRAME_MENU_BAR_ITEMS (f
);
1532 for (i
= 0; i
< ASIZE (items
); i
+= 4)
1536 string
= AREF (items
, i
+ 1);
1540 wv
= xmalloc_widget_value ();
1541 wv
->name
= (char *) SDATA (string
);
1544 wv
->button_type
= BUTTON_TYPE_NONE
;
1546 /* This prevents lwlib from assuming this
1547 menu item is really supposed to be empty. */
1548 /* The EMACS_INT cast avoids a warning.
1549 This value just has to be different from small integers. */
1550 wv
->call_data
= (void *) (EMACS_INT
) (-1);
1555 first_wv
->contents
= wv
;
1559 /* Forget what we thought we knew about what is in the
1560 detailed contents of the menu bar menus.
1561 Changing the top level always destroys the contents. */
1562 f
->menu_bar_items_used
= 0;
1565 /* Create or update the menu bar widget. */
1571 /* Empty current menubar, rather than creating a fresh one. */
1572 while (DeleteMenu (menubar_widget
, 0, MF_BYPOSITION
))
1577 menubar_widget
= CreateMenu ();
1579 fill_in_menu (menubar_widget
, first_wv
->contents
);
1581 free_menubar_widget_value_tree (first_wv
);
1584 HMENU old_widget
= f
->output_data
.w32
->menubar_widget
;
1586 f
->output_data
.w32
->menubar_widget
= menubar_widget
;
1587 SetMenu (FRAME_W32_WINDOW (f
), f
->output_data
.w32
->menubar_widget
);
1588 /* Causes flicker when menu bar is updated
1589 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1591 /* Force the window size to be recomputed so that the frame's text
1592 area remains the same, if menubar has just been created. */
1593 if (old_widget
== NULL
)
1594 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1600 /* Called from Fx_create_frame to create the initial menubar of a frame
1601 before it is mapped, so that the window is mapped with the menubar already
1602 there instead of us tacking it on later and thrashing the window after it
1606 initialize_frame_menubar (f
)
1609 HMODULE user32
= GetModuleHandle ("user32.dll");
1611 Reinitialize the function pointers set_menu_item_info and
1612 get_menu_item_info here.
1613 Even though these function pointers are initialized in
1614 syms_of_w32menu which is called from main (emacs.c),
1615 we need to initialize them again here in order to prevent
1616 a crash that occurs in Windows 9x (possibly only when Emacs
1617 was built on Windows NT / 2000 / XP?) in add_menu_item.
1618 The crash occurs when attempting to call the Win32 API
1619 function SetMenuItemInfo through the function pointer.
1620 It appears as if the function pointer that is obtained when
1621 syms_of_w32menu is called from main is no longer valid
1622 (possibly due to DLL relocation?).
1623 To resolve this issue, I have placed calls to reinitialize
1624 these function pointers here because this function is the
1625 entry point for menu creation.
1627 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
1628 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
1629 /* This function is called before the first chance to redisplay
1630 the frame. It has to be, so the frame will have the right size. */
1631 FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1632 set_frame_menubar (f
, 1, 1);
1635 /* Get rid of the menu bar of frame F, and free its storage.
1636 This is used when deleting a frame, and when turning off the menu bar. */
1639 free_frame_menubar (f
)
1645 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1646 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1647 f
->output_data
.w32
->menubar_widget
= NULL
;
1655 /* w32_menu_show actually displays a menu using the panes and items in
1656 menu_items and returns the value selected from it; we assume input
1657 is blocked by the caller. */
1659 /* F is the frame the menu is for.
1660 X and Y are the frame-relative specified position,
1661 relative to the inside upper left corner of the frame F.
1662 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1663 KEYMAPS is 1 if this menu was specified with keymaps;
1664 in that case, we return a list containing the chosen item's value
1665 and perhaps also the pane's prefix.
1666 TITLE is the specified menu title.
1667 ERROR is a place to store an error message string in case of failure.
1668 (We return nil on failure, but the value doesn't actually matter.) */
1671 w32_menu_show (f
, x
, y
, for_click
, keymaps
, title
, error
)
1681 int menu_item_selection
;
1684 widget_value
*wv
, *save_wv
= 0, *first_wv
= 0, *prev_wv
= 0;
1685 widget_value
**submenu_stack
1686 = (widget_value
**) alloca (menu_items_used
* sizeof (widget_value
*));
1687 Lisp_Object
*subprefix_stack
1688 = (Lisp_Object
*) alloca (menu_items_used
* sizeof (Lisp_Object
));
1689 int submenu_depth
= 0;
1694 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1696 *error
= "Empty menu";
1700 /* Create a tree of widget_value objects
1701 representing the panes and their items. */
1702 wv
= xmalloc_widget_value ();
1706 wv
->button_type
= BUTTON_TYPE_NONE
;
1711 /* Loop over all panes and items, filling in the tree. */
1713 while (i
< menu_items_used
)
1715 if (EQ (AREF (menu_items
, i
), Qnil
))
1717 submenu_stack
[submenu_depth
++] = save_wv
;
1723 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1726 save_wv
= submenu_stack
[--submenu_depth
];
1730 else if (EQ (AREF (menu_items
, i
), Qt
)
1731 && submenu_depth
!= 0)
1732 i
+= MENU_ITEMS_PANE_LENGTH
;
1733 /* Ignore a nil in the item list.
1734 It's meaningful only for dialog boxes. */
1735 else if (EQ (AREF (menu_items
, i
), Qquote
))
1737 else if (EQ (AREF (menu_items
, i
), Qt
))
1739 /* Create a new pane. */
1740 Lisp_Object pane_name
, prefix
;
1742 pane_name
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_NAME
);
1743 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1744 #ifndef HAVE_MULTILINGUAL_MENU
1745 if (STRINGP (pane_name
) && STRING_MULTIBYTE (pane_name
))
1747 pane_name
= ENCODE_SYSTEM (pane_name
);
1748 ASET (menu_items
, i
+ MENU_ITEMS_PANE_NAME
, pane_name
);
1751 pane_string
= (NILP (pane_name
)
1752 ? "" : (char *) SDATA (pane_name
));
1753 /* If there is just one top-level pane, put all its items directly
1754 under the top-level menu. */
1755 if (menu_items_n_panes
== 1)
1758 /* If the pane has a meaningful name,
1759 make the pane a top-level menu item
1760 with its items as a submenu beneath it. */
1761 if (!keymaps
&& strcmp (pane_string
, ""))
1763 wv
= xmalloc_widget_value ();
1767 first_wv
->contents
= wv
;
1768 wv
->name
= pane_string
;
1769 if (keymaps
&& !NILP (prefix
))
1773 wv
->button_type
= BUTTON_TYPE_NONE
;
1778 else if (first_pane
)
1784 i
+= MENU_ITEMS_PANE_LENGTH
;
1788 /* Create a new item within current pane. */
1789 Lisp_Object item_name
, enable
, descrip
, def
, type
, selected
, help
;
1791 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
1792 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
1793 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
1794 def
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_DEFINITION
);
1795 type
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_TYPE
);
1796 selected
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_SELECTED
);
1797 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
1799 #ifndef HAVE_MULTILINGUAL_MENU
1800 if (STRINGP (item_name
) && STRING_MULTIBYTE (item_name
))
1802 item_name
= ENCODE_SYSTEM (item_name
);
1803 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
, item_name
);
1805 if (STRINGP (descrip
) && STRING_MULTIBYTE (descrip
))
1807 descrip
= ENCODE_SYSTEM (descrip
);
1808 ASET (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
, descrip
);
1810 #endif /* not HAVE_MULTILINGUAL_MENU */
1812 wv
= xmalloc_widget_value ();
1816 save_wv
->contents
= wv
;
1817 wv
->name
= (char *) SDATA (item_name
);
1818 if (!NILP (descrip
))
1819 wv
->key
= (char *) SDATA (descrip
);
1821 /* Use the contents index as call_data, since we are
1822 restricted to 16-bits. */
1823 wv
->call_data
= !NILP (def
) ? (void *) (EMACS_INT
) i
: 0;
1824 wv
->enabled
= !NILP (enable
);
1827 wv
->button_type
= BUTTON_TYPE_NONE
;
1828 else if (EQ (type
, QCtoggle
))
1829 wv
->button_type
= BUTTON_TYPE_TOGGLE
;
1830 else if (EQ (type
, QCradio
))
1831 wv
->button_type
= BUTTON_TYPE_RADIO
;
1835 wv
->selected
= !NILP (selected
);
1836 if (!STRINGP (help
))
1843 i
+= MENU_ITEMS_ITEM_LENGTH
;
1847 /* Deal with the title, if it is non-nil. */
1850 widget_value
*wv_title
= xmalloc_widget_value ();
1851 widget_value
*wv_sep
= xmalloc_widget_value ();
1853 /* Maybe replace this separator with a bitmap or owner-draw item
1854 so that it looks better. Having two separators looks odd. */
1855 wv_sep
->name
= "--";
1856 wv_sep
->next
= first_wv
->contents
;
1857 wv_sep
->help
= Qnil
;
1859 #ifndef HAVE_MULTILINGUAL_MENU
1860 if (STRING_MULTIBYTE (title
))
1861 title
= ENCODE_SYSTEM (title
);
1863 wv_title
->name
= (char *) SDATA (title
);
1864 wv_title
->enabled
= TRUE
;
1865 wv_title
->title
= TRUE
;
1866 wv_title
->button_type
= BUTTON_TYPE_NONE
;
1867 wv_title
->help
= Qnil
;
1868 wv_title
->next
= wv_sep
;
1869 first_wv
->contents
= wv_title
;
1872 /* Actually create the menu. */
1873 current_popup_menu
= menu
= CreatePopupMenu ();
1874 fill_in_menu (menu
, first_wv
->contents
);
1876 /* Adjust coordinates to be root-window-relative. */
1879 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1881 /* No selection has been chosen yet. */
1882 menu_item_selection
= 0;
1884 /* Display the menu. */
1885 menu_item_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1886 WM_EMACS_TRACKPOPUPMENU
,
1887 (WPARAM
)menu
, (LPARAM
)&pos
);
1889 /* Clean up extraneous mouse events which might have been generated
1891 discard_mouse_events ();
1893 /* Free the widget_value objects we used to specify the contents. */
1894 free_menubar_widget_value_tree (first_wv
);
1898 /* Find the selected item, and its pane, to return
1899 the proper value. */
1900 if (menu_item_selection
!= 0)
1902 Lisp_Object prefix
, entry
;
1904 prefix
= entry
= Qnil
;
1906 while (i
< menu_items_used
)
1908 if (EQ (AREF (menu_items
, i
), Qnil
))
1910 subprefix_stack
[submenu_depth
++] = prefix
;
1914 else if (EQ (AREF (menu_items
, i
), Qlambda
))
1916 prefix
= subprefix_stack
[--submenu_depth
];
1919 else if (EQ (AREF (menu_items
, i
), Qt
))
1921 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
1922 i
+= MENU_ITEMS_PANE_LENGTH
;
1924 /* Ignore a nil in the item list.
1925 It's meaningful only for dialog boxes. */
1926 else if (EQ (AREF (menu_items
, i
), Qquote
))
1930 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
1931 if (menu_item_selection
== i
)
1937 entry
= Fcons (entry
, Qnil
);
1939 entry
= Fcons (prefix
, entry
);
1940 for (j
= submenu_depth
- 1; j
>= 0; j
--)
1941 if (!NILP (subprefix_stack
[j
]))
1942 entry
= Fcons (subprefix_stack
[j
], entry
);
1946 i
+= MENU_ITEMS_ITEM_LENGTH
;
1956 static char * button_names
[] = {
1957 "button1", "button2", "button3", "button4", "button5",
1958 "button6", "button7", "button8", "button9", "button10" };
1961 w32_dialog_show (f
, keymaps
, title
, error
)
1967 int i
, nb_buttons
=0;
1968 char dialog_name
[6];
1969 int menu_item_selection
;
1971 widget_value
*wv
, *first_wv
= 0, *prev_wv
= 0;
1973 /* Number of elements seen so far, before boundary. */
1975 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1976 int boundary_seen
= 0;
1980 if (menu_items_n_panes
> 1)
1982 *error
= "Multiple panes in dialog box";
1986 /* Create a tree of widget_value objects
1987 representing the text label and buttons. */
1989 Lisp_Object pane_name
, prefix
;
1991 pane_name
= AREF (menu_items
, MENU_ITEMS_PANE_NAME
);
1992 prefix
= AREF (menu_items
, MENU_ITEMS_PANE_PREFIX
);
1993 pane_string
= (NILP (pane_name
)
1994 ? "" : (char *) SDATA (pane_name
));
1995 prev_wv
= xmalloc_widget_value ();
1996 prev_wv
->value
= pane_string
;
1997 if (keymaps
&& !NILP (prefix
))
1999 prev_wv
->enabled
= 1;
2000 prev_wv
->name
= "message";
2001 prev_wv
->help
= Qnil
;
2004 /* Loop over all panes and items, filling in the tree. */
2005 i
= MENU_ITEMS_PANE_LENGTH
;
2006 while (i
< menu_items_used
)
2009 /* Create a new item within current pane. */
2010 Lisp_Object item_name
, enable
, descrip
, help
;
2012 item_name
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_NAME
);
2013 enable
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_ENABLE
);
2014 descrip
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_EQUIV_KEY
);
2015 help
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_HELP
);
2017 if (NILP (item_name
))
2019 free_menubar_widget_value_tree (first_wv
);
2020 *error
= "Submenu in dialog items";
2023 if (EQ (item_name
, Qquote
))
2025 /* This is the boundary between left-side elts
2026 and right-side elts. Stop incrementing right_count. */
2031 if (nb_buttons
>= 9)
2033 free_menubar_widget_value_tree (first_wv
);
2034 *error
= "Too many dialog items";
2038 wv
= xmalloc_widget_value ();
2040 wv
->name
= (char *) button_names
[nb_buttons
];
2041 if (!NILP (descrip
))
2042 wv
->key
= (char *) SDATA (descrip
);
2043 wv
->value
= (char *) SDATA (item_name
);
2044 wv
->call_data
= (void *) &AREF (menu_items
, i
);
2045 wv
->enabled
= !NILP (enable
);
2049 if (! boundary_seen
)
2053 i
+= MENU_ITEMS_ITEM_LENGTH
;
2056 /* If the boundary was not specified,
2057 by default put half on the left and half on the right. */
2058 if (! boundary_seen
)
2059 left_count
= nb_buttons
- nb_buttons
/ 2;
2061 wv
= xmalloc_widget_value ();
2062 wv
->name
= dialog_name
;
2065 /* Dialog boxes use a really stupid name encoding
2066 which specifies how many buttons to use
2067 and how many buttons are on the right.
2068 The Q means something also. */
2069 dialog_name
[0] = 'Q';
2070 dialog_name
[1] = '0' + nb_buttons
;
2071 dialog_name
[2] = 'B';
2072 dialog_name
[3] = 'R';
2073 /* Number of buttons to put on the right. */
2074 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2076 wv
->contents
= first_wv
;
2080 /* Actually create the dialog. */
2081 dialog_id
= widget_id_tick
++;
2082 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2083 f
->output_data
.w32
->widget
, 1, 0,
2084 dialog_selection_callback
, 0);
2085 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, TRUE
);
2087 /* Free the widget_value objects we used to specify the contents. */
2088 free_menubar_widget_value_tree (first_wv
);
2090 /* No selection has been chosen yet. */
2091 menu_item_selection
= 0;
2093 /* Display the menu. */
2094 lw_pop_up_all_widgets (dialog_id
);
2095 popup_activated_flag
= 1;
2097 /* Process events that apply to the menu. */
2098 popup_get_selection ((XEvent
*) 0, FRAME_X_DISPLAY_INFO (f
), dialog_id
);
2100 lw_destroy_all_widgets (dialog_id
);
2102 /* Find the selected item, and its pane, to return
2103 the proper value. */
2104 if (menu_item_selection
!= 0)
2110 while (i
< menu_items_used
)
2114 if (EQ (AREF (menu_items
, i
), Qt
))
2116 prefix
= AREF (menu_items
, i
+ MENU_ITEMS_PANE_PREFIX
);
2117 i
+= MENU_ITEMS_PANE_LENGTH
;
2121 entry
= AREF (menu_items
, i
+ MENU_ITEMS_ITEM_VALUE
);
2122 if (menu_item_selection
== i
)
2126 entry
= Fcons (entry
, Qnil
);
2128 entry
= Fcons (prefix
, entry
);
2132 i
+= MENU_ITEMS_ITEM_LENGTH
;
2139 #endif /* HAVE_DIALOGS */
2142 /* Is this item a separator? */
2144 name_is_separator (name
)
2149 /* Check if name string consists of only dashes ('-'). */
2150 while (*name
== '-') name
++;
2151 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2152 or "--deep-shadow". We don't implement them yet, se we just treat
2153 them like normal separators. */
2154 return (*name
== '\0' || start
+ 2 == name
);
2158 /* Indicate boundary between left and right. */
2160 add_left_right_boundary (HMENU menu
)
2162 return AppendMenu (menu
, MF_MENUBARBREAK
, 0, NULL
);
2166 add_menu_item (HMENU menu
, widget_value
*wv
, HMENU item
)
2172 if (name_is_separator (wv
->name
))
2174 fuFlags
= MF_SEPARATOR
;
2180 fuFlags
= MF_STRING
;
2182 fuFlags
= MF_STRING
| MF_GRAYED
;
2184 if (wv
->key
!= NULL
)
2186 out_string
= alloca (strlen (wv
->name
) + strlen (wv
->key
) + 2);
2187 strcpy (out_string
, wv
->name
);
2188 strcat (out_string
, "\t");
2189 strcat (out_string
, wv
->key
);
2192 out_string
= wv
->name
;
2196 else if (wv
->title
|| wv
->call_data
== 0)
2198 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2199 we can't deallocate the memory otherwise. */
2200 if (get_menu_item_info
)
2202 out_string
= (char *) local_alloc (strlen (wv
->name
) + 1);
2203 strcpy (out_string
, wv
->name
);
2205 DebPrint ("Menu: allocing %ld for owner-draw", out_string
);
2207 fuFlags
= MF_OWNERDRAW
| MF_DISABLED
;
2210 fuFlags
= MF_DISABLED
;
2213 /* Draw radio buttons and tickboxes. */
2214 else if (wv
->selected
&& (wv
->button_type
== BUTTON_TYPE_TOGGLE
||
2215 wv
->button_type
== BUTTON_TYPE_RADIO
))
2216 fuFlags
|= MF_CHECKED
;
2218 fuFlags
|= MF_UNCHECKED
;
2224 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2227 /* This must be done after the menu item is created. */
2228 if (!wv
->title
&& wv
->call_data
!= 0)
2230 if (set_menu_item_info
)
2233 bzero (&info
, sizeof (info
));
2234 info
.cbSize
= sizeof (info
);
2235 info
.fMask
= MIIM_DATA
;
2237 /* Set help string for menu item. Leave it as a Lisp_Object
2238 until it is ready to be displayed, since GC can happen while
2239 menus are active. */
2241 info
.dwItemData
= (DWORD
) wv
->help
;
2243 if (wv
->button_type
== BUTTON_TYPE_RADIO
)
2245 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2246 RADIO items, but is not available on NT 3.51 and earlier. */
2247 info
.fMask
|= MIIM_TYPE
| MIIM_STATE
;
2248 info
.fType
= MFT_RADIOCHECK
| MFT_STRING
;
2249 info
.dwTypeData
= out_string
;
2250 info
.fState
= wv
->selected
? MFS_CHECKED
: MFS_UNCHECKED
;
2253 set_menu_item_info (menu
,
2254 item
!= NULL
? (UINT
) item
: (UINT
) wv
->call_data
,
2258 return return_value
;
2261 /* Construct native Windows menu(bar) based on widget_value tree. */
2263 fill_in_menu (HMENU menu
, widget_value
*wv
)
2265 int items_added
= 0;
2267 for ( ; wv
!= NULL
; wv
= wv
->next
)
2271 HMENU sub_menu
= CreatePopupMenu ();
2273 if (sub_menu
== NULL
)
2276 if (!fill_in_menu (sub_menu
, wv
->contents
) ||
2277 !add_menu_item (menu
, wv
, sub_menu
))
2279 DestroyMenu (sub_menu
);
2285 if (!add_menu_item (menu
, wv
, NULL
))
2295 /* popup_activated_flag not actually used on W32 */
2299 /* Display help string for currently pointed to menu item. Not
2300 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2303 w32_menu_display_help (HWND owner
, HMENU menu
, UINT item
, UINT flags
)
2305 if (get_menu_item_info
)
2307 struct frame
*f
= x_window_to_frame (&one_w32_display_info
, owner
);
2308 Lisp_Object frame
, help
;
2310 // No help echo on owner-draw menu items.
2311 if (flags
& MF_OWNERDRAW
|| flags
& MF_POPUP
)
2317 bzero (&info
, sizeof (info
));
2318 info
.cbSize
= sizeof (info
);
2319 info
.fMask
= MIIM_DATA
;
2320 get_menu_item_info (menu
, item
, FALSE
, &info
);
2322 help
= info
.dwItemData
? (Lisp_Object
) info
.dwItemData
: Qnil
;
2325 /* Store the help echo in the keyboard buffer as the X toolkit
2326 version does, rather than directly showing it. This seems to
2327 solve the GC problems that were present when we based the
2328 Windows code on the non-toolkit version. */
2331 XSETFRAME (frame
, f
);
2332 kbd_buffer_store_help_event (frame
, help
);
2335 /* X version has a loop through frames here, which doesn't
2336 appear to do anything, unless it has some side effect. */
2337 show_help_echo (help
, Qnil
, Qnil
, Qnil
, 1);
2341 /* Free memory used by owner-drawn strings. */
2343 w32_free_submenu_strings (menu
)
2346 int i
, num
= GetMenuItemCount (menu
);
2347 for (i
= 0; i
< num
; i
++)
2350 bzero (&info
, sizeof (info
));
2351 info
.cbSize
= sizeof (info
);
2352 info
.fMask
= MIIM_DATA
| MIIM_TYPE
| MIIM_SUBMENU
;
2354 get_menu_item_info (menu
, i
, TRUE
, &info
);
2356 /* Owner-drawn names are held in dwItemData. */
2357 if ((info
.fType
& MF_OWNERDRAW
) && info
.dwItemData
)
2360 DebPrint ("Menu: freeing %ld for owner-draw", info
.dwItemData
);
2362 local_free (info
.dwItemData
);
2365 /* Recurse down submenus. */
2367 w32_free_submenu_strings (info
.hSubMenu
);
2372 w32_free_menu_strings (hwnd
)
2375 HMENU menu
= current_popup_menu
;
2377 if (get_menu_item_info
)
2379 /* If there is no popup menu active, free the strings from the frame's
2382 menu
= GetMenu (hwnd
);
2385 w32_free_submenu_strings (menu
);
2388 current_popup_menu
= NULL
;
2391 #endif /* HAVE_MENUS */
2393 void syms_of_w32menu ()
2395 /* See if Get/SetMenuItemInfo functions are available. */
2396 HMODULE user32
= GetModuleHandle ("user32.dll");
2397 get_menu_item_info
= (GetMenuItemInfoA_Proc
) GetProcAddress (user32
, "GetMenuItemInfoA");
2398 set_menu_item_info
= (SetMenuItemInfoA_Proc
) GetProcAddress (user32
, "SetMenuItemInfoA");
2400 staticpro (&menu_items
);
2403 current_popup_menu
= NULL
;
2405 Qdebug_on_next_call
= intern ("debug-on-next-call");
2406 staticpro (&Qdebug_on_next_call
);
2408 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame
,
2409 doc
: /* Frame for which we are updating a menu.
2410 The enable predicate for a menu command should check this variable. */);
2411 Vmenu_updating_frame
= Qnil
;
2413 defsubr (&Sx_popup_menu
);
2415 defsubr (&Sx_popup_dialog
);