1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994 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. */
21 /* Written by Kevin Gallo. */
28 #include "termhooks.h"
32 #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 #define min(x, y) (((x) < (y)) ? (x) : (y))
48 #define max(x, y) (((x) > (y)) ? (x) : (y))
50 typedef struct menu_map
52 Lisp_Object menu_items
;
53 int menu_items_allocated
;
57 Lisp_Object Qdebug_on_next_call
;
59 extern Lisp_Object Qmenu_enable
;
60 extern Lisp_Object Qmenu_bar
;
62 extern Lisp_Object Voverriding_local_map
;
63 extern Lisp_Object Voverriding_local_map_menu_flag
;
65 extern Lisp_Object Qoverriding_local_map
, Qoverriding_terminal_local_map
;
67 extern Lisp_Object Qmenu_bar_update_hook
;
69 void set_frame_menubar ();
71 static Lisp_Object
w32_dialog_show ();
72 static Lisp_Object
w32menu_show ();
74 static HMENU
keymap_panes ();
75 static HMENU
single_keymap_panes ();
76 static HMENU
list_of_panes ();
77 static HMENU
list_of_items ();
79 static HMENU
create_menu_items ();
81 /* Initialize the menu_items structure if we haven't already done so.
82 Also mark it as currently empty. */
86 init_menu_items (lpmm
)
89 if (NILP (lpmm
->menu_items
))
91 lpmm
->menu_items_allocated
= 60;
92 lpmm
->menu_items
= Fmake_vector (make_number (lpmm
->menu_items_allocated
),
96 lpmm
->menu_items_used
= 0;
99 /* Make the menu_items vector twice as large. */
102 grow_menu_items (lpmm
)
106 int old_size
= lpmm
->menu_items_allocated
;
108 lpmm
->menu_items_allocated
*= 2;
109 new = Fmake_vector (make_number (lpmm
->menu_items_allocated
), Qnil
);
110 bcopy (XVECTOR (lpmm
->menu_items
)->contents
, XVECTOR (new)->contents
,
111 old_size
* sizeof (Lisp_Object
));
113 lpmm
->menu_items
= new;
117 /* Call when finished using the data for the current menu
121 discard_menu_items (lpmm
)
125 lpmm
->menu_items
= Qnil
;
127 lpmm
->menu_items_allocated
= lpmm
->menu_items_used
= 0;
130 /* Is this item a separator? */
132 name_is_separator (name
)
135 int isseparator
= (((char *)XSTRING (name
)->data
)[0] == 0);
139 /* Check if name string consists of only dashes ('-') */
140 char *string
= (char *)XSTRING (name
)->data
;
141 while (*string
== '-') string
++;
142 isseparator
= (*string
== 0);
149 /* Indicate boundary between left and right. */
152 add_left_right_boundary (hmenu
)
155 AppendMenu (hmenu
, MF_MENUBARBREAK
, 0, NULL
);
158 /* Push one menu item into the current pane.
159 NAME is the string to display. ENABLE if non-nil means
160 this item can be selected. KEY is the key generated by
161 choosing this item. EQUIV is the textual description
162 of the keyboard equivalent for this item (or nil if none). */
165 add_menu_item (lpmm
, hmenu
, name
, enable
, key
, equiv
)
174 Lisp_Object out_string
;
176 if (NILP (name
) || name_is_separator (name
))
177 fuFlags
= MF_SEPARATOR
;
183 fuFlags
= MF_STRING
| MF_GRAYED
;
187 out_string
= concat2 (name
, make_string ("\t", 1));
188 out_string
= concat2 (out_string
, equiv
);
196 lpmm
->menu_items_used
+ 1,
197 (fuFlags
== MF_SEPARATOR
)?NULL
:
198 (char *) XSTRING (out_string
)->data
);
200 lpmm
->menu_items_used
++;
202 if (lpmm
->menu_items_used
>= lpmm
->menu_items_allocated
)
203 grow_menu_items (lpmm
);
205 XSET (XVECTOR (lpmm
->menu_items
)->contents
[lpmm
->menu_items_used
++],
211 /* Figure out the current keyboard equivalent of a menu item ITEM1.
212 The item string for menu display should be ITEM_STRING.
213 Store the equivalent keyboard key sequence's
214 textual description into *DESCRIP_PTR.
215 Also cache them in the item itself.
216 Return the real definition to execute. */
219 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
220 Lisp_Object item_string
;
222 Lisp_Object
*descrip_ptr
;
224 /* This is the real definition--the function to run. */
226 /* This is the sublist that records cached equiv key data
227 so we can save time. */
228 Lisp_Object cachelist
;
229 /* These are the saved equivalent keyboard key sequence
230 and its key-description. */
231 Lisp_Object savedkey
, descrip
;
234 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
236 /* If a help string follows the item string, skip it. */
237 if (CONSP (XCONS (item1
)->cdr
)
238 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
239 item1
= XCONS (item1
)->cdr
;
243 /* Get out the saved equivalent-keyboard-key info. */
244 cachelist
= savedkey
= descrip
= Qnil
;
245 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
246 && (NILP (XCONS (XCONS (def
)->car
)->car
)
247 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
249 cachelist
= XCONS (def
)->car
;
250 def
= XCONS (def
)->cdr
;
251 savedkey
= XCONS (cachelist
)->car
;
252 descrip
= XCONS (cachelist
)->cdr
;
255 GCPRO4 (def
, def1
, savedkey
, descrip
);
257 /* Is it still valid? */
259 if (!NILP (savedkey
))
260 def1
= Fkey_binding (savedkey
, Qnil
);
261 /* If not, update it. */
263 /* If the command is an alias for another
264 (such as easymenu.el and lmenu.el set it up),
265 check if the original command matches the cached command. */
266 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
267 && EQ (def1
, XSYMBOL (def
)->function
))
268 /* If something had no key binding before, don't recheck it--
269 doing that takes too much time and makes menus too slow. */
270 && !(!NILP (cachelist
) && NILP (savedkey
)))
274 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
275 /* If the command is an alias for another
276 (such as easymenu.el and lmenu.el set it up),
277 see if the original command name has equivalent keys. */
278 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
279 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
282 if (VECTORP (savedkey
)
283 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
285 if (!NILP (savedkey
))
287 descrip
= Fkey_description (savedkey
);
288 descrip
= concat2 (make_string (" (", 3), descrip
);
289 descrip
= concat2 (descrip
, make_string (")", 1));
293 /* Cache the data we just got in a sublist of the menu binding. */
294 if (NILP (cachelist
))
295 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
298 XCONS (cachelist
)->car
= savedkey
;
299 XCONS (cachelist
)->cdr
= descrip
;
303 *descrip_ptr
= descrip
;
307 /* This is used as the handler when calling internal_condition_case_1. */
310 menu_item_enabled_p_1 (arg
)
316 /* Return non-nil if the command DEF is enabled when used as a menu item.
317 This is based on looking for a menu-enable property.
318 If NOTREAL is set, don't bother really computing this. */
321 menu_item_enabled_p (def
, notreal
)
324 Lisp_Object enabled
, tem
;
329 if (XTYPE (def
) == Lisp_Symbol
)
331 /* No property, or nil, means enable.
332 Otherwise, enable if value is not nil. */
333 tem
= Fget (def
, Qmenu_enable
);
335 /* (condition-case nil (eval tem)
337 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
338 menu_item_enabled_p_1
);
343 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
344 and generate menu panes for them in menu_items.
345 If NOTREAL is nonzero,
346 don't bother really computing whether an item is enabled. */
349 keymap_panes (lpmm
, keymaps
, nmaps
, notreal
)
351 Lisp_Object
*keymaps
;
358 init_menu_items (lpmm
);
367 hmenu
= CreatePopupMenu ();
369 if (!hmenu
) return (NULL
);
376 /* Loop over the given keymaps, making a pane for each map.
377 But don't make a pane that is empty--ignore that map instead.
378 P is the number of panes we have made so far. */
379 for (mapno
= 0; mapno
< nmaps
; mapno
++)
383 new_hmenu
= single_keymap_panes (lpmm
, keymaps
[mapno
],
384 Qnil
, Qnil
, notreal
);
386 if (!notreal
&& new_hmenu
)
388 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, "");
396 return (single_keymap_panes (lpmm
, keymaps
[0], Qnil
, Qnil
, notreal
));
400 /* This is a recursive subroutine of keymap_panes.
401 It handles one keymap, KEYMAP.
402 The other arguments are passed along
403 or point to local variables of the previous function.
404 If NOTREAL is nonzero,
405 don't bother really computing whether an item is enabled. */
408 single_keymap_panes (lpmm
, keymap
, pane_name
, prefix
, notreal
)
411 Lisp_Object pane_name
;
415 Lisp_Object pending_maps
;
416 Lisp_Object tail
, item
, item1
, item_string
, table
;
418 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
422 hmenu
= CreatePopupMenu ();
423 if (hmenu
== NULL
) return NULL
;
432 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
434 /* Look at each key binding, and if it has a menu string,
435 make a menu item from it. */
437 item
= XCONS (tail
)->car
;
441 item1
= XCONS (item
)->cdr
;
443 if (XTYPE (item1
) == Lisp_Cons
)
445 item_string
= XCONS (item1
)->car
;
446 if (XTYPE (item_string
) == Lisp_String
)
448 /* This is the real definition--the function to run. */
452 /* These are the saved equivalent keyboard key sequence
453 and its key-description. */
456 Lisp_Object tem
, enabled
;
458 /* GCPRO because ...enabled_p will call eval
459 and ..._equiv_key may autoload something.
460 Protecting KEYMAP preserves everything we use;
461 aside from that, must protect whatever might be
462 a string. Since there's no GCPRO5, we refetch
463 item_string instead of protecting it. */
465 descrip
= def
= Qnil
;
466 GCPRO4 (keymap
, pending_maps
, def
, prefix
);
468 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
472 enabled
= menu_item_enabled_p (def
, notreal
);
478 item_string
= XCONS (item1
)->car
;
480 tem
= Fkeymapp (def
);
481 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
483 pending_maps
= Fcons (Fcons (def
,
492 GCPRO5 (keymap
, pending_maps
, item
, item_string
, descrip
);
494 submap
= get_keymap_1 (def
, 0, 1);
506 Fcons (XCONS (item
)->car
, prefix
),
511 /* Display a submenu. */
513 HMENU new_hmenu
= single_keymap_panes (lpmm
,
521 AppendMenu (hmenu
, MF_POPUP
,
523 (char *) XSTRING (item_string
)->data
);
530 else if (VECTORP (item
))
532 /* Loop over the char values represented in the vector. */
533 int len
= XVECTOR (item
)->size
;
535 for (c
= 0; c
< len
; c
++)
537 Lisp_Object character
;
538 XSETFASTINT (character
, c
);
539 item1
= XVECTOR (item
)->contents
[c
];
542 item_string
= XCONS (item1
)->car
;
543 if (STRINGP (item_string
))
547 /* These are the saved equivalent keyboard key sequence
548 and its key-description. */
550 Lisp_Object tem
, enabled
;
552 /* GCPRO because ...enabled_p will call eval
553 and ..._equiv_key may autoload something.
554 Protecting KEYMAP preserves everything we use;
555 aside from that, must protect whatever might be
556 a string. Since there's no GCPRO5, we refetch
557 item_string instead of protecting it. */
558 GCPRO3 (keymap
, pending_maps
, def
);
559 descrip
= def
= Qnil
;
561 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
565 enabled
= menu_item_enabled_p (def
, notreal
);
571 item_string
= XCONS (item1
)->car
;
573 tem
= Fkeymapp (def
);
574 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
575 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
581 GCPRO5 (keymap
, pending_maps
, descrip
, item_string
, descrip
);
583 submap
= get_keymap_1 (def
, 0, 1);
600 /* Display a submenu. */
602 HMENU new_hmenu
= single_keymap_panes (lpmm
,
610 AppendMenu (hmenu
,MF_POPUP
,
612 (char *)XSTRING (item_string
)->data
);
622 /* Process now any submenus which want to be panes at this level. */
623 while (!NILP (pending_maps
))
625 Lisp_Object elt
, eltcdr
, string
;
626 elt
= Fcar (pending_maps
);
627 eltcdr
= XCONS (elt
)->cdr
;
628 string
= XCONS (eltcdr
)->car
;
629 /* We no longer discard the @ from the beginning of the string here.
630 Instead, we do this in w32menu_show. */
632 HMENU new_hmenu
= single_keymap_panes (lpmm
,
635 XCONS (eltcdr
)->cdr
, notreal
);
639 AppendMenu (hmenu
, MF_POPUP
,
641 (char *) XSTRING (string
)->data
);
645 pending_maps
= Fcdr (pending_maps
);
651 /* Push all the panes and items of a menu described by the
652 alist-of-alists MENU.
653 This handles old-fashioned calls to x-popup-menu. */
656 list_of_panes (lpmm
, menu
)
663 if (XFASTINT (Flength (menu
)) > 1)
665 hmenu
= CreatePopupMenu ();
666 if (hmenu
== NULL
) return NULL
;
668 /* init_menu_items (lpmm); */
670 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
672 Lisp_Object elt
, pane_name
, pane_data
;
676 pane_name
= Fcar (elt
);
677 CHECK_STRING (pane_name
, 0);
678 pane_data
= Fcdr (elt
);
679 CHECK_CONS (pane_data
, 0);
681 if (XSTRING (pane_name
)->data
[0] == 0)
683 list_of_items (hmenu
, lpmm
, pane_data
);
687 new_hmenu
= list_of_items (NULL
, lpmm
, pane_data
);
688 if (new_hmenu
== NULL
) goto error
;
690 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
691 (char *) XSTRING (pane_name
)->data
);
697 Lisp_Object elt
, pane_name
, pane_data
;
700 pane_name
= Fcar (elt
);
701 CHECK_STRING (pane_name
, 0);
702 pane_data
= Fcdr (elt
);
703 CHECK_CONS (pane_data
, 0);
704 hmenu
= list_of_items (NULL
, lpmm
, pane_data
);
714 /* Push the items in a single pane defined by the alist PANE. */
717 list_of_items (hmenu
, lpmm
, pane
)
722 Lisp_Object tail
, item
, item1
;
726 hmenu
= CreatePopupMenu ();
727 if (hmenu
== NULL
) return NULL
;
730 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
734 add_menu_item (lpmm
, hmenu
, item
, 0, Qnil
, Qnil
);
735 else if (NILP (item
))
736 add_left_right_boundary ();
739 CHECK_CONS (item
, 0);
741 CHECK_STRING (item1
, 1);
742 add_menu_item (lpmm
, hmenu
, item1
, 1, Fcdr (item
), Qnil
);
751 create_menu_items (lpmm
, menu
, notreal
)
757 Lisp_Object keymap
, tem
;
762 /* Decode the menu items from what was specified. */
764 keymap
= Fkeymapp (menu
);
766 if (XTYPE (menu
) == Lisp_Cons
)
767 tem
= Fkeymapp (Fcar (menu
));
771 /* We were given a keymap. Extract menu info from the keymap. */
773 keymap
= get_keymap (menu
);
775 /* Extract the detailed info to make one pane. */
776 hmenu
= keymap_panes (lpmm
, &keymap
, 1, notreal
);
779 /* Search for a string appearing directly as an element of the keymap.
780 That string is the title of the menu. */
781 prompt
= map_prompt (keymap
);
783 /* Make that be the pane title of the first pane. */
784 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
785 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
788 else if (!NILP (tem
))
790 /* We were given a list of keymaps. */
791 int nmaps
= XFASTINT (Flength (menu
));
793 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
798 /* The first keymap that has a prompt string
799 supplies the menu title. */
800 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
804 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
806 prompt
= map_prompt (keymap
);
807 if (NILP (title
) && !NILP (prompt
))
812 /* Extract the detailed info to make one pane. */
813 hmenu
= keymap_panes (lpmm
, maps
, nmaps
, notreal
);
816 /* Make the title be the pane title of the first pane. */
817 if (!NILP (title
) && menu_items_n_panes
>= 0)
818 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
823 /* We were given an old-fashioned menu. */
825 CHECK_STRING (title
, 1);
827 hmenu
= list_of_panes (lpmm
, Fcdr (menu
));
833 /* This is a recursive subroutine of keymap_panes.
834 It handles one keymap, KEYMAP.
835 The other arguments are passed along
836 or point to local variables of the previous function.
837 If NOTREAL is nonzero,
838 don't bother really computing whether an item is enabled. */
841 get_single_keymap_event (keymap
, lpnum
)
845 Lisp_Object pending_maps
;
846 Lisp_Object tail
, item
, item1
, item_string
, table
;
847 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
851 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
853 /* Look at each key binding, and if it has a menu string,
854 make a menu item from it. */
856 item
= XCONS (tail
)->car
;
858 if (XTYPE (item
) == Lisp_Cons
)
860 item1
= XCONS (item
)->cdr
;
864 item_string
= XCONS (item1
)->car
;
865 if (XTYPE (item_string
) == Lisp_String
)
867 /* This is the real definition--the function to run. */
871 /* These are the saved equivalent keyboard key sequence
872 and its key-description. */
875 Lisp_Object tem
, enabled
;
877 /* GCPRO because ...enabled_p will call eval
878 and ..._equiv_key may autoload something.
879 Protecting KEYMAP preserves everything we use;
880 aside from that, must protect whatever might be
881 a string. Since there's no GCPRO5, we refetch
882 item_string instead of protecting it. */
884 descrip
= def
= Qnil
;
885 GCPRO3 (keymap
, pending_maps
, def
);
887 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
891 item_string
= XCONS (item1
)->car
;
893 tem
= Fkeymapp (def
);
894 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
896 pending_maps
= Fcons (Fcons (def
,
905 GCPRO5 (keymap
, pending_maps
, item
, item_string
, descrip
);
907 submap
= get_keymap_1 (def
, 0, 1);
915 return (Fcons (XCONS (item
)->car
, Qnil
));
919 /* Display a submenu. */
921 Lisp_Object event
= get_single_keymap_event (submap
,
926 if (!NILP (XCONS (item
)->car
))
927 event
= Fcons (XCONS (item
)->car
, event
);
936 else if (VECTORP (item
))
938 /* Loop over the char values represented in the vector. */
939 int len
= XVECTOR (item
)->size
;
941 for (c
= 0; c
< len
; c
++)
943 Lisp_Object character
;
944 XSETFASTINT (character
, c
);
945 item1
= XVECTOR (item
)->contents
[c
];
946 if (XTYPE (item1
) == Lisp_Cons
)
948 item_string
= XCONS (item1
)->car
;
949 if (XTYPE (item_string
) == Lisp_String
)
953 /* These are the saved equivalent keyboard key sequence
954 and its key-description. */
956 Lisp_Object tem
, enabled
;
958 /* GCPRO because ...enabled_p will call eval
959 and ..._equiv_key may autoload something.
960 Protecting KEYMAP preserves everything we use;
961 aside from that, must protect whatever might be
962 a string. Since there's no GCPRO5, we refetch
963 item_string instead of protecting it. */
964 GCPRO3 (keymap
, pending_maps
, def
);
965 descrip
= def
= Qnil
;
967 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
971 item_string
= XCONS (item1
)->car
;
973 tem
= Fkeymapp (def
);
974 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
975 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
981 GCPRO5 (keymap
, pending_maps
, descrip
, item_string
, descrip
);
983 submap
= get_keymap_1 (def
, 0, 1);
991 return (Fcons (character
, Qnil
));
995 /* Display a submenu. */
997 Lisp_Object event
= get_single_keymap_event (submap
,
1002 if (!NILP (character
))
1003 event
= Fcons (character
, event
);
1015 /* Process now any submenus which want to be panes at this level. */
1016 while (!NILP (pending_maps
))
1018 Lisp_Object elt
, eltcdr
, string
;
1019 elt
= Fcar (pending_maps
);
1020 eltcdr
= XCONS (elt
)->cdr
;
1021 string
= XCONS (eltcdr
)->car
;
1022 /* We no longer discard the @ from the beginning of the string here.
1023 Instead, we do this in w32menu_show. */
1025 Lisp_Object event
= get_single_keymap_event (Fcar (elt
), lpnum
);
1029 if (!NILP (XCONS (eltcdr
)->cdr
))
1030 event
= Fcons (XCONS (eltcdr
)->cdr
, event
);
1036 pending_maps
= Fcdr (pending_maps
);
1042 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
1043 and generate menu panes for them in menu_items.
1044 If NOTREAL is nonzero,
1045 don't bother really computing whether an item is enabled. */
1048 get_keymap_event (keymaps
, nmaps
, lpnum
)
1049 Lisp_Object
*keymaps
;
1054 Lisp_Object event
= Qnil
;
1056 /* Loop over the given keymaps, making a pane for each map.
1057 But don't make a pane that is empty--ignore that map instead.
1058 P is the number of panes we have made so far. */
1059 for (mapno
= 0; mapno
< nmaps
; mapno
++)
1061 event
= get_single_keymap_event (keymaps
[mapno
], lpnum
);
1063 if (*lpnum
<= 0) break;
1070 get_list_of_items_event (pane
, lpnum
)
1074 Lisp_Object tail
, item
, item1
;
1076 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
1081 if (-- (*lpnum
) == 0)
1086 else if (!NILP (item
))
1088 if (--(*lpnum
) == 0)
1090 CHECK_CONS (item
, 0);
1091 return (Fcdr (item
));
1099 /* Push all the panes and items of a menu described by the
1100 alist-of-alists MENU.
1101 This handles old-fashioned calls to x-popup-menu. */
1104 get_list_of_panes_event (menu
, lpnum
)
1110 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
1112 Lisp_Object elt
, pane_name
, pane_data
;
1116 pane_data
= Fcdr (elt
);
1117 CHECK_CONS (pane_data
, 0);
1119 event
= get_list_of_items_event (pane_data
, lpnum
);
1131 get_menu_event (menu
, lpnum
)
1135 Lisp_Object keymap
, tem
;
1138 /* Decode the menu items from what was specified. */
1140 keymap
= Fkeymapp (menu
);
1142 if (XTYPE (menu
) == Lisp_Cons
)
1143 tem
= Fkeymapp (Fcar (menu
));
1147 keymap
= get_keymap (menu
);
1149 event
= get_keymap_event (&keymap
, 1, lpnum
);
1151 else if (!NILP (tem
))
1153 /* We were given a list of keymaps. */
1154 int nmaps
= XFASTINT (Flength (menu
));
1156 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1159 /* The first keymap that has a prompt string
1160 supplies the menu title. */
1161 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
1165 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
1168 event
= get_keymap_event (maps
, nmaps
, lpnum
);
1172 /* We were given an old-fashioned menu. */
1173 event
= get_list_of_panes_event (Fcdr (menu
), lpnum
);
1179 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1180 "Pop up a deck-of-cards menu and return user's selection.\n\
1181 POSITION is a position specification. This is either a mouse button event\n\
1182 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1183 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1184 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1185 This controls the position of the center of the first line\n\
1186 in the first pane of the menu, not the top left of the menu as a whole.\n\
1187 If POSITION is t, it means to use the current mouse position.\n\
1189 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1190 The menu items come from key bindings that have a menu string as well as\n\
1191 a definition; actually, the \"definition\" in such a key binding looks like\n\
1192 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1193 the keymap as a top-level element.\n\n\
1194 You can also use a list of keymaps as MENU.\n\
1195 Then each keymap makes a separate pane.\n\
1196 When MENU is a keymap or a list of keymaps, the return value\n\
1197 is a list of events.\n\n\
1198 Alternatively, you can specify a menu of multiple panes\n\
1199 with a list of the form (TITLE PANE1 PANE2...),\n\
1200 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1201 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1202 but a string can appear as an item--that makes a nonselectable line\n\
1204 With this form of menu, the return value is VALUE from the chosen item.\n\
1206 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1207 cached information about equivalent key sequences.")
1209 Lisp_Object position
, menu
;
1211 int number_of_panes
, panes
;
1212 Lisp_Object keymap
, tem
;
1216 Lisp_Object selection
;
1219 Lisp_Object x
, y
, window
;
1222 struct gcpro gcpro1
;
1226 if (! NILP (position
))
1228 /* Decode the first argument: find the window and the coordinates. */
1229 if (EQ (position
, Qt
)
1230 || (CONSP (position
) && EQ (XCONS (position
)->car
, Qmenu_bar
)))
1232 /* Use the mouse's current position. */
1233 FRAME_PTR new_f
= selected_frame
;
1234 Lisp_Object bar_window
;
1238 if (mouse_position_hook
)
1239 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
,
1242 XSETFRAME (window
, new_f
);
1245 window
= selected_window
;
1252 tem
= Fcar (position
);
1255 window
= Fcar (Fcdr (position
));
1257 y
= Fcar (Fcdr (tem
));
1261 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1262 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1263 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1267 /* Determine whether this menu is handling a menu bar click. */
1268 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
1269 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
1274 CHECK_NUMBER (x
, 0);
1275 CHECK_NUMBER (y
, 0);
1277 /* Decode where to put the menu. */
1279 if (FRAMEP (window
))
1281 f
= XFRAME (window
);
1286 else if (WINDOWP (window
))
1288 CHECK_LIVE_WINDOW (window
, 0);
1289 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1291 xpos
= (FONT_WIDTH (f
->output_data
.w32
->font
) * XWINDOW (window
)->left
);
1292 ypos
= (f
->output_data
.w32
->line_height
* XWINDOW (window
)->top
);
1295 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1296 but I don't want to make one now. */
1297 CHECK_WINDOW (window
, 0);
1306 discard_menu_items (&mm
);
1307 hmenu
= create_menu_items (&mm
, menu
, NILP (position
));
1309 if (NILP (position
))
1311 discard_menu_items (&mm
);
1316 /* Display them in a menu. */
1319 selection
= w32menu_show (f
, xpos
, ypos
, menu
, hmenu
, &error_name
);
1323 discard_menu_items (&mm
);
1324 DestroyMenu (hmenu
);
1328 if (error_name
) error (error_name
);
1332 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
1333 "Pop up a dialog box and return user's selection.\n\
1334 POSITION specifies which frame to use.\n\
1335 This is normally a mouse button event or a window or frame.\n\
1336 If POSITION is t, it means to use the frame the mouse is on.\n\
1337 The dialog box appears in the middle of the specified frame.\n\
1339 CONTENTS specifies the alternatives to display in the dialog box.\n\
1340 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1341 Each ITEM is a cons cell (STRING . VALUE).\n\
1342 The return value is VALUE from the chosen item.\n\n\
1343 An ITEM may also be just a string--that makes a nonselectable item.\n\
1344 An ITEM may also be nil--that means to put all preceding items\n\
1345 on the left of the dialog box and all following items on the right.\n\
1346 \(By default, approximately half appear on each side.)")
1347 (position
, contents
)
1348 Lisp_Object position
, contents
;
1353 /* Decode the first argument: find the window or frame to use. */
1354 if (EQ (position
, Qt
))
1356 /* Decode the first argument: find the window and the coordinates. */
1357 if (EQ (position
, Qt
))
1358 window
= selected_window
;
1360 else if (CONSP (position
))
1363 tem
= Fcar (position
);
1364 if (XTYPE (tem
) == Lisp_Cons
)
1365 window
= Fcar (Fcdr (position
));
1368 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1369 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1372 else if (WINDOWP (position
) || FRAMEP (position
))
1375 /* Decode where to put the menu. */
1377 if (FRAMEP (window
))
1378 f
= XFRAME (window
);
1379 else if (WINDOWP (window
))
1381 CHECK_LIVE_WINDOW (window
, 0);
1382 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1385 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1386 but I don't want to make one now. */
1387 CHECK_WINDOW (window
, 0);
1390 /* Display a menu with these alternatives
1391 in the middle of frame F. */
1393 Lisp_Object x
, y
, frame
, newpos
;
1394 XSETFRAME (frame
, f
);
1395 XSETINT (x
, x_pixel_width (f
) / 2);
1396 XSETINT (y
, x_pixel_height (f
) / 2);
1397 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1399 return Fx_popup_menu (newpos
,
1400 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1406 Lisp_Object selection
;
1408 /* Decode the dialog items from what was specified. */
1409 title
= Fcar (contents
);
1410 CHECK_STRING (title
, 1);
1412 list_of_panes (Fcons (contents
, Qnil
));
1414 /* Display them in a dialog box. */
1416 selection
= w32_dialog_show (f
, 0, 0, title
, &error_name
);
1419 discard_menu_items ();
1421 if (error_name
) error (error_name
);
1428 get_frame_menubar_event (f
, num
)
1432 Lisp_Object tail
, items
;
1434 struct gcpro gcpro1
;
1440 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1441 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1443 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1445 Lisp_Object event
, binding
;
1446 binding
= XVECTOR (items
)->contents
[i
+ 2];
1448 /* Check to see if this might be a menubar button. It might be
1449 if it is not a keymap, it is a cons cell, its car is not a
1450 keymap, and its cdr is nil. */
1451 if (NILP (Fkeymapp (binding
))
1453 && NILP (Fkeymapp (XCONS (binding
)->car
))
1454 && NILP (XCONS (binding
)->cdr
))
1456 /* The fact that we have to check that this is a string here
1457 is the reason we don't do all this rigamarole in
1459 if (XTYPE (XVECTOR (items
)->contents
[i
+ 1]) == Lisp_String
)
1461 /* This was a menubar button. */
1466 return (Fcons (XVECTOR (items
)->contents
[i
], Qnil
));
1472 event
= get_menu_event (binding
, &num
);
1478 return (Fcons (XVECTOR (items
)->contents
[i
], event
));
1489 /* Activate the menu bar of frame F.
1490 This is called from keyboard.c when it gets the
1491 menu_bar_activate_event out of the Emacs event queue.
1493 To activate the menu bar, we signal to the input thread that it can
1494 return from the WM_INITMENU message, allowing the normal Windows
1495 processing of the menus.
1497 But first we recompute the menu bar contents (the whole tree).
1499 This way we can safely execute Lisp code. */
1501 x_activate_menubar (f
)
1504 set_frame_menubar (f
, 0, 1);
1506 /* Lock out further menubar changes while active. */
1507 f
->output_data
.w32
->menubar_active
= 1;
1509 /* Signal input thread to return from WM_INITMENU. */
1510 complete_deferred_msg (FRAME_W32_WINDOW (f
), WM_INITMENU
, 0);
1514 set_frame_menubar (f
, first_time
, deep_p
)
1519 Lisp_Object tail
, items
;
1522 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
1524 int count
= specpdl_ptr
- specpdl
;
1526 struct buffer
*prev
= current_buffer
;
1529 /* We must not change the menubar when actually in use. */
1530 if (f
->output_data
.w32
->menubar_active
)
1533 #if 0 /* I don't see why this should be needed */
1534 /* Ensure menubar is up to date when about to be used. */
1535 if (f
->output_data
.w32
->pending_menu_activation
&& !deep_p
)
1539 buffer
= XWINDOW (FRAME_SELECTED_WINDOW (f
))->buffer
;
1540 specbind (Qinhibit_quit
, Qt
);
1541 /* Don't let the debugger step into this code
1542 because it is not reentrant. */
1543 specbind (Qdebug_on_next_call
, Qnil
);
1545 record_unwind_protect (Fstore_match_data
, Fmatch_data (Qnil
, Qnil
));
1546 if (NILP (Voverriding_local_map_menu_flag
))
1548 specbind (Qoverriding_terminal_local_map
, Qnil
);
1549 specbind (Qoverriding_local_map
, Qnil
);
1552 set_buffer_internal_1 (XBUFFER (buffer
));
1554 /* Run the Lucid hook. */
1555 call1 (Vrun_hooks
, Qactivate_menubar_hook
);
1556 /* If it has changed current-menubar from previous value,
1557 really recompute the menubar from the value. */
1558 if (! NILP (Vlucid_menu_bar_dirty_flag
))
1559 call0 (Qrecompute_lucid_menubar
);
1560 safe_run_hooks (Qmenu_bar_update_hook
);
1566 items
= FRAME_MENU_BAR_ITEMS (f
);
1568 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1570 hmenu
= f
->output_data
.w32
->menubar_widget
;
1573 hmenu
= CreateMenu ();
1574 if (!hmenu
) goto error
;
1578 /* Delete current contents. */
1579 while (DeleteMenu (hmenu
, 0, MF_BYPOSITION
))
1583 discard_menu_items (&mm
);
1586 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 4)
1588 Lisp_Object string
, binding
;
1593 string
= XVECTOR (items
)->contents
[i
+ 1];
1597 binding
= XVECTOR (items
)->contents
[i
+ 2];
1599 if (NILP (Fkeymapp (binding
))
1601 && NILP (Fkeymapp (XCONS (binding
)->car
))
1602 && NILP (XCONS (binding
)->cdr
))
1604 /* This is a menubar button. */
1605 Lisp_Object descrip
, def
;
1606 Lisp_Object enabled
, item
;
1607 item
= Fcons (string
, Fcar (binding
));
1608 descrip
= def
= Qnil
;
1610 GCPRO4 (items
, item
, def
, string
);
1612 def
= menu_item_equiv_key (string
, item
, &descrip
);
1613 enabled
= menu_item_enabled_p (def
, 0);
1618 add_menu_item (&mm
, hmenu
, string
, enabled
, def
, Qnil
);
1622 /* Input must not be blocked here because we call general
1623 Lisp code and internal_condition_case_1. */
1624 new_hmenu
= create_menu_items (&mm
, binding
, 0);
1630 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
1631 (char *) XSTRING (string
)->data
);
1638 HMENU old
= f
->output_data
.w32
->menubar_widget
;
1639 SetMenu (FRAME_W32_WINDOW (f
), hmenu
);
1640 f
->output_data
.w32
->menubar_widget
= hmenu
;
1641 /* Causes flicker when menu bar is updated
1642 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1644 /* Force the window size to be recomputed so that the frame's text
1645 area remains the same, if menubar has just been created. */
1647 x_set_window_size (f
, 0, FRAME_WIDTH (f
), FRAME_HEIGHT (f
));
1651 set_buffer_internal_1 (prev
);
1654 unbind_to (count
, Qnil
);
1658 free_frame_menubar (f
)
1664 HMENU old
= GetMenu (FRAME_W32_WINDOW (f
));
1665 SetMenu (FRAME_W32_WINDOW (f
), NULL
);
1666 f
->output_data
.w32
->menubar_widget
= NULL
;
1672 /* Called from Fw32_create_frame to create the initial menubar of a frame
1673 before it is mapped, so that the window is mapped with the menubar already
1674 there instead of us tacking it on later and thrashing the window after it
1677 initialize_frame_menubar (f
)
1680 set_frame_menubar (f
, 1, 1);
1684 /* If the mouse has moved to another menu bar item,
1685 return 1 and unread a button press event for that item.
1686 Otherwise return 0. */
1689 check_mouse_other_menu_bar (f
)
1693 Lisp_Object bar_window
;
1698 (*mouse_position_hook
) (&new_f
, 1, &bar_window
, &part
, &x
, &y
, &time
);
1700 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1702 unread_menu_bar_button (f
, x
);
1713 create_menu (keymaps
, error
)
1717 HMENU hmenu
= NULL
; /* the menu we are currently working on */
1718 HMENU first_hmenu
= NULL
;
1720 HMENU
*submenu_stack
= (HMENU
*) alloca (menu_items_used
* sizeof (HMENU
));
1721 Lisp_Object
*subprefix_stack
= (Lisp_Object
*) alloca (menu_items_used
*
1722 sizeof (Lisp_Object
));
1723 int submenu_depth
= 0;
1726 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1728 *error
= "Empty menu";
1734 /* Loop over all panes and items, filling in the tree. */
1736 while (i
< menu_items_used
)
1738 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1740 submenu_stack
[submenu_depth
++] = hmenu
;
1743 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1745 hmenu
= submenu_stack
[--submenu_depth
];
1749 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1750 && submenu_depth
!= 0)
1751 i
+= MENU_ITEMS_PANE_LENGTH
;
1753 /* Ignore a nil in the item list.
1754 It's meaningful only for dialog boxes. */
1755 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1757 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1759 /* Create a new pane. */
1761 Lisp_Object pane_name
;
1764 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1765 pane_string
= (NILP (pane_name
) ? "" : (char *) XSTRING (pane_name
)->data
);
1767 if (!hmenu
|| strcmp (pane_string
, ""))
1769 HMENU new_hmenu
= CreatePopupMenu ();
1773 *error
= "Could not create menu pane";
1779 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, pane_string
);
1784 if (!first_hmenu
) first_hmenu
= hmenu
;
1786 i
+= MENU_ITEMS_PANE_LENGTH
;
1790 /* Create a new item within current pane. */
1792 Lisp_Object item_name
, enable
, descrip
;
1795 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1796 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1797 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1799 if (name_is_separator (item_name
))
1800 fuFlags
= MF_SEPARATOR
;
1801 else if (NILP (enable
) || !XUINT (enable
))
1802 fuFlags
= MF_STRING
| MF_GRAYED
;
1804 fuFlags
= MF_STRING
;
1809 (char *) XSTRING (item_name
)->data
);
1811 // if (!NILP (descrip))
1812 // hmenu->key = (char *) XSTRING (descrip)->data;
1814 i
+= MENU_ITEMS_ITEM_LENGTH
;
1818 return (first_hmenu
);
1821 if (first_hmenu
) DestroyMenu (first_hmenu
);
1827 /* w32menu_show actually displays a menu using the panes and items in
1828 menu_items and returns the value selected from it.
1829 There are two versions of w32menu_show, one for Xt and one for Xlib.
1830 Both assume input is blocked by the caller. */
1832 /* F is the frame the menu is for.
1833 X and Y are the frame-relative specified position,
1834 relative to the inside upper left corner of the frame F.
1835 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1836 KEYMAPS is 1 if this menu was specified with keymaps;
1837 in that case, we return a list containing the chosen item's value
1838 and perhaps also the pane's prefix.
1839 TITLE is the specified menu title.
1840 ERROR is a place to store an error message string in case of failure.
1841 (We return nil on failure, but the value doesn't actually matter.) */
1845 w32menu_show (f
, x
, y
, menu
, hmenu
, error
)
1853 int i
, menu_selection
;
1860 *error
= "Empty menu";
1867 /* Offset the coordinates to root-relative. */
1868 ClientToScreen (FRAME_W32_WINDOW (f
), &pos
);
1871 /* If the mouse moves out of the menu before we show the menu,
1872 don't show it at all. */
1873 if (check_mouse_other_menu_bar (f
))
1875 DestroyMenu (hmenu
);
1880 /* Display the menu. */
1881 menu_selection
= SendMessage (FRAME_W32_WINDOW (f
),
1882 WM_EMACS_TRACKPOPUPMENU
,
1883 (WPARAM
)hmenu
, (LPARAM
)&pos
);
1885 /* Clean up extraneous mouse events which might have been generated
1887 discard_mouse_events ();
1889 if (menu_selection
== -1)
1891 *error
= "Invalid menu specification";
1895 /* Find the selected item, and its pane, to return
1896 the proper value. */
1899 if (menu_selection
> 0)
1901 return get_menu_event (menu
, &menu_selection
);
1904 if (menu_selection
> 0 && menu_selection
<= lpmm
->menu_items_used
)
1906 return (XVECTOR (lpmm
->menu_items
)->contents
[menu_selection
- 1]);
1914 static char * button_names
[] =
1916 "button1", "button2", "button3", "button4", "button5",
1917 "button6", "button7", "button8", "button9", "button10"
1921 w32_dialog_show (f
, menubarp
, keymaps
, title
, error
)
1928 int i
, nb_buttons
=0;
1930 char dialog_name
[6];
1932 /* Number of elements seen so far, before boundary. */
1934 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1935 int boundary_seen
= 0;
1939 if (menu_items_n_panes
> 1)
1941 *error
= "Multiple panes in dialog box";
1945 /* Create a tree of widget_value objects
1946 representing the text label and buttons. */
1948 Lisp_Object pane_name
, prefix
;
1950 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1951 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1952 pane_string
= (NILP (pane_name
)
1953 ? "" : (char *) XSTRING (pane_name
)->data
);
1954 prev_wv
= malloc_widget_value ();
1955 prev_wv
->value
= pane_string
;
1956 if (keymaps
&& !NILP (prefix
))
1958 prev_wv
->enabled
= 1;
1959 prev_wv
->name
= "message";
1962 /* Loop over all panes and items, filling in the tree. */
1963 i
= MENU_ITEMS_PANE_LENGTH
;
1964 while (i
< menu_items_used
)
1967 /* Create a new item within current pane. */
1968 Lisp_Object item_name
, enable
, descrip
;
1969 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1970 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1972 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1974 if (NILP (item_name
))
1976 free_menubar_widget_value_tree (first_wv
);
1977 *error
= "Submenu in dialog items";
1980 if (EQ (item_name
, Qquote
))
1982 /* This is the boundary between left-side elts
1983 and right-side elts. Stop incrementing right_count. */
1988 if (nb_buttons
>= 10)
1990 free_menubar_widget_value_tree (first_wv
);
1991 *error
= "Too many dialog items";
1995 wv
= malloc_widget_value ();
1997 wv
->name
= (char *) button_names
[nb_buttons
];
1998 if (!NILP (descrip
))
1999 wv
->key
= (char *) XSTRING (descrip
)->data
;
2000 wv
->value
= (char *) XSTRING (item_name
)->data
;
2001 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
2002 wv
->enabled
= !NILP (enable
);
2005 if (! boundary_seen
)
2009 i
+= MENU_ITEMS_ITEM_LENGTH
;
2012 /* If the boundary was not specified,
2013 by default put half on the left and half on the right. */
2014 if (! boundary_seen
)
2015 left_count
= nb_buttons
- nb_buttons
/ 2;
2017 wv
= malloc_widget_value ();
2018 wv
->name
= dialog_name
;
2020 /* Dialog boxes use a really stupid name encoding
2021 which specifies how many buttons to use
2022 and how many buttons are on the right.
2023 The Q means something also. */
2024 dialog_name
[0] = 'Q';
2025 dialog_name
[1] = '0' + nb_buttons
;
2026 dialog_name
[2] = 'B';
2027 dialog_name
[3] = 'R';
2028 /* Number of buttons to put on the right. */
2029 dialog_name
[4] = '0' + nb_buttons
- left_count
;
2031 wv
->contents
= first_wv
;
2035 /* Actually create the dialog. */
2036 dialog_id
= ++popup_id_tick
;
2037 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
2038 f
->output_data
.w32
->widget
, 1, 0,
2039 dialog_selection_callback
, 0);
2040 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
2041 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
2043 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
2044 /* Free the widget_value objects we used to specify the contents. */
2045 free_menubar_widget_value_tree (first_wv
);
2047 /* No selection has been chosen yet. */
2048 menu_item_selection
= 0;
2050 /* Display the menu. */
2051 lw_pop_up_all_widgets (dialog_id
);
2053 /* Process events that apply to the menu. */
2058 XtAppNextEvent (Xt_app_con
, &event
);
2059 if (event
.type
== ButtonRelease
)
2061 XtDispatchEvent (&event
);
2064 else if (event
.type
== Expose
)
2065 process_expose_from_menu (event
);
2066 XtDispatchEvent (&event
);
2067 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
2069 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
2071 if (queue_tmp
!= NULL
)
2073 queue_tmp
->event
= event
;
2074 queue_tmp
->next
= queue
;
2081 /* State that no mouse buttons are now held.
2082 That is not necessarily true, but the fiction leads to reasonable
2083 results, and it is a pain to ask which are actually held now
2084 or track this in the loop above. */
2085 w32_mouse_grabbed
= 0;
2087 /* Unread any events that we got but did not handle. */
2088 while (queue
!= NULL
)
2091 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
2092 queue
= queue_tmp
->next
;
2093 free ((char *)queue_tmp
);
2094 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2095 interrupt_input_pending
= 1;
2098 /* Find the selected item, and its pane, to return
2099 the proper value. */
2100 if (menu_item_selection
!= 0)
2106 while (i
< menu_items_used
)
2110 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
2113 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
2114 i
+= MENU_ITEMS_PANE_LENGTH
;
2119 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
2120 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
2124 entry
= Fcons (entry
, Qnil
);
2126 entry
= Fcons (prefix
, entry
);
2130 i
+= MENU_ITEMS_ITEM_LENGTH
;
2141 Qdebug_on_next_call
= intern ("debug-on-next-call");
2142 staticpro (&Qdebug_on_next_call
);
2144 defsubr (&Sx_popup_menu
);
2145 defsubr (&Sx_popup_dialog
);