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, 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"
34 /* This may include sys/types.h, and that somehow loses
35 if this is not done before the other system files. */
38 /* Load sys/types.h if not already loaded.
39 In some systems loading it twice is suicidal. */
41 #include <sys/types.h>
44 #include "dispextern.h"
46 #define min(x, y) (((x) < (y)) ? (x) : (y))
47 #define max(x, y) (((x) > (y)) ? (x) : (y))
49 typedef struct menu_map
51 Lisp_Object menu_items
;
52 int menu_items_allocated
;
56 extern Lisp_Object Qmenu_enable
;
57 extern Lisp_Object Qmenu_bar
;
59 static Lisp_Object
win32_dialog_show ();
60 static Lisp_Object
win32menu_show ();
62 static HMENU
keymap_panes ();
63 static HMENU
single_keymap_panes ();
64 static HMENU
list_of_panes ();
65 static HMENU
list_of_items ();
67 static HMENU
create_menu_items ();
69 /* Initialize the menu_items structure if we haven't already done so.
70 Also mark it as currently empty. */
73 init_menu_items (lpmm
)
76 if (NILP (lpmm
->menu_items
))
78 lpmm
->menu_items_allocated
= 60;
79 lpmm
->menu_items
= Fmake_vector (make_number (lpmm
->menu_items_allocated
),
83 lpmm
->menu_items_used
= 0;
86 /* Call when finished using the data for the current menu
90 discard_menu_items (lpmm
)
93 lpmm
->menu_items
= Qnil
;
94 lpmm
->menu_items_allocated
= lpmm
->menu_items_used
= 0;
97 /* Make the menu_items vector twice as large. */
100 grow_menu_items (lpmm
)
104 int old_size
= lpmm
->menu_items_allocated
;
106 lpmm
->menu_items_allocated
*= 2;
107 new = Fmake_vector (make_number (lpmm
->menu_items_allocated
), Qnil
);
108 bcopy (XVECTOR (lpmm
->menu_items
)->contents
, XVECTOR (new)->contents
,
109 old_size
* sizeof (Lisp_Object
));
111 lpmm
->menu_items
= new;
114 /* Indicate boundary between left and right. */
117 add_left_right_boundary (hmenu
)
120 AppendMenu (hmenu
, MF_MENUBARBREAK
, 0, NULL
);
123 /* Push one menu item into the current pane.
124 NAME is the string to display. ENABLE if non-nil means
125 this item can be selected. KEY is the key generated by
126 choosing this item. EQUIV is the textual description
127 of the keyboard equivalent for this item (or nil if none). */
130 add_menu_item (lpmm
, hmenu
, name
, enable
, key
)
140 || ((char *) XSTRING (name
)->data
)[0] == 0
141 || strcmp ((char *) XSTRING (name
)->data
, "--") == 0)
142 fuFlags
= MF_SEPARATOR
;
146 fuFlags
= MF_STRING
| MF_GRAYED
;
150 lpmm
->menu_items_used
+ 1,
151 (fuFlags
== MF_SEPARATOR
)?NULL
: (char *) XSTRING (name
)->data
);
153 lpmm
->menu_items_used
++;
155 if (lpmm
->menu_items_used
>= lpmm
->menu_items_allocated
)
156 grow_menu_items (lpmm
);
158 XSET (XVECTOR (lpmm
->menu_items
)->contents
[lpmm
->menu_items_used
++],
164 /* Figure out the current keyboard equivalent of a menu item ITEM1.
165 The item string for menu display should be ITEM_STRING.
166 Store the equivalent keyboard key sequence's
167 textual description into *DESCRIP_PTR.
168 Also cache them in the item itself.
169 Return the real definition to execute. */
172 menu_item_equiv_key (item_string
, item1
, descrip_ptr
)
173 Lisp_Object item_string
;
175 Lisp_Object
*descrip_ptr
;
177 /* This is the real definition--the function to run. */
179 /* This is the sublist that records cached equiv key data
180 so we can save time. */
181 Lisp_Object cachelist
;
182 /* These are the saved equivalent keyboard key sequence
183 and its key-description. */
184 Lisp_Object savedkey
, descrip
;
187 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
189 /* If a help string follows the item string, skip it. */
190 if (CONSP (XCONS (item1
)->cdr
)
191 && STRINGP (XCONS (XCONS (item1
)->cdr
)->car
))
192 item1
= XCONS (item1
)->cdr
;
196 /* Get out the saved equivalent-keyboard-key info. */
197 cachelist
= savedkey
= descrip
= Qnil
;
198 if (CONSP (def
) && CONSP (XCONS (def
)->car
)
199 && (NILP (XCONS (XCONS (def
)->car
)->car
)
200 || VECTORP (XCONS (XCONS (def
)->car
)->car
)))
202 cachelist
= XCONS (def
)->car
;
203 def
= XCONS (def
)->cdr
;
204 savedkey
= XCONS (cachelist
)->car
;
205 descrip
= XCONS (cachelist
)->cdr
;
208 GCPRO4 (def
, def1
, savedkey
, descrip
);
210 /* Is it still valid? */
212 if (!NILP (savedkey
))
213 def1
= Fkey_binding (savedkey
, Qnil
);
214 /* If not, update it. */
216 /* If the command is an alias for another
217 (such as easymenu.el and lmenu.el set it up),
218 check if the original command matches the cached command. */
219 && !(SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
)
220 && EQ (def1
, XSYMBOL (def
)->function
))
221 /* If something had no key binding before, don't recheck it--
222 doing that takes too much time and makes menus too slow. */
223 && !(!NILP (cachelist
) && NILP (savedkey
)))
227 savedkey
= Fwhere_is_internal (def
, Qnil
, Qt
, Qnil
);
228 /* If the command is an alias for another
229 (such as easymenu.el and lmenu.el set it up),
230 see if the original command name has equivalent keys. */
231 if (SYMBOLP (def
) && SYMBOLP (XSYMBOL (def
)->function
))
232 savedkey
= Fwhere_is_internal (XSYMBOL (def
)->function
,
235 if (VECTORP (savedkey
)
236 && EQ (XVECTOR (savedkey
)->contents
[0], Qmenu_bar
))
238 if (!NILP (savedkey
))
240 descrip
= Fkey_description (savedkey
);
241 descrip
= concat2 (make_string (" (", 3), descrip
);
242 descrip
= concat2 (descrip
, make_string (")", 1));
246 /* Cache the data we just got in a sublist of the menu binding. */
247 if (NILP (cachelist
))
248 XCONS (item1
)->cdr
= Fcons (Fcons (savedkey
, descrip
), def
);
251 XCONS (cachelist
)->car
= savedkey
;
252 XCONS (cachelist
)->cdr
= descrip
;
256 *descrip_ptr
= descrip
;
260 /* This is used as the handler when calling internal_condition_case_1. */
263 menu_item_enabled_p_1 (arg
)
269 /* Return non-nil if the command DEF is enabled when used as a menu item.
270 This is based on looking for a menu-enable property.
271 If NOTREAL is set, don't bother really computing this. */
274 menu_item_enabled_p (def
, notreal
)
277 Lisp_Object enabled
, tem
;
282 if (XTYPE (def
) == Lisp_Symbol
)
284 /* No property, or nil, means enable.
285 Otherwise, enable if value is not nil. */
286 tem
= Fget (def
, Qmenu_enable
);
288 /* (condition-case nil (eval tem)
290 enabled
= internal_condition_case_1 (Feval
, tem
, Qerror
,
291 menu_item_enabled_p_1
);
296 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
297 and generate menu panes for them in menu_items.
298 If NOTREAL is nonzero,
299 don't bother really computing whether an item is enabled. */
302 keymap_panes (lpmm
, keymaps
, nmaps
, notreal
)
304 Lisp_Object
*keymaps
;
310 // init_menu_items (lpmm);
318 hmenu
= CreateMenu ();
320 if (!hmenu
) return (NULL
);
327 /* Loop over the given keymaps, making a pane for each map.
328 But don't make a pane that is empty--ignore that map instead.
329 P is the number of panes we have made so far. */
330 for (mapno
= 0; mapno
< nmaps
; mapno
++)
334 new_hmenu
= single_keymap_panes (lpmm
, keymaps
[mapno
],
335 Qnil
, Qnil
, notreal
);
337 if (!notreal
&& new_hmenu
)
339 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, "");
347 return (single_keymap_panes (lpmm
, keymaps
[0], Qnil
, Qnil
, notreal
));
351 /* This is a recursive subroutine of keymap_panes.
352 It handles one keymap, KEYMAP.
353 The other arguments are passed along
354 or point to local variables of the previous function.
355 If NOTREAL is nonzero,
356 don't bother really computing whether an item is enabled. */
359 single_keymap_panes (lpmm
, keymap
, pane_name
, prefix
, notreal
)
362 Lisp_Object pane_name
;
366 Lisp_Object pending_maps
;
367 Lisp_Object tail
, item
, item1
, item_string
, table
;
369 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
373 hmenu
= CreateMenu ();
374 if (hmenu
== NULL
) return NULL
;
383 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
385 /* Look at each key binding, and if it has a menu string,
386 make a menu item from it. */
388 item
= XCONS (tail
)->car
;
392 item1
= XCONS (item
)->cdr
;
394 if (XTYPE (item1
) == Lisp_Cons
)
396 item_string
= XCONS (item1
)->car
;
397 if (XTYPE (item_string
) == Lisp_String
)
399 /* This is the real definition--the function to run. */
403 /* These are the saved equivalent keyboard key sequence
404 and its key-description. */
407 Lisp_Object tem
, enabled
;
409 /* GCPRO because ...enabled_p will call eval
410 and ..._equiv_key may autoload something.
411 Protecting KEYMAP preserves everything we use;
412 aside from that, must protect whatever might be
413 a string. Since there's no GCPRO5, we refetch
414 item_string instead of protecting it. */
416 descrip
= def
= Qnil
;
417 GCPRO4 (keymap
, pending_maps
, def
, prefix
);
419 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
420 enabled
= menu_item_enabled_p (def
, notreal
);
424 item_string
= XCONS (item1
)->car
;
426 tem
= Fkeymapp (def
);
427 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
429 pending_maps
= Fcons (Fcons (def
,
438 GCPRO4 (keymap
, pending_maps
, item
, item_string
);
440 submap
= get_keymap_1 (def
, 0, 1);
452 Fcons (XCONS (item
)->car
, prefix
));
456 /* Display a submenu. */
458 HMENU new_hmenu
= single_keymap_panes (lpmm
,
466 AppendMenu (hmenu
, MF_POPUP
,
468 (char *) XSTRING (item_string
)->data
);
475 else if (VECTORP (item
))
477 /* Loop over the char values represented in the vector. */
478 int len
= XVECTOR (item
)->size
;
480 for (c
= 0; c
< len
; c
++)
482 Lisp_Object character
;
483 XSETFASTINT (character
, c
);
484 item1
= XVECTOR (item
)->contents
[c
];
487 item_string
= XCONS (item1
)->car
;
488 if (STRINGP (item_string
))
492 /* These are the saved equivalent keyboard key sequence
493 and its key-description. */
495 Lisp_Object tem
, enabled
;
497 /* GCPRO because ...enabled_p will call eval
498 and ..._equiv_key may autoload something.
499 Protecting KEYMAP preserves everything we use;
500 aside from that, must protect whatever might be
501 a string. Since there's no GCPRO5, we refetch
502 item_string instead of protecting it. */
503 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
504 descrip
= def
= Qnil
;
506 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
507 enabled
= menu_item_enabled_p (def
, notreal
);
511 item_string
= XCONS (item1
)->car
;
513 tem
= Fkeymapp (def
);
514 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
515 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
521 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
523 submap
= get_keymap_1 (def
, 0, 1);
539 /* Display a submenu. */
541 HMENU new_hmenu
= single_keymap_panes (lpmm
,
549 AppendMenu (hmenu
,MF_POPUP
,
551 (char *)XSTRING (item_string
)->data
);
561 /* Process now any submenus which want to be panes at this level. */
562 while (!NILP (pending_maps
))
564 Lisp_Object elt
, eltcdr
, string
;
565 elt
= Fcar (pending_maps
);
566 eltcdr
= XCONS (elt
)->cdr
;
567 string
= XCONS (eltcdr
)->car
;
568 /* We no longer discard the @ from the beginning of the string here.
569 Instead, we do this in win32menu_show. */
571 HMENU new_hmenu
= single_keymap_panes (lpmm
,
574 XCONS (eltcdr
)->cdr
, notreal
);
578 AppendMenu (hmenu
, MF_POPUP
,
580 (char *) XSTRING (string
)->data
);
584 pending_maps
= Fcdr (pending_maps
);
590 /* Push all the panes and items of a menu described by the
591 alist-of-alists MENU.
592 This handles old-fashioned calls to x-popup-menu. */
595 list_of_panes (lpmm
, menu
)
602 hmenu
= CreateMenu ();
603 if (hmenu
== NULL
) return NULL
;
605 // init_menu_items (lpmm);
607 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
609 Lisp_Object elt
, pane_name
, pane_data
;
613 pane_name
= Fcar (elt
);
614 CHECK_STRING (pane_name
, 0);
615 pane_data
= Fcdr (elt
);
616 CHECK_CONS (pane_data
, 0);
618 new_hmenu
= list_of_items (lpmm
, pane_data
);
619 if (new_hmenu
== NULL
) goto error
;
621 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
622 (char *) XSTRING (pane_name
)->data
);
633 /* Push the items in a single pane defined by the alist PANE. */
636 list_of_items (lpmm
, pane
)
640 Lisp_Object tail
, item
, item1
;
643 hmenu
= CreateMenu ();
644 if (hmenu
== NULL
) return NULL
;
646 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
650 add_menu_item (lpmm
, hmenu
, item
, Qnil
, Qnil
);
651 else if (NILP (item
))
652 add_left_right_boundary ();
655 CHECK_CONS (item
, 0);
657 CHECK_STRING (item1
, 1);
658 add_menu_item (lpmm
, hmenu
, item1
, Qt
, Fcdr (item
));
667 create_menu_items (lpmm
, menu
, notreal
)
673 Lisp_Object keymap
, tem
;
678 /* Decode the menu items from what was specified. */
680 keymap
= Fkeymapp (menu
);
682 if (XTYPE (menu
) == Lisp_Cons
)
683 tem
= Fkeymapp (Fcar (menu
));
687 /* We were given a keymap. Extract menu info from the keymap. */
689 keymap
= get_keymap (menu
);
691 /* Extract the detailed info to make one pane. */
692 hmenu
= keymap_panes (lpmm
, &keymap
, 1, notreal
);
695 /* Search for a string appearing directly as an element of the keymap.
696 That string is the title of the menu. */
697 prompt
= map_prompt (keymap
);
699 /* Make that be the pane title of the first pane. */
700 if (!NILP (prompt
) && menu_items_n_panes
>= 0)
701 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = prompt
;
704 else if (!NILP (tem
))
706 /* We were given a list of keymaps. */
707 int nmaps
= XFASTINT (Flength (menu
));
709 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
714 /* The first keymap that has a prompt string
715 supplies the menu title. */
716 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
720 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
722 prompt
= map_prompt (keymap
);
723 if (NILP (title
) && !NILP (prompt
))
728 /* Extract the detailed info to make one pane. */
729 hmenu
= keymap_panes (lpmm
, maps
, nmaps
, notreal
);
732 /* Make the title be the pane title of the first pane. */
733 if (!NILP (title
) && menu_items_n_panes
>= 0)
734 XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
] = title
;
739 /* We were given an old-fashioned menu. */
741 CHECK_STRING (title
, 1);
743 hmenu
= list_of_panes (lpmm
, Fcdr (menu
));
749 /* This is a recursive subroutine of keymap_panes.
750 It handles one keymap, KEYMAP.
751 The other arguments are passed along
752 or point to local variables of the previous function.
753 If NOTREAL is nonzero,
754 don't bother really computing whether an item is enabled. */
757 get_single_keymap_event (keymap
, lpnum
)
761 Lisp_Object pending_maps
;
762 Lisp_Object tail
, item
, item1
, item_string
, table
;
763 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
767 for (tail
= keymap
; XTYPE (tail
) == Lisp_Cons
; tail
= XCONS (tail
)->cdr
)
769 /* Look at each key binding, and if it has a menu string,
770 make a menu item from it. */
772 item
= XCONS (tail
)->car
;
774 if (XTYPE (item
) == Lisp_Cons
)
776 item1
= XCONS (item
)->cdr
;
780 item_string
= XCONS (item1
)->car
;
781 if (XTYPE (item_string
) == Lisp_String
)
783 /* This is the real definition--the function to run. */
787 /* These are the saved equivalent keyboard key sequence
788 and its key-description. */
791 Lisp_Object tem
, enabled
;
793 /* GCPRO because ...enabled_p will call eval
794 and ..._equiv_key may autoload something.
795 Protecting KEYMAP preserves everything we use;
796 aside from that, must protect whatever might be
797 a string. Since there's no GCPRO5, we refetch
798 item_string instead of protecting it. */
800 descrip
= def
= Qnil
;
801 GCPRO3 (keymap
, pending_maps
, def
);
803 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
807 item_string
= XCONS (item1
)->car
;
809 tem
= Fkeymapp (def
);
810 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
812 pending_maps
= Fcons (Fcons (def
,
821 GCPRO4 (keymap
, pending_maps
, item
, item_string
);
823 submap
= get_keymap_1 (def
, 0, 1);
831 return (Fcons (XCONS (item
)->car
, Qnil
));
835 /* Display a submenu. */
837 Lisp_Object event
= get_single_keymap_event (submap
,
842 if (!NILP (XCONS (item
)->car
))
843 event
= Fcons (XCONS (item
)->car
, event
);
852 else if (VECTORP (item
))
854 /* Loop over the char values represented in the vector. */
855 int len
= XVECTOR (item
)->size
;
857 for (c
= 0; c
< len
; c
++)
859 Lisp_Object character
;
860 XSETFASTINT (character
, c
);
861 item1
= XVECTOR (item
)->contents
[c
];
862 if (XTYPE (item1
) == Lisp_Cons
)
864 item_string
= XCONS (item1
)->car
;
865 if (XTYPE (item_string
) == Lisp_String
)
869 /* These are the saved equivalent keyboard key sequence
870 and its key-description. */
872 Lisp_Object tem
, enabled
;
874 /* GCPRO because ...enabled_p will call eval
875 and ..._equiv_key may autoload something.
876 Protecting KEYMAP preserves everything we use;
877 aside from that, must protect whatever might be
878 a string. Since there's no GCPRO5, we refetch
879 item_string instead of protecting it. */
880 GCPRO4 (keymap
, pending_maps
, def
, descrip
);
881 descrip
= def
= Qnil
;
883 def
= menu_item_equiv_key (item_string
, item1
, &descrip
);
887 item_string
= XCONS (item1
)->car
;
889 tem
= Fkeymapp (def
);
890 if (XSTRING (item_string
)->data
[0] == '@' && !NILP (tem
))
891 pending_maps
= Fcons (Fcons (def
, Fcons (item_string
, character
)),
897 GCPRO4 (keymap
, pending_maps
, descrip
, item_string
);
899 submap
= get_keymap_1 (def
, 0, 1);
907 return (Fcons (character
, Qnil
));
911 /* Display a submenu. */
913 Lisp_Object event
= get_single_keymap_event (submap
,
918 if (!NILP (character
))
919 event
= Fcons (character
, event
);
931 /* Process now any submenus which want to be panes at this level. */
932 while (!NILP (pending_maps
))
934 Lisp_Object elt
, eltcdr
, string
;
935 elt
= Fcar (pending_maps
);
936 eltcdr
= XCONS (elt
)->cdr
;
937 string
= XCONS (eltcdr
)->car
;
938 /* We no longer discard the @ from the beginning of the string here.
939 Instead, we do this in win32menu_show. */
941 Lisp_Object event
= get_single_keymap_event (Fcar (elt
), lpnum
);
945 if (!NILP (XCONS (eltcdr
)->cdr
))
946 event
= Fcons (XCONS (eltcdr
)->cdr
, event
);
952 pending_maps
= Fcdr (pending_maps
);
958 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
959 and generate menu panes for them in menu_items.
960 If NOTREAL is nonzero,
961 don't bother really computing whether an item is enabled. */
964 get_keymap_event (keymaps
, nmaps
, lpnum
)
965 Lisp_Object
*keymaps
;
970 Lisp_Object event
= Qnil
;
972 /* Loop over the given keymaps, making a pane for each map.
973 But don't make a pane that is empty--ignore that map instead.
974 P is the number of panes we have made so far. */
975 for (mapno
= 0; mapno
< nmaps
; mapno
++)
977 event
= get_single_keymap_event (keymaps
[mapno
], lpnum
);
979 if (*lpnum
<= 0) break;
986 get_list_of_items_event (pane
, lpnum
)
990 Lisp_Object tail
, item
, item1
;
992 for (tail
= pane
; !NILP (tail
); tail
= Fcdr (tail
))
997 if (-- (*lpnum
) == 0)
1002 else if (!NILP (item
))
1004 if (--(*lpnum
) == 0)
1006 CHECK_CONS (item
, 0);
1007 return (Fcdr (item
));
1015 /* Push all the panes and items of a menu described by the
1016 alist-of-alists MENU.
1017 This handles old-fashioned calls to x-popup-menu. */
1020 get_list_of_panes_event (menu
, lpnum
)
1026 for (tail
= menu
; !NILP (tail
); tail
= Fcdr (tail
))
1028 Lisp_Object elt
, pane_name
, pane_data
;
1032 pane_data
= Fcdr (elt
);
1033 CHECK_CONS (pane_data
, 0);
1035 event
= get_list_of_items_event (pane_data
, lpnum
);
1047 get_menu_event (menu
, lpnum
)
1051 Lisp_Object keymap
, tem
;
1054 /* Decode the menu items from what was specified. */
1056 keymap
= Fkeymapp (menu
);
1058 if (XTYPE (menu
) == Lisp_Cons
)
1059 tem
= Fkeymapp (Fcar (menu
));
1063 keymap
= get_keymap (menu
);
1065 event
= get_keymap_event (menu
, 1, lpnum
);
1067 else if (!NILP (tem
))
1069 /* We were given a list of keymaps. */
1070 int nmaps
= XFASTINT (Flength (menu
));
1072 = (Lisp_Object
*) alloca (nmaps
* sizeof (Lisp_Object
));
1075 /* The first keymap that has a prompt string
1076 supplies the menu title. */
1077 for (tem
= menu
, i
= 0; XTYPE (tem
) == Lisp_Cons
; tem
= Fcdr (tem
))
1081 maps
[i
++] = keymap
= get_keymap (Fcar (tem
));
1084 event
= get_keymap_event (maps
, nmaps
, lpnum
);
1088 /* We were given an old-fashioned menu. */
1089 event
= get_list_of_panes_event (Fcdr (menu
), lpnum
);
1095 DEFUN ("x-popup-menu", Fx_popup_menu
, Sx_popup_menu
, 2, 2, 0,
1096 "Pop up a deck-of-cards menu and return user's selection.\n\
1097 POSITION is a position specification. This is either a mouse button event\n\
1098 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1099 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1100 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1101 This controls the position of the center of the first line\n\
1102 in the first pane of the menu, not the top left of the menu as a whole.\n\
1103 If POSITION is t, it means to use the current mouse position.\n\
1105 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1106 The menu items come from key bindings that have a menu string as well as\n\
1107 a definition; actually, the \"definition\" in such a key binding looks like\n\
1108 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1109 the keymap as a top-level element.\n\n\
1110 You can also use a list of keymaps as MENU.\n\
1111 Then each keymap makes a separate pane.\n\
1112 When MENU is a keymap or a list of keymaps, the return value\n\
1113 is a list of events.\n\n\
1114 Alternatively, you can specify a menu of multiple panes\n\
1115 with a list of the form (TITLE PANE1 PANE2...),\n\
1116 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1117 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1118 but a string can appear as an item--that makes a nonselectable line\n\
1120 With this form of menu, the return value is VALUE from the chosen item.\n\
1122 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1123 cached information about equivalent key sequences.")
1125 Lisp_Object position
, menu
;
1127 int number_of_panes
, panes
;
1128 Lisp_Object keymap
, tem
;
1132 Lisp_Object selection
;
1135 Lisp_Object x
, y
, window
;
1138 struct gcpro gcpro1
;
1142 if (! NILP (position
))
1144 /* Decode the first argument: find the window and the coordinates. */
1145 if (EQ (position
, Qt
))
1147 /* Use the mouse's current position. */
1148 FRAME_PTR new_f
= 0;
1149 Lisp_Object bar_window
;
1153 if (mouse_position_hook
)
1154 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1156 XSETFRAME (window
, new_f
);
1159 window
= selected_window
;
1166 tem
= Fcar (position
);
1169 window
= Fcar (Fcdr (position
));
1171 y
= Fcar (Fcdr (tem
));
1175 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1176 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1177 tem
= Fcar (Fcdr (Fcdr (tem
))); /* POSN_WINDOW_POSN (tem) */
1181 /* Determine whether this menu is handling a menu bar click. */
1182 tem
= Fcar (Fcdr (Fcar (Fcdr (position
))));
1183 if (CONSP (tem
) && EQ (Fcar (tem
), Qmenu_bar
))
1188 CHECK_NUMBER (x
, 0);
1189 CHECK_NUMBER (y
, 0);
1191 /* Decode where to put the menu. */
1193 if (FRAMEP (window
))
1195 f
= XFRAME (window
);
1200 else if (WINDOWP (window
))
1202 CHECK_LIVE_WINDOW (window
, 0);
1203 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1205 xpos
= (FONT_WIDTH (f
->output_data
.win32
->font
) * XWINDOW (window
)->left
);
1206 ypos
= (f
->output_data
.win32
->line_height
* XWINDOW (window
)->top
);
1209 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1210 but I don't want to make one now. */
1211 CHECK_WINDOW (window
, 0);
1220 discard_menu_items (&mm
);
1221 hmenu
= create_menu_items (&mm
, menu
, NILP (position
));
1223 if (NILP (position
))
1225 discard_menu_items (&mm
);
1230 /* Display them in a menu. */
1233 selection
= win32menu_show (f
, xpos
, ypos
, menu
, &hmenu
, &error_name
);
1237 discard_menu_items (&mm
);
1238 DestroyMenu (hmenu
);
1242 if (error_name
) error (error_name
);
1246 DEFUN ("x-popup-dialog", Fx_popup_dialog
, Sx_popup_dialog
, 2, 2, 0,
1247 "Pop up a dialog box and return user's selection.\n\
1248 POSITION specifies which frame to use.\n\
1249 This is normally a mouse button event or a window or frame.\n\
1250 If POSITION is t, it means to use the frame the mouse is on.\n\
1251 The dialog box appears in the middle of the specified frame.\n\
1253 CONTENTS specifies the alternatives to display in the dialog box.\n\
1254 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1255 Each ITEM is a cons cell (STRING . VALUE).\n\
1256 The return value is VALUE from the chosen item.\n\n\
1257 An ITEM may also be just a string--that makes a nonselectable item.\n\
1258 An ITEM may also be nil--that means to put all preceding items\n\
1259 on the left of the dialog box and all following items on the right.\n\
1260 \(By default, approximately half appear on each side.)")
1261 (position
, contents
)
1262 Lisp_Object position
, contents
;
1267 /* Decode the first argument: find the window or frame to use. */
1268 if (EQ (position
, Qt
))
1270 /* Decode the first argument: find the window and the coordinates. */
1271 if (EQ (position
, Qt
))
1272 window
= selected_window
;
1274 else if (CONSP (position
))
1277 tem
= Fcar (position
);
1278 if (XTYPE (tem
) == Lisp_Cons
)
1279 window
= Fcar (Fcdr (position
));
1282 tem
= Fcar (Fcdr (position
)); /* EVENT_START (position) */
1283 window
= Fcar (tem
); /* POSN_WINDOW (tem) */
1286 else if (WINDOWP (position
) || FRAMEP (position
))
1289 /* Decode where to put the menu. */
1291 if (FRAMEP (window
))
1292 f
= XFRAME (window
);
1293 else if (WINDOWP (window
))
1295 CHECK_LIVE_WINDOW (window
, 0);
1296 f
= XFRAME (WINDOW_FRAME (XWINDOW (window
)));
1299 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1300 but I don't want to make one now. */
1301 CHECK_WINDOW (window
, 0);
1304 /* Display a menu with these alternatives
1305 in the middle of frame F. */
1307 Lisp_Object x
, y
, frame
, newpos
;
1308 XSETFRAME (frame
, f
);
1309 XSETINT (x
, x_pixel_width (f
) / 2);
1310 XSETINT (y
, x_pixel_height (f
) / 2);
1311 newpos
= Fcons (Fcons (x
, Fcons (y
, Qnil
)), Fcons (frame
, Qnil
));
1313 return Fx_popup_menu (newpos
,
1314 Fcons (Fcar (contents
), Fcons (contents
, Qnil
)));
1320 Lisp_Object selection
;
1322 /* Decode the dialog items from what was specified. */
1323 title
= Fcar (contents
);
1324 CHECK_STRING (title
, 1);
1326 list_of_panes (Fcons (contents
, Qnil
));
1328 /* Display them in a dialog box. */
1330 selection
= win32_dialog_show (f
, 0, 0, title
, &error_name
);
1333 discard_menu_items ();
1335 if (error_name
) error (error_name
);
1342 get_frame_menubar_event (f
, num
)
1346 Lisp_Object tail
, items
;
1348 struct gcpro gcpro1
;
1354 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1355 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1357 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1361 event
= get_menu_event (XVECTOR (items
)->contents
[i
+ 2], &num
);
1367 return (Fcons (XVECTOR (items
)->contents
[i
], event
));
1378 set_frame_menubar (f
, first_time
)
1382 Lisp_Object tail
, items
;
1385 struct gcpro gcpro1
;
1392 if (NILP (items
= FRAME_MENU_BAR_ITEMS (f
)))
1393 items
= FRAME_MENU_BAR_ITEMS (f
) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f
));
1395 hmenu
= CreateMenu ();
1397 if (!hmenu
) goto error
;
1399 discard_menu_items (&mm
);
1401 for (i
= 0; i
< XVECTOR (items
)->size
; i
+= 3)
1408 string
= XVECTOR (items
)->contents
[i
+ 1];
1412 new_hmenu
= create_menu_items (&mm
,
1413 XVECTOR (items
)->contents
[i
+ 2],
1419 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
,
1420 (char *) XSTRING (string
)->data
);
1424 HMENU old
= GetMenu (FRAME_WIN32_WINDOW (f
));
1425 SetMenu (FRAME_WIN32_WINDOW (f
), hmenu
);
1435 free_frame_menubar (f
)
1441 HMENU old
= GetMenu (FRAME_WIN32_WINDOW (f
));
1442 SetMenu (FRAME_WIN32_WINDOW (f
), NULL
);
1448 /* Called from Fwin32_create_frame to create the initial menubar of a frame
1449 before it is mapped, so that the window is mapped with the menubar already
1450 there instead of us tacking it on later and thrashing the window after it
1453 initialize_frame_menubar (f
)
1456 set_frame_menubar (f
, 1);
1460 /* If the mouse has moved to another menu bar item,
1461 return 1 and unread a button press event for that item.
1462 Otherwise return 0. */
1465 check_mouse_other_menu_bar (f
)
1469 Lisp_Object bar_window
;
1474 (*mouse_position_hook
) (&new_f
, &bar_window
, &part
, &x
, &y
, &time
);
1476 if (f
== new_f
&& other_menu_bar_item_p (f
, x
, y
))
1478 unread_menu_bar_button (f
, x
);
1489 create_menu (keymaps
, error
)
1493 HMENU hmenu
= NULL
; /* the menu we are currently working on */
1494 HMENU first_hmenu
= NULL
;
1496 HMENU
*submenu_stack
= (HMENU
*) alloca (menu_items_used
* sizeof (HMENU
));
1497 Lisp_Object
*subprefix_stack
= (Lisp_Object
*) alloca (menu_items_used
*
1498 sizeof (Lisp_Object
));
1499 int submenu_depth
= 0;
1502 if (menu_items_used
<= MENU_ITEMS_PANE_LENGTH
)
1504 *error
= "Empty menu";
1510 /* Loop over all panes and items, filling in the tree. */
1512 while (i
< menu_items_used
)
1514 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qnil
))
1516 submenu_stack
[submenu_depth
++] = hmenu
;
1519 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qlambda
))
1521 hmenu
= submenu_stack
[--submenu_depth
];
1525 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
)
1526 && submenu_depth
!= 0)
1527 i
+= MENU_ITEMS_PANE_LENGTH
;
1529 /* Ignore a nil in the item list.
1530 It's meaningful only for dialog boxes. */
1531 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qquote
))
1533 else if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1535 /* Create a new pane. */
1537 Lisp_Object pane_name
;
1540 pane_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_NAME
];
1541 pane_string
= (NILP (pane_name
) ? "" : (char *) XSTRING (pane_name
)->data
);
1543 if (!hmenu
|| strcmp (pane_string
, ""))
1545 HMENU new_hmenu
= CreateMenu ();
1549 *error
= "Could not create menu pane";
1555 AppendMenu (hmenu
, MF_POPUP
, (UINT
)new_hmenu
, pane_string
);
1560 if (!first_hmenu
) first_hmenu
= hmenu
;
1562 i
+= MENU_ITEMS_PANE_LENGTH
;
1566 /* Create a new item within current pane. */
1568 Lisp_Object item_name
, enable
, descrip
;
1571 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1572 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1573 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1575 if (((char *) XSTRING (item_name
)->data
)[0] == 0
1576 || strcmp ((char *) XSTRING (item_name
)->data
, "--") == 0)
1577 fuFlags
= MF_SEPARATOR
;
1578 else if (NILP (enable
) || !XUINT(enable
))
1579 fuFlags
= MF_STRING
| MF_GRAYED
;
1581 fuFlags
= MF_STRING
;
1586 (char *) XSTRING (item_name
)->data
);
1588 // if (!NILP (descrip))
1589 // hmenu->key = (char *) XSTRING (descrip)->data;
1591 i
+= MENU_ITEMS_ITEM_LENGTH
;
1595 return (first_hmenu
);
1598 if (first_hmenu
) DestroyMenu (first_hmenu
);
1604 /* win32menu_show actually displays a menu using the panes and items in
1605 menu_items and returns the value selected from it.
1606 There are two versions of win32menu_show, one for Xt and one for Xlib.
1607 Both assume input is blocked by the caller. */
1609 /* F is the frame the menu is for.
1610 X and Y are the frame-relative specified position,
1611 relative to the inside upper left corner of the frame F.
1612 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1613 KEYMAPS is 1 if this menu was specified with keymaps;
1614 in that case, we return a list containing the chosen item's value
1615 and perhaps also the pane's prefix.
1616 TITLE is the specified menu title.
1617 ERROR is a place to store an error message string in case of failure.
1618 (We return nil on failure, but the value doesn't actually matter.) */
1622 win32menu_show (f
, x
, y
, menu
, hmenu
, error
)
1630 int i
, menu_selection
;
1637 *error
= "Empty menu";
1644 /* Offset the coordinates to root-relative. */
1645 ClientToScreen (FRAME_WIN32_WINDOW (f
), &pos
);
1648 /* If the mouse moves out of the menu before we show the menu,
1649 don't show it at all. */
1650 if (check_mouse_other_menu_bar (f
))
1652 DestroyMenu (hmenu
);
1657 /* Display the menu. */
1658 menu_selection
= TrackPopupMenu (hmenu
,
1662 FRAME_WIN32_WINDOW (f
),
1664 if (menu_selection
== -1)
1666 *error
= "Invalid menu specification";
1670 /* Find the selected item, and its pane, to return
1671 the proper value. */
1674 if (menu_selection
> 0)
1676 return get_menu_event (menu
, menu_selection
);
1679 if (menu_selection
> 0 && menu_selection
<= lpmm
->menu_items_used
)
1681 return (XVECTOR (lpmm
->menu_items
)->contents
[menu_selection
- 1]);
1689 static char * button_names
[] =
1691 "button1", "button2", "button3", "button4", "button5",
1692 "button6", "button7", "button8", "button9", "button10"
1696 win32_dialog_show (f
, menubarp
, keymaps
, title
, error
)
1703 int i
, nb_buttons
=0;
1705 char dialog_name
[6];
1707 /* Number of elements seen so far, before boundary. */
1709 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1710 int boundary_seen
= 0;
1714 if (menu_items_n_panes
> 1)
1716 *error
= "Multiple panes in dialog box";
1720 /* Create a tree of widget_value objects
1721 representing the text label and buttons. */
1723 Lisp_Object pane_name
, prefix
;
1725 pane_name
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_NAME
];
1726 prefix
= XVECTOR (menu_items
)->contents
[MENU_ITEMS_PANE_PREFIX
];
1727 pane_string
= (NILP (pane_name
)
1728 ? "" : (char *) XSTRING (pane_name
)->data
);
1729 prev_wv
= malloc_widget_value ();
1730 prev_wv
->value
= pane_string
;
1731 if (keymaps
&& !NILP (prefix
))
1733 prev_wv
->enabled
= 1;
1734 prev_wv
->name
= "message";
1737 /* Loop over all panes and items, filling in the tree. */
1738 i
= MENU_ITEMS_PANE_LENGTH
;
1739 while (i
< menu_items_used
)
1742 /* Create a new item within current pane. */
1743 Lisp_Object item_name
, enable
, descrip
;
1744 item_name
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_NAME
];
1745 enable
= XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_ENABLE
];
1747 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_EQUIV_KEY
];
1749 if (NILP (item_name
))
1751 free_menubar_widget_value_tree (first_wv
);
1752 *error
= "Submenu in dialog items";
1755 if (EQ (item_name
, Qquote
))
1757 /* This is the boundary between left-side elts
1758 and right-side elts. Stop incrementing right_count. */
1763 if (nb_buttons
>= 10)
1765 free_menubar_widget_value_tree (first_wv
);
1766 *error
= "Too many dialog items";
1770 wv
= malloc_widget_value ();
1772 wv
->name
= (char *) button_names
[nb_buttons
];
1773 if (!NILP (descrip
))
1774 wv
->key
= (char *) XSTRING (descrip
)->data
;
1775 wv
->value
= (char *) XSTRING (item_name
)->data
;
1776 wv
->call_data
= (void *) &XVECTOR (menu_items
)->contents
[i
];
1777 wv
->enabled
= !NILP (enable
);
1780 if (! boundary_seen
)
1784 i
+= MENU_ITEMS_ITEM_LENGTH
;
1787 /* If the boundary was not specified,
1788 by default put half on the left and half on the right. */
1789 if (! boundary_seen
)
1790 left_count
= nb_buttons
- nb_buttons
/ 2;
1792 wv
= malloc_widget_value ();
1793 wv
->name
= dialog_name
;
1795 /* Dialog boxes use a really stupid name encoding
1796 which specifies how many buttons to use
1797 and how many buttons are on the right.
1798 The Q means something also. */
1799 dialog_name
[0] = 'Q';
1800 dialog_name
[1] = '0' + nb_buttons
;
1801 dialog_name
[2] = 'B';
1802 dialog_name
[3] = 'R';
1803 /* Number of buttons to put on the right. */
1804 dialog_name
[4] = '0' + nb_buttons
- left_count
;
1806 wv
->contents
= first_wv
;
1810 /* Actually create the dialog. */
1811 dialog_id
= ++popup_id_tick
;
1812 menu
= lw_create_widget (first_wv
->name
, "dialog", dialog_id
, first_wv
,
1813 f
->output_data
.win32
->widget
, 1, 0,
1814 dialog_selection_callback
, 0);
1815 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1816 lw_modify_all_widgets (dialog_id
, first_wv
, True
);
1818 lw_modify_all_widgets (dialog_id
, first_wv
->contents
, True
);
1819 /* Free the widget_value objects we used to specify the contents. */
1820 free_menubar_widget_value_tree (first_wv
);
1822 /* No selection has been chosen yet. */
1823 menu_item_selection
= 0;
1825 /* Display the menu. */
1826 lw_pop_up_all_widgets (dialog_id
);
1828 /* Process events that apply to the menu. */
1833 XtAppNextEvent (Xt_app_con
, &event
);
1834 if (event
.type
== ButtonRelease
)
1836 XtDispatchEvent (&event
);
1839 else if (event
.type
== Expose
)
1840 process_expose_from_menu (event
);
1841 XtDispatchEvent (&event
);
1842 if (XtWindowToWidget(XDISPLAY event
.xany
.window
) != menu
)
1844 queue_tmp
= (struct event_queue
*) malloc (sizeof (struct event_queue
));
1846 if (queue_tmp
!= NULL
)
1848 queue_tmp
->event
= event
;
1849 queue_tmp
->next
= queue
;
1856 /* State that no mouse buttons are now held.
1857 That is not necessarily true, but the fiction leads to reasonable
1858 results, and it is a pain to ask which are actually held now
1859 or track this in the loop above. */
1860 win32_mouse_grabbed
= 0;
1862 /* Unread any events that we got but did not handle. */
1863 while (queue
!= NULL
)
1866 XPutBackEvent (XDISPLAY
&queue_tmp
->event
);
1867 queue
= queue_tmp
->next
;
1868 free ((char *)queue_tmp
);
1869 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1870 interrupt_input_pending
= 1;
1873 /* Find the selected item, and its pane, to return
1874 the proper value. */
1875 if (menu_item_selection
!= 0)
1881 while (i
< menu_items_used
)
1885 if (EQ (XVECTOR (menu_items
)->contents
[i
], Qt
))
1888 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_PANE_PREFIX
];
1889 i
+= MENU_ITEMS_PANE_LENGTH
;
1894 = XVECTOR (menu_items
)->contents
[i
+ MENU_ITEMS_ITEM_VALUE
];
1895 if (menu_item_selection
== &XVECTOR (menu_items
)->contents
[i
])
1899 entry
= Fcons (entry
, Qnil
);
1901 entry
= Fcons (prefix
, entry
);
1905 i
+= MENU_ITEMS_ITEM_LENGTH
;
1914 syms_of_win32menu ()
1916 defsubr (&Sx_popup_menu
);
1917 defsubr (&Sx_popup_dialog
);