1 /* X Communication module for terminals which understand the X protocol.
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, 675 Mass Ave, Cambridge, MA 02139, USA. */
20 /* Written by Kevin Gallo. */
27 #include "termhooks.h"
31 #include "blockinput.h"
33 /* This may include sys/types.h, and that somehow loses
34 if this is not done before the other system files. */
37 /* Load sys/types.h if not already loaded.
38 In some systems loading it twice is suicidal. */
40 #include <sys/types.h>
43 #include "dispextern.h"
45 #define min(x, y) (((x) < (y)) ? (x) : (y))
46 #define max(x, y) (((x) > (y)) ? (x) : (y))
48 typedef struct menu_map
50 Lisp_Object menu_items
;
51 int menu_items_allocated
;
55 extern Lisp_Object Qmenu_enable
;
56 extern Lisp_Object Qmenu_bar
;
58 static Lisp_Object
win32_dialog_show ();
59 static Lisp_Object
win32menu_show ();
61 static HMENU
keymap_panes ();
62 static HMENU
single_keymap_panes ();
63 static HMENU
list_of_panes ();
64 static HMENU
list_of_items ();
66 static HMENU
create_menu_items ();
68 /* Initialize the menu_items structure if we haven't already done so.
69 Also mark it as currently empty. */
72 init_menu_items (lpmm
)
75 if (NILP (lpmm
->menu_items
))
77 lpmm
->menu_items_allocated
= 60;
78 lpmm
->menu_items
= Fmake_vector (make_number (lpmm
->menu_items_allocated
),
82 lpmm
->menu_items_used
= 0;
85 /* Call when finished using the data for the current menu
89 discard_menu_items (lpmm
)
92 lpmm
->menu_items
= Qnil
;
93 lpmm
->menu_items_allocated
= lpmm
->menu_items_used
= 0;
96 /* Make the menu_items vector twice as large. */
99 grow_menu_items (lpmm
)
103 int old_size
= lpmm
->menu_items_allocated
;
105 lpmm
->menu_items_allocated
*= 2;
106 new = Fmake_vector (make_number (lpmm
->menu_items_allocated
), Qnil
);
107 bcopy (XVECTOR (lpmm
->menu_items
)->contents
, XVECTOR (new)->contents
,
108 old_size
* sizeof (Lisp_Object
));
110 lpmm
->menu_items
= new;
113 /* Indicate boundary between left and right. */
116 add_left_right_boundary (hmenu
)
119 AppendMenu (hmenu
, MF_MENUBARBREAK
, 0, NULL
);
122 /* Push one menu item into the current pane.
123 NAME is the string to display. ENABLE if non-nil means
124 this item can be selected. KEY is the key generated by
125 choosing this item. EQUIV is the textual description
126 of the keyboard equivalent for this item (or nil if none). */
129 add_menu_item (lpmm
, hmenu
, name
, enable
, key
)
139 || ((char *) XSTRING (name
)->data
)[0] == 0
140 || strcmp ((char *) XSTRING (name
)->data
, "--") == 0)
141 fuFlags
= MF_SEPARATOR
;
145 fuFlags
= MF_STRING
| MF_GRAYED
;
149 lpmm
->menu_items_used
+ 1,
150 (fuFlags
== MF_SEPARATOR
)?NULL
: (char *) XSTRING (name
)->data
);
152 lpmm
->menu_items_used
++;
154 if (lpmm
->menu_items_used
>= lpmm
->menu_items_allocated
)
155 grow_menu_items (lpmm
);
157 XSET (XVECTOR (lpmm
->menu_items
)->contents
[lpmm
->menu_items_used
++],
163 /* Figure out the current keyboard equivalent of a menu item ITEM1.
164 The item string for menu display should be ITEM_STRING.
165 Store the equivalent keyboard key sequence's
166 textual description into *DESCRIP_PTR.
167 Also cache them in the item itself.
168 Return the real definition to execute. */
171 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
172 Lisp_Object item_string
;
174 Lisp_Object
*descrip_ptr
;
176 /* This is the real definition--the function to run. */
178 /* This is the sublist that records cached equiv key data
179 so we can save time. */
180 Lisp_Object cachelist
;
181 /* These are the saved equivalent keyboard key sequence
182 and its key-description. */
183 Lisp_Object savedkey
, descrip
;
186 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
188 /* If a help string follows the item string, skip it. */
189 if (CONSP (XCONS (item1
)->cdr
)
190 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
191 item1
= XCONS (item1
)->cdr
;
195 /* Get out the saved equivalent-keyboard-key info. */
196 cachelist
= savedkey
= descrip
= Qnil
;
197 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
198 && (NILP (XCONS (XCONS (def
)->car
)->car
)
199 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
201 cachelist
= XCONS (def
)->car
;
202 def
= XCONS (def
)->cdr
;
203 savedkey
= XCONS (cachelist
)->car
;
204 descrip
= XCONS (cachelist
)->cdr
;
207 GCPRO4 (def
, def1
, savedkey
, descrip
);
209 /* Is it still valid? */
211 if (!NILP (savedkey
))
212 def1
= Fkey_binding (savedkey
, Qnil
);
213 /* If not, update it. */
215 /* If the command is an alias for another
216 (such as easymenu.el and lmenu.el set it up),
217 check if the original command matches the cached command. */
218 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
219 && EQ (def1
, XSYMBOL (def
)->function
))
220 /* If something had no key binding before, don't recheck it--
221 doing that takes too much time and makes menus too slow. */
222 && !(!NILP (cachelist
) && NILP (savedkey
)))
226 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
227 /* If the command is an alias for another
228 (such as easymenu.el and lmenu.el set it up),
229 see if the original command name has equivalent keys. */
230 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
231 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
234 if (VECTORP (savedkey
)
235 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
237 if (!NILP (savedkey
))
239 descrip
= Fkey_description (savedkey
);
240 descrip
= concat2 (make_string (" (", 3), descrip
);
241 descrip
= concat2 (descrip
, make_string (")", 1));
245 /* Cache the data we just got in a sublist of the menu binding. */
246 if (NILP (cachelist
))
247 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
250 XCONS (cachelist
)->car
= savedkey
;
251 XCONS (cachelist
)->cdr
= descrip
;
255 *descrip_ptr
= descrip
;
259 /* This is used as the handler when calling internal_condition_case_1. */
262 menu_item_enabled_p_1 (arg
)
268 /* Return non-nil if the command DEF is enabled when used as a menu item.
269 This is based on looking for a menu-enable property.
270 If NOTREAL is set, don't bother really computing this. */
273 menu_item_enabled_p (def
, notreal
)
276 Lisp_Object enabled
, tem
;
281 if (XTYPE (def
) == Lisp_Symbol
)
283 /* No property, or nil, means enable.
284 Otherwise, enable if value is not nil. */
285 tem
= Fget (def
, Qmenu_enable
);
287 /* (condition-case nil (eval tem)
289 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
290 menu_item_enabled_p_1
);
295 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
296 and generate menu panes for them in menu_items.
297 If NOTREAL is nonzero,
298 don't bother really computing whether an item is enabled. */
301 keymap_panes (lpmm
, keymaps
, nmaps
, notreal
)
303 Lisp_Object
*keymaps
;
309 // init_menu_items (lpmm);
317 hmenu
= CreateMenu ();
319 if (!hmenu
) return (NULL
);
326 /* Loop over the given keymaps, making a pane for each map.
327 But don't make a pane that is empty--ignore that map instead.
328 P is the number of panes we have made so far. */
329 for (mapno
= 0; mapno
< nmaps
; mapno
++)
333 new_hmenu
= single_keymap_panes (lpmm
, keymaps
[mapno
],
334 Qnil
, Qnil
, notreal
);
336 if (!notreal
&& new_hmenu
)
338 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, "");
346 return (single_keymap_panes (lpmm
, keymaps
[0], Qnil
, Qnil
, notreal
));
350 /* This is a recursive subroutine of keymap_panes.
351 It handles one keymap, KEYMAP.
352 The other arguments are passed along
353 or point to local variables of the previous function.
354 If NOTREAL is nonzero,
355 don't bother really computing whether an item is enabled. */
358 single_keymap_panes (lpmm
, keymap
, pane_name
, prefix
, notreal
)
361 Lisp_Object pane_name
;
365 Lisp_Object pending_maps
;
366 Lisp_Object tail
, item
, item1
, item_string
, table
;
368 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
372 hmenu
= CreateMenu ();
373 if (hmenu
== NULL
) return NULL
;
382 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
384 /* Look at each key binding, and if it has a menu string,
385 make a menu item from it. */
387 item
= XCONS (tail
)->car
;
391 item1
= XCONS (item
)->cdr
;
393 if (XTYPE (item1
) == Lisp_Cons
)
395 item_string
= XCONS (item1
)->car
;
396 if (XTYPE (item_string
) == Lisp_String
)
398 /* This is the real definition--the function to run. */
402 /* These are the saved equivalent keyboard key sequence
403 and its key-description. */
406 Lisp_Object tem
, enabled
;
408 /* GCPRO because ...enabled_p will call eval
409 and ..._equiv_key may autoload something.
410 Protecting KEYMAP preserves everything we use;
411 aside from that, must protect whatever might be
412 a string. Since there's no GCPRO5, we refetch
413 item_string instead of protecting it. */
415 descrip
= def
= Qnil
;
416 GCPRO4 (keymap
, pending_maps
, def
, prefix
);
418 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
419 enabled
= menu_item_enabled_p (def
, notreal
);
423 item_string
= XCONS (item1
)->car
;
425 tem
= Fkeymapp (def
);
426 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
428 pending_maps
= Fcons (Fcons (def
,
437 GCPRO4 (keymap
, pending_maps
, item
, item_string
);
439 submap
= get_keymap_1 (def
, 0, 1);
451 Fcons (XCONS (item
)->car
, prefix
));
455 /* Display a submenu. */
457 HMENU new_hmenu
= single_keymap_panes (lpmm
,
465 AppendMenu (hmenu
, MF_POPUP
,
467 (char *) XSTRING (item_string
)->data
);
474 else if (VECTORP (item
))
476 /* Loop over the char values represented in the vector. */
477 int len
= XVECTOR (item
)->size
;
479 for (c
= 0; c
< len
; c
++)
481 Lisp_Object character
;
482 XSETFASTINT (character
, c
);
483 item1
= XVECTOR (item
)->contents
[c
];
486 item_string
= XCONS (item1
)->car
;
487 if (STRINGP (item_string
))
491 /* These are the saved equivalent keyboard key sequence
492 and its key-description. */
494 Lisp_Object tem
, enabled
;
496 /* GCPRO because ...enabled_p will call eval
497 and ..._equiv_key may autoload something.
498 Protecting KEYMAP preserves everything we use;
499 aside from that, must protect whatever might be
500 a string. Since there's no GCPRO5, we refetch
501 item_string instead of protecting it. */
502 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
503 descrip
= def
= Qnil
;
505 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
506 enabled
= menu_item_enabled_p (def
, notreal
);
510 item_string
= XCONS (item1
)->car
;
512 tem
= Fkeymapp (def
);
513 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
514 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
520 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
522 submap
= get_keymap_1 (def
, 0, 1);
538 /* Display a submenu. */
540 HMENU new_hmenu
= single_keymap_panes (lpmm
,
548 AppendMenu (hmenu
,MF_POPUP
,
550 (char *)XSTRING (item_string
)->data
);
560 /* Process now any submenus which want to be panes at this level. */
561 while (!NILP (pending_maps
))
563 Lisp_Object elt
, eltcdr
, string
;
564 elt
= Fcar (pending_maps
);
565 eltcdr
= XCONS (elt
)->cdr
;
566 string
= XCONS (eltcdr
)->car
;
567 /* We no longer discard the @ from the beginning of the string here.
568 Instead, we do this in win32menu_show. */
570 HMENU new_hmenu
= single_keymap_panes (lpmm
,
573 XCONS (eltcdr
)->cdr
, notreal
);
577 AppendMenu (hmenu
, MF_POPUP
,
579 (char *) XSTRING (string
)->data
);
583 pending_maps
= Fcdr (pending_maps
);
589 /* Push all the panes and items of a menu decsribed by the
590 alist-of-alists MENU.
591 This handles old-fashioned calls to x-popup-menu. */
594 list_of_panes (lpmm
, menu
)
601 hmenu
= CreateMenu ();
602 if (hmenu
== NULL
) return NULL
;
604 // init_menu_items (lpmm);
606 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
608 Lisp_Object elt
, pane_name
, pane_data
;
612 pane_name
= Fcar (elt
);
613 CHECK_STRING (pane_name
, 0);
614 pane_data
= Fcdr (elt
);
615 CHECK_CONS (pane_data
, 0);
617 new_hmenu
= list_of_items (lpmm
, pane_data
);
618 if (new_hmenu
== NULL
) goto error
;
620 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
621 (char *) XSTRING (pane_name
)->data
);
632 /* Push the items in a single pane defined by the alist PANE. */
635 list_of_items (lpmm
, pane
)
639 Lisp_Object tail
, item
, item1
;
642 hmenu
= CreateMenu ();
643 if (hmenu
== NULL
) return NULL
;
645 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
649 add_menu_item (lpmm
, hmenu
, item
, Qnil
, Qnil
);
650 else if (NILP (item
))
651 add_left_right_boundary ();
654 CHECK_CONS (item
, 0);
656 CHECK_STRING (item1
, 1);
657 add_menu_item (lpmm
, hmenu
, item1
, Qt
, Fcdr (item
));
666 create_menu_items (lpmm
, menu
, notreal
)
672 Lisp_Object keymap
, tem
;
677 /* Decode the menu items from what was specified. */
679 keymap
= Fkeymapp (menu
);
681 if (XTYPE (menu
) == Lisp_Cons
)
682 tem
= Fkeymapp (Fcar (menu
));
686 /* We were given a keymap. Extract menu info from the keymap. */
688 keymap
= get_keymap (menu
);
690 /* Extract the detailed info to make one pane. */
691 hmenu
= keymap_panes (lpmm
, &keymap
, 1, notreal
);
694 /* Search for a string appearing directly as an element of the keymap.
695 That string is the title of the menu. */
696 prompt
= map_prompt (keymap
);
698 /* Make that be the pane title of the first pane. */
699 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
700 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
703 else if (!NILP (tem
))
705 /* We were given a list of keymaps. */
706 int nmaps
= XFASTINT (Flength (menu
));
708 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
713 /* The first keymap that has a prompt string
714 supplies the menu title. */
715 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
719 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
721 prompt
= map_prompt (keymap
);
722 if (NILP (title
) && !NILP (prompt
))
727 /* Extract the detailed info to make one pane. */
728 hmenu
= keymap_panes (lpmm
, maps
, nmaps
, notreal
);
731 /* Make the title be the pane title of the first pane. */
732 if (!NILP (title
) && menu_items_n_panes
>= 0)
733 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
738 /* We were given an old-fashioned menu. */
740 CHECK_STRING (title
, 1);
742 hmenu
= list_of_panes (lpmm
, Fcdr (menu
));
748 /* This is a recursive subroutine of keymap_panes.
749 It handles one keymap, KEYMAP.
750 The other arguments are passed along
751 or point to local variables of the previous function.
752 If NOTREAL is nonzero,
753 don't bother really computing whether an item is enabled. */
756 get_single_keymap_event (keymap
, lpnum
)
760 Lisp_Object pending_maps
;
761 Lisp_Object tail
, item
, item1
, item_string
, table
;
762 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
766 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
768 /* Look at each key binding, and if it has a menu string,
769 make a menu item from it. */
771 item
= XCONS (tail
)->car
;
773 if (XTYPE (item
) == Lisp_Cons
)
775 item1
= XCONS (item
)->cdr
;
779 item_string
= XCONS (item1
)->car
;
780 if (XTYPE (item_string
) == Lisp_String
)
782 /* This is the real definition--the function to run. */
786 /* These are the saved equivalent keyboard key sequence
787 and its key-description. */
790 Lisp_Object tem
, enabled
;
792 /* GCPRO because ...enabled_p will call eval
793 and ..._equiv_key may autoload something.
794 Protecting KEYMAP preserves everything we use;
795 aside from that, must protect whatever might be
796 a string. Since there's no GCPRO5, we refetch
797 item_string instead of protecting it. */
799 descrip
= def
= Qnil
;
800 GCPRO3 (keymap
, pending_maps
, def
);
802 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
806 item_string
= XCONS (item1
)->car
;
808 tem
= Fkeymapp (def
);
809 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
811 pending_maps
= Fcons (Fcons (def
,
820 GCPRO4 (keymap
, pending_maps
, item
, item_string
);
822 submap
= get_keymap_1 (def
, 0, 1);
830 return (Fcons (XCONS (item
)->car
, Qnil
));
834 /* Display a submenu. */
836 Lisp_Object event
= get_single_keymap_event (submap
,
841 if (!NILP (XCONS (item
)->car
))
842 event
= Fcons (XCONS (item
)->car
, event
);
851 else if (VECTORP (item
))
853 /* Loop over the char values represented in the vector. */
854 int len
= XVECTOR (item
)->size
;
856 for (c
= 0; c
< len
; c
++)
858 Lisp_Object character
;
859 XSETFASTINT (character
, c
);
860 item1
= XVECTOR (item
)->contents
[c
];
861 if (XTYPE (item1
) == Lisp_Cons
)
863 item_string
= XCONS (item1
)->car
;
864 if (XTYPE (item_string
) == Lisp_String
)
868 /* These are the saved equivalent keyboard key sequence
869 and its key-description. */
871 Lisp_Object tem
, enabled
;
873 /* GCPRO because ...enabled_p will call eval
874 and ..._equiv_key may autoload something.
875 Protecting KEYMAP preserves everything we use;
876 aside from that, must protect whatever might be
877 a string. Since there's no GCPRO5, we refetch
878 item_string instead of protecting it. */
879 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
880 descrip
= def
= Qnil
;
882 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
886 item_string
= XCONS (item1
)->car
;
888 tem
= Fkeymapp (def
);
889 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
890 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
896 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
898 submap
= get_keymap_1 (def
, 0, 1);
906 return (Fcons (character
, Qnil
));
910 /* Display a submenu. */
912 Lisp_Object event
= get_single_keymap_event (submap
,
917 if (!NILP (character
))
918 event
= Fcons (character
, event
);
930 /* Process now any submenus which want to be panes at this level. */
931 while (!NILP (pending_maps
))
933 Lisp_Object elt
, eltcdr
, string
;
934 elt
= Fcar (pending_maps
);
935 eltcdr
= XCONS (elt
)->cdr
;
936 string
= XCONS (eltcdr
)->car
;
937 /* We no longer discard the @ from the beginning of the string here.
938 Instead, we do this in win32menu_show. */
940 Lisp_Object event
= get_single_keymap_event (Fcar (elt
), lpnum
);
944 if (!NILP (XCONS (eltcdr
)->cdr
))
945 event
= Fcons (XCONS (eltcdr
)->cdr
, event
);
951 pending_maps
= Fcdr (pending_maps
);
957 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
958 and generate menu panes for them in menu_items.
959 If NOTREAL is nonzero,
960 don't bother really computing whether an item is enabled. */
963 get_keymap_event (keymaps
, nmaps
, lpnum
)
964 Lisp_Object
*keymaps
;
969 Lisp_Object event
= Qnil
;
971 /* Loop over the given keymaps, making a pane for each map.
972 But don't make a pane that is empty--ignore that map instead.
973 P is the number of panes we have made so far. */
974 for (mapno
= 0; mapno
< nmaps
; mapno
++)
976 event
= get_single_keymap_event (keymaps
[mapno
], lpnum
);
978 if (*lpnum
<= 0) break;
985 get_list_of_items_event (pane
, lpnum
)
989 Lisp_Object tail
, item
, item1
;
991 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
996 if (-- (*lpnum
) == 0)
1001 else if (!NILP (item
))
1003 if (--(*lpnum
) == 0)
1005 CHECK_CONS (item
, 0);
1006 return (Fcdr (item
));
1014 /* Push all the panes and items of a menu decsribed by the
1015 alist-of-alists MENU.
1016 This handles old-fashioned calls to x-popup-menu. */
1019 get_list_of_panes_event (menu
, lpnum
)
1025 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
1027 Lisp_Object elt
, pane_name
, pane_data
;
1031 pane_data
= Fcdr (elt
);
1032 CHECK_CONS (pane_data
, 0);
1034 event
= get_list_of_items_event (pane_data
, lpnum
);
1046 get_menu_event (menu
, lpnum
)
1050 Lisp_Object keymap
, tem
;
1053 /* Decode the menu items from what was specified. */
1055 keymap
= Fkeymapp (menu
);
1057 if (XTYPE (menu
) == Lisp_Cons
)
1058 tem
= Fkeymapp (Fcar (menu
));
1062 keymap
= get_keymap (menu
);
1064 event
= get_keymap_event (menu
, 1, lpnum
);
1066 else if (!NILP (tem
))
1068 /* We were given a list of keymaps. */
1069 int nmaps
= XFASTINT (Flength (menu
));
1071 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1074 /* The first keymap that has a prompt string
1075 supplies the menu title. */
1076 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
1080 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
1083 event
= get_keymap_event (maps
, nmaps
, lpnum
);
1087 /* We were given an old-fashioned menu. */
1088 event
= get_list_of_panes_event (Fcdr (menu
), lpnum
);
1094 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1095 "Pop up a deck-of-cards menu and return user's selection.\n\
1096 POSITION is a position specification. This is either a mouse button event\n\
1097 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1098 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1099 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1100 This controls the position of the center of the first line\n\
1101 in the first pane of the menu, not the top left of the menu as a whole.\n\
1102 If POSITION is t, it means to use the current mouse position.\n\
1104 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1105 The menu items come from key bindings that have a menu string as well as\n\
1106 a definition; actually, the \"definition\" in such a key binding looks like\n\
1107 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1108 the keymap as a top-level element.\n\n\
1109 You can also use a list of keymaps as MENU.\n\
1110 Then each keymap makes a separate pane.\n\
1111 When MENU is a keymap or a list of keymaps, the return value\n\
1112 is a list of events.\n\n\
1113 Alternatively, you can specify a menu of multiple panes\n\
1114 with a list of the form (TITLE PANE1 PANE2...),\n\
1115 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1116 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1117 but a string can appear as an item--that makes a nonselectable line\n\
1119 With this form of menu, the return value is VALUE from the chosen item.\n\
1121 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1122 cached information about equivalent key sequences.")
1124 Lisp_Object position
, menu
;
1126 int number_of_panes
, panes
;
1127 Lisp_Object keymap
, tem
;
1131 Lisp_Object selection
;
1134 Lisp_Object x
, y
, window
;
1137 struct gcpro gcpro1
;
1141 if (! NILP (position
))
1143 /* Decode the first argument: find the window and the coordinates. */
1144 if (EQ (position
, Qt
))
1146 /* Use the mouse's current position. */
1147 FRAME_PTR new_f
= 0;
1148 Lisp_Object bar_window
;
1152 if (mouse_position_hook
)
1153 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1155 XSETFRAME (window
, new_f
);
1158 window
= selected_window
;
1165 tem
= Fcar (position
);
1168 window
= Fcar (Fcdr (position
));
1170 y
= Fcar (Fcdr (tem
));
1174 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1175 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1176 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1180 /* Determine whether this menu is handling a menu bar click. */
1181 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
1182 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
1187 CHECK_NUMBER (x
, 0);
1188 CHECK_NUMBER (y
, 0);
1190 /* Decode where to put the menu. */
1192 if (FRAMEP (window
))
1194 f
= XFRAME (window
);
1199 else if (WINDOWP (window
))
1201 CHECK_LIVE_WINDOW (window
, 0);
1202 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1204 xpos
= (FONT_WIDTH (f
->output_data
.win32
->font
) * XWINDOW (window
)->left
);
1205 ypos
= (f
->output_data
.win32
->line_height
* XWINDOW (window
)->top
);
1208 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1209 but I don't want to make one now. */
1210 CHECK_WINDOW (window
, 0);
1219 discard_menu_items (&mm
);
1220 hmenu
= create_menu_items (&mm
, menu
, NILP (position
));
1222 if (NILP (position
))
1224 discard_menu_items (&mm
);
1229 /* Display them in a menu. */
1232 selection
= win32menu_show (f
, xpos
, ypos
, menu
, &hmenu
, &error_name
);
1236 discard_menu_items (&mm
);
1237 DestroyMenu (hmenu
);
1241 if (error_name
) error (error_name
);
1245 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
1246 "Pop up a dialog box and return user's selection.\n\
1247 POSITION specifies which frame to use.\n\
1248 This is normally a mouse button event or a window or frame.\n\
1249 If POSITION is t, it means to use the frame the mouse is on.\n\
1250 The dialog box appears in the middle of the specified frame.\n\
1252 CONTENTS specifies the alternatives to display in the dialog box.\n\
1253 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1254 Each ITEM is a cons cell (STRING . VALUE).\n\
1255 The return value is VALUE from the chosen item.\n\n\
1256 An ITEM may also be just a string--that makes a nonselectable item.\n\
1257 An ITEM may also be nil--that means to put all preceding items\n\
1258 on the left of the dialog box and all following items on the right.\n\
1259 \(By default, approximately half appear on each side.)")
1260 (position
, contents
)
1261 Lisp_Object position
, contents
;
1266 /* Decode the first argument: find the window or frame to use. */
1267 if (EQ (position
, Qt
))
1269 /* Decode the first argument: find the window and the coordinates. */
1270 if (EQ (position
, Qt
))
1271 window
= selected_window
;
1273 else if (CONSP (position
))
1276 tem
= Fcar (position
);
1277 if (XTYPE (tem
) == Lisp_Cons
)
1278 window
= Fcar (Fcdr (position
));
1281 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1282 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1285 else if (WINDOWP (position
) || FRAMEP (position
))
1288 /* Decode where to put the menu. */
1290 if (FRAMEP (window
))
1291 f
= XFRAME (window
);
1292 else if (WINDOWP (window
))
1294 CHECK_LIVE_WINDOW (window
, 0);
1295 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1298 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1299 but I don't want to make one now. */
1300 CHECK_WINDOW (window
, 0);
1303 /* Display a menu with these alternatives
1304 in the middle of frame F. */
1306 Lisp_Object x
, y
, frame
, newpos
;
1307 XSETFRAME (frame
, f
);
1308 XSETINT (x
, x_pixel_width (f
) / 2);
1309 XSETINT (y
, x_pixel_height (f
) / 2);
1310 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1312 return Fx_popup_menu (newpos
,
1313 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1319 Lisp_Object selection
;
1321 /* Decode the dialog items from what was specified. */
1322 title
= Fcar (contents
);
1323 CHECK_STRING (title
, 1);
1325 list_of_panes (Fcons (contents
, Qnil
));
1327 /* Display them in a dialog box. */
1329 selection
= win32_dialog_show (f
, 0, 0, title
, &error_name
);
1332 discard_menu_items ();
1334 if (error_name
) error (error_name
);
1341 get_frame_menubar_event (f
, num
)
1345 Lisp_Object tail
, items
;
1347 struct gcpro gcpro1
;
1353 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1354 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1356 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1360 event
= get_menu_event (XVECTOR (items
)->contents
[i
+ 2], &num
);
1366 return (Fcons (XVECTOR (items
)->contents
[i
], event
));
1377 set_frame_menubar (f
, first_time
)
1381 Lisp_Object tail
, items
;
1384 struct gcpro gcpro1
;
1391 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1392 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1394 hmenu
= CreateMenu ();
1396 if (!hmenu
) goto error
;
1398 discard_menu_items (&mm
);
1400 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1407 string
= XVECTOR (items
)->contents
[i
+ 1];
1411 new_hmenu
= create_menu_items (&mm
,
1412 XVECTOR (items
)->contents
[i
+ 2],
1418 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
1419 (char *) XSTRING (string
)->data
);
1423 HMENU old
= GetMenu (FRAME_WIN32_WINDOW (f
));
1424 SetMenu (FRAME_WIN32_WINDOW (f
), hmenu
);
1434 free_frame_menubar (f
)
1440 HMENU old
= GetMenu (FRAME_WIN32_WINDOW (f
));
1441 SetMenu (FRAME_WIN32_WINDOW (f
), NULL
);
1447 /* Called from Fwin32_create_frame to create the inital menubar of a frame
1448 before it is mapped, so that the window is mapped with the menubar already
1449 there instead of us tacking it on later and thrashing the window after it
1452 initialize_frame_menubar (f
)
1455 set_frame_menubar (f
, 1);
1459 /* If the mouse has moved to another menu bar item,
1460 return 1 and unread a button press event for that item.
1461 Otherwise return 0. */
1464 check_mouse_other_menu_bar (f
)
1468 Lisp_Object bar_window
;
1473 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1475 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1477 unread_menu_bar_button (f
, x
);
1488 create_menu (keymaps
, error
)
1492 HMENU hmenu
= NULL
; /* the menu we are currently working on */
1493 HMENU first_hmenu
= NULL
;
1495 HMENU
*submenu_stack
= (HMENU
*) alloca (menu_items_used
* sizeof (HMENU
));
1496 Lisp_Object
*subprefix_stack
= (Lisp_Object
*) alloca (menu_items_used
*
1497 sizeof (Lisp_Object
));
1498 int submenu_depth
= 0;
1501 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1503 *error
= "Empty menu";
1509 /* Loop over all panes and items, filling in the tree. */
1511 while (i
< menu_items_used
)
1513 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1515 submenu_stack
[submenu_depth
++] = hmenu
;
1518 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1520 hmenu
= submenu_stack
[--submenu_depth
];
1524 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1525 && submenu_depth
!= 0)
1526 i
+= MENU_ITEMS_PANE_LENGTH
;
1528 /* Ignore a nil in the item list.
1529 It's meaningful only for dialog boxes. */
1530 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1532 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1534 /* Create a new pane. */
1536 Lisp_Object pane_name
;
1539 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1540 pane_string
= (NILP (pane_name
) ? "" : (char *) XSTRING (pane_name
)->data
);
1542 if (!hmenu
|| strcmp (pane_string
, ""))
1544 HMENU new_hmenu
= CreateMenu ();
1548 *error
= "Could not create menu pane";
1554 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, pane_string
);
1559 if (!first_hmenu
) first_hmenu
= hmenu
;
1561 i
+= MENU_ITEMS_PANE_LENGTH
;
1565 /* Create a new item within current pane. */
1567 Lisp_Object item_name
, enable
, descrip
;
1570 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1571 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1572 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1574 if (((char *) XSTRING (item_name
)->data
)[0] == 0
1575 || strcmp ((char *) XSTRING (item_name
)->data
, "--") == 0)
1576 fuFlags
= MF_SEPARATOR
;
1577 else if (NILP (enable
) || !XUINT(enable
))
1578 fuFlags
= MF_STRING
| MF_GRAYED
;
1580 fuFlags
= MF_STRING
;
1585 (char *) XSTRING (item_name
)->data
);
1587 // if (!NILP (descrip))
1588 // hmenu->key = (char *) XSTRING (descrip)->data;
1590 i
+= MENU_ITEMS_ITEM_LENGTH
;
1594 return (first_hmenu
);
1597 if (first_hmenu
) DestroyMenu (first_hmenu
);
1603 /* win32menu_show actually displays a menu using the panes and items in
1604 menu_items and returns the value selected from it.
1605 There are two versions of win32menu_show, one for Xt and one for Xlib.
1606 Both assume input is blocked by the caller. */
1608 /* F is the frame the menu is for.
1609 X and Y are the frame-relative specified position,
1610 relative to the inside upper left corner of the frame F.
1611 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1612 KEYMAPS is 1 if this menu was specified with keymaps;
1613 in that case, we return a list containing the chosen item's value
1614 and perhaps also the pane's prefix.
1615 TITLE is the specified menu title.
1616 ERROR is a place to store an error message string in case of failure.
1617 (We return nil on failure, but the value doesn't actually matter.) */
1621 win32menu_show (f
, x
, y
, menu
, hmenu
, error
)
1629 int i
, menu_selection
;
1636 *error
= "Empty menu";
1643 /* Offset the coordinates to root-relative. */
1644 ClientToScreen (FRAME_WIN32_WINDOW (f
), &pos
);
1647 /* If the mouse moves out of the menu before we show the menu,
1648 don't show it at all. */
1649 if (check_mouse_other_menu_bar (f
))
1651 DestroyMenu (hmenu
);
1656 /* Display the menu. */
1657 menu_selection
= TrackPopupMenu (hmenu
,
1661 FRAME_WIN32_WINDOW (f
),
1663 if (menu_selection
== -1)
1665 *error
= "Invalid menu specification";
1669 /* Find the selected item, and its pane, to return
1670 the proper value. */
1673 if (menu_selection
> 0)
1675 return get_menu_event (menu
, menu_selection
);
1678 if (menu_selection
> 0 && menu_selection
<= lpmm
->menu_items_used
)
1680 return (XVECTOR (lpmm
->menu_items
)->contents
[menu_selection
- 1]);
1688 static char * button_names
[] =
1690 "button1", "button2", "button3", "button4", "button5",
1691 "button6", "button7", "button8", "button9", "button10"
1695 win32_dialog_show (f
, menubarp
, keymaps
, title
, error
)
1702 int i
, nb_buttons
=0;
1704 char dialog_name
[6];
1706 /* Number of elements seen so far, before boundary. */
1708 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1709 int boundary_seen
= 0;
1713 if (menu_items_n_panes
> 1)
1715 *error
= "Multiple panes in dialog box";
1719 /* Create a tree of widget_value objects
1720 representing the text label and buttons. */
1722 Lisp_Object pane_name
, prefix
;
1724 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1725 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1726 pane_string
= (NILP (pane_name
)
1727 ? "" : (char *) XSTRING (pane_name
)->data
);
1728 prev_wv
= malloc_widget_value ();
1729 prev_wv
->value
= pane_string
;
1730 if (keymaps
&& !NILP (prefix
))
1732 prev_wv
->enabled
= 1;
1733 prev_wv
->name
= "message";
1736 /* Loop over all panes and items, filling in the tree. */
1737 i
= MENU_ITEMS_PANE_LENGTH
;
1738 while (i
< menu_items_used
)
1741 /* Create a new item within current pane. */
1742 Lisp_Object item_name
, enable
, descrip
;
1743 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1744 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1746 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1748 if (NILP (item_name
))
1750 free_menubar_widget_value_tree (first_wv
);
1751 *error
= "Submenu in dialog items";
1754 if (EQ (item_name
, Qquote
))
1756 /* This is the boundary between left-side elts
1757 and right-side elts. Stop incrementing right_count. */
1762 if (nb_buttons
>= 10)
1764 free_menubar_widget_value_tree (first_wv
);
1765 *error
= "Too many dialog items";
1769 wv
= malloc_widget_value ();
1771 wv
->name
= (char *) button_names
[nb_buttons
];
1772 if (!NILP (descrip
))
1773 wv
->key
= (char *) XSTRING (descrip
)->data
;
1774 wv
->value
= (char *) XSTRING (item_name
)->data
;
1775 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1776 wv
->enabled
= !NILP (enable
);
1779 if (! boundary_seen
)
1783 i
+= MENU_ITEMS_ITEM_LENGTH
;
1786 /* If the boundary was not specified,
1787 by default put half on the left and half on the right. */
1788 if (! boundary_seen
)
1789 left_count
= nb_buttons
- nb_buttons
/ 2;
1791 wv
= malloc_widget_value ();
1792 wv
->name
= dialog_name
;
1794 /* Dialog boxes use a really stupid name encoding
1795 which specifies how many buttons to use
1796 and how many buttons are on the right.
1797 The Q means something also. */
1798 dialog_name
[0] = 'Q';
1799 dialog_name
[1] = '0' + nb_buttons
;
1800 dialog_name
[2] = 'B';
1801 dialog_name
[3] = 'R';
1802 /* Number of buttons to put on the right. */
1803 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1805 wv
->contents
= first_wv
;
1809 /* Actually create the dialog. */
1810 dialog_id
= ++popup_id_tick
;
1811 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1812 f
->output_data
.win32
->widget
, 1, 0,
1813 dialog_selection_callback
, 0);
1814 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1815 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1817 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1818 /* Free the widget_value objects we used to specify the contents. */
1819 free_menubar_widget_value_tree (first_wv
);
1821 /* No selection has been chosen yet. */
1822 menu_item_selection
= 0;
1824 /* Display the menu. */
1825 lw_pop_up_all_widgets (dialog_id
);
1827 /* Process events that apply to the menu. */
1832 XtAppNextEvent (Xt_app_con
, &event
);
1833 if (event
.type
== ButtonRelease
)
1835 XtDispatchEvent (&event
);
1838 else if (event
.type
== Expose
)
1839 process_expose_from_menu (event
);
1840 XtDispatchEvent (&event
);
1841 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1843 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1845 if (queue_tmp
!= NULL
)
1847 queue_tmp
->event
= event
;
1848 queue_tmp
->next
= queue
;
1855 /* State that no mouse buttons are now held.
1856 That is not necessarily true, but the fiction leads to reasonable
1857 results, and it is a pain to ask which are actually held now
1858 or track this in the loop above. */
1859 win32_mouse_grabbed
= 0;
1861 /* Unread any events that we got but did not handle. */
1862 while (queue
!= NULL
)
1865 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1866 queue
= queue_tmp
->next
;
1867 free ((char *)queue_tmp
);
1868 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1869 interrupt_input_pending
= 1;
1872 /* Find the selected item, and its pane, to return
1873 the proper value. */
1874 if (menu_item_selection
!= 0)
1880 while (i
< menu_items_used
)
1884 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1887 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1888 i
+= MENU_ITEMS_PANE_LENGTH
;
1893 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1894 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1898 entry
= Fcons (entry
, Qnil
);
1900 entry
= Fcons (prefix
, entry
);
1904 i
+= MENU_ITEMS_ITEM_LENGTH
;
1913 syms_of_win32menu ()
1915 defsubr (&Sx_popup_menu
);
1916 defsubr (&Sx_popup_dialog
);