(make_lispy_event): Distinguish S-SPC from SPC.
[emacs.git] / src / w32menu.c
blobf77ce136fe2434a4e8be6e11487eb7120db53732
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)
9 any later version.
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. */
23 #include <signal.h>
24 #include <config.h>
26 #include <stdio.h>
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "keyboard.h"
32 #include "blockinput.h"
33 #include "buffer.h"
35 /* This may include sys/types.h, and that somehow loses
36 if this is not done before the other system files. */
37 #include "w32term.h"
39 /* Load sys/types.h if not already loaded.
40 In some systems loading it twice is suicidal. */
41 #ifndef makedev
42 #include <sys/types.h>
43 #endif
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;
54 int menu_items_used;
55 } menu_map;
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 static Lisp_Object w32_dialog_show ();
70 static Lisp_Object w32menu_show ();
72 static HMENU keymap_panes ();
73 static HMENU single_keymap_panes ();
74 static HMENU list_of_panes ();
75 static HMENU list_of_items ();
77 static HMENU create_menu_items ();
79 /* Initialize the menu_items structure if we haven't already done so.
80 Also mark it as currently empty. */
82 static void
83 init_menu_items (lpmm)
84 menu_map * lpmm;
86 if (NILP (lpmm->menu_items))
88 lpmm->menu_items_allocated = 60;
89 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
90 Qnil);
93 lpmm->menu_items_used = 0;
96 /* Call when finished using the data for the current menu
97 in menu_items. */
99 static void
100 discard_menu_items (lpmm)
101 menu_map * lpmm;
103 lpmm->menu_items = Qnil;
104 lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
107 /* Make the menu_items vector twice as large. */
109 static void
110 grow_menu_items (lpmm)
111 menu_map * lpmm;
113 Lisp_Object new;
114 int old_size = lpmm->menu_items_allocated;
116 lpmm->menu_items_allocated *= 2;
117 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
118 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
119 old_size * sizeof (Lisp_Object));
121 lpmm->menu_items = new;
124 /* Indicate boundary between left and right. */
126 static void
127 add_left_right_boundary (hmenu)
128 HMENU hmenu;
130 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
133 /* Push one menu item into the current pane.
134 NAME is the string to display. ENABLE if non-nil means
135 this item can be selected. KEY is the key generated by
136 choosing this item. EQUIV is the textual description
137 of the keyboard equivalent for this item (or nil if none). */
139 static void
140 add_menu_item (lpmm, hmenu, name, enable, key)
141 menu_map * lpmm;
142 HMENU hmenu;
143 Lisp_Object name;
144 UINT enable;
145 Lisp_Object key;
147 UINT fuFlags;
149 if (NILP (name)
150 || ((char *) XSTRING (name)->data)[0] == 0
151 || strcmp ((char *) XSTRING (name)->data, "--") == 0)
152 fuFlags = MF_SEPARATOR;
153 else if (enable)
154 fuFlags = MF_STRING;
155 else
156 fuFlags = MF_STRING | MF_GRAYED;
158 AppendMenu (hmenu,
159 fuFlags,
160 lpmm->menu_items_used + 1,
161 (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data);
163 lpmm->menu_items_used++;
164 #if 0
165 if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
166 grow_menu_items (lpmm);
168 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
169 Lisp_Cons,
170 key);
171 #endif
174 /* Figure out the current keyboard equivalent of a menu item ITEM1.
175 The item string for menu display should be ITEM_STRING.
176 Store the equivalent keyboard key sequence's
177 textual description into *DESCRIP_PTR.
178 Also cache them in the item itself.
179 Return the real definition to execute. */
181 static Lisp_Object
182 menu_item_equiv_key (item_string, item1, descrip_ptr)
183 Lisp_Object item_string;
184 Lisp_Object item1;
185 Lisp_Object *descrip_ptr;
187 /* This is the real definition--the function to run. */
188 Lisp_Object def;
189 /* This is the sublist that records cached equiv key data
190 so we can save time. */
191 Lisp_Object cachelist;
192 /* These are the saved equivalent keyboard key sequence
193 and its key-description. */
194 Lisp_Object savedkey, descrip;
195 Lisp_Object def1;
196 int changed = 0;
197 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
199 /* If a help string follows the item string, skip it. */
200 if (CONSP (XCONS (item1)->cdr)
201 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
202 item1 = XCONS (item1)->cdr;
204 def = Fcdr (item1);
206 /* Get out the saved equivalent-keyboard-key info. */
207 cachelist = savedkey = descrip = Qnil;
208 if (CONSP (def) && CONSP (XCONS (def)->car)
209 && (NILP (XCONS (XCONS (def)->car)->car)
210 || VECTORP (XCONS (XCONS (def)->car)->car)))
212 cachelist = XCONS (def)->car;
213 def = XCONS (def)->cdr;
214 savedkey = XCONS (cachelist)->car;
215 descrip = XCONS (cachelist)->cdr;
218 GCPRO4 (def, def1, savedkey, descrip);
220 /* Is it still valid? */
221 def1 = Qnil;
222 if (!NILP (savedkey))
223 def1 = Fkey_binding (savedkey, Qnil);
224 /* If not, update it. */
225 if (! EQ (def1, def)
226 /* If the command is an alias for another
227 (such as easymenu.el and lmenu.el set it up),
228 check if the original command matches the cached command. */
229 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
230 && EQ (def1, XSYMBOL (def)->function))
231 /* If something had no key binding before, don't recheck it--
232 doing that takes too much time and makes menus too slow. */
233 && !(!NILP (cachelist) && NILP (savedkey)))
235 changed = 1;
236 descrip = Qnil;
237 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
238 /* If the command is an alias for another
239 (such as easymenu.el and lmenu.el set it up),
240 see if the original command name has equivalent keys. */
241 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
242 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
243 Qnil, Qt, Qnil);
245 if (VECTORP (savedkey)
246 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
247 savedkey = Qnil;
248 if (!NILP (savedkey))
250 descrip = Fkey_description (savedkey);
251 descrip = concat2 (make_string (" (", 3), descrip);
252 descrip = concat2 (descrip, make_string (")", 1));
256 /* Cache the data we just got in a sublist of the menu binding. */
257 if (NILP (cachelist))
258 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
259 else if (changed)
261 XCONS (cachelist)->car = savedkey;
262 XCONS (cachelist)->cdr = descrip;
265 UNGCPRO;
266 *descrip_ptr = descrip;
267 return def;
270 /* This is used as the handler when calling internal_condition_case_1. */
272 static Lisp_Object
273 menu_item_enabled_p_1 (arg)
274 Lisp_Object arg;
276 return Qnil;
279 /* Return non-nil if the command DEF is enabled when used as a menu item.
280 This is based on looking for a menu-enable property.
281 If NOTREAL is set, don't bother really computing this. */
283 static Lisp_Object
284 menu_item_enabled_p (def, notreal)
285 Lisp_Object def;
287 Lisp_Object enabled, tem;
289 enabled = Qt;
290 if (notreal)
291 return enabled;
292 if (XTYPE (def) == Lisp_Symbol)
294 /* No property, or nil, means enable.
295 Otherwise, enable if value is not nil. */
296 tem = Fget (def, Qmenu_enable);
297 if (!NILP (tem))
298 /* (condition-case nil (eval tem)
299 (error nil)) */
300 enabled = internal_condition_case_1 (Feval, tem, Qerror,
301 menu_item_enabled_p_1);
303 return enabled;
306 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
307 and generate menu panes for them in menu_items.
308 If NOTREAL is nonzero,
309 don't bother really computing whether an item is enabled. */
311 static HMENU
312 keymap_panes (lpmm, keymaps, nmaps, notreal)
313 menu_map * lpmm;
314 Lisp_Object *keymaps;
315 int nmaps;
316 int notreal;
318 int mapno;
320 // init_menu_items (lpmm);
322 if (nmaps > 1)
324 HMENU hmenu;
326 if (!notreal)
328 hmenu = CreateMenu ();
330 if (!hmenu) return (NULL);
332 else
334 hmenu = NULL;
337 /* Loop over the given keymaps, making a pane for each map.
338 But don't make a pane that is empty--ignore that map instead.
339 P is the number of panes we have made so far. */
340 for (mapno = 0; mapno < nmaps; mapno++)
342 HMENU new_hmenu;
344 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
345 Qnil, Qnil, notreal);
347 if (!notreal && new_hmenu)
349 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
353 return (hmenu);
355 else
357 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
361 /* This is a recursive subroutine of keymap_panes.
362 It handles one keymap, KEYMAP.
363 The other arguments are passed along
364 or point to local variables of the previous function.
365 If NOTREAL is nonzero,
366 don't bother really computing whether an item is enabled. */
368 HMENU
369 single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
370 menu_map * lpmm;
371 Lisp_Object keymap;
372 Lisp_Object pane_name;
373 Lisp_Object prefix;
374 int notreal;
376 Lisp_Object pending_maps;
377 Lisp_Object tail, item, item1, item_string, table;
378 HMENU hmenu;
379 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
381 if (!notreal)
383 hmenu = CreateMenu ();
384 if (hmenu == NULL) return NULL;
386 else
388 hmenu = NULL;
391 pending_maps = Qnil;
393 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
395 /* Look at each key binding, and if it has a menu string,
396 make a menu item from it. */
398 item = XCONS (tail)->car;
400 if (CONSP (item))
402 item1 = XCONS (item)->cdr;
404 if (XTYPE (item1) == Lisp_Cons)
406 item_string = XCONS (item1)->car;
407 if (XTYPE (item_string) == Lisp_String)
409 /* This is the real definition--the function to run. */
411 Lisp_Object def;
413 /* These are the saved equivalent keyboard key sequence
414 and its key-description. */
416 Lisp_Object descrip;
417 Lisp_Object tem, enabled;
419 /* GCPRO because ...enabled_p will call eval
420 and ..._equiv_key may autoload something.
421 Protecting KEYMAP preserves everything we use;
422 aside from that, must protect whatever might be
423 a string. Since there's no GCPRO5, we refetch
424 item_string instead of protecting it. */
426 descrip = def = Qnil;
427 GCPRO4 (keymap, pending_maps, def, prefix);
429 def = menu_item_equiv_key (item_string, item1, &descrip);
430 enabled = menu_item_enabled_p (def, notreal);
432 UNGCPRO;
434 item_string = XCONS (item1)->car;
436 tem = Fkeymapp (def);
437 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
439 pending_maps = Fcons (Fcons (def,
440 Fcons (item_string,
441 XCONS (item)->car)),
442 pending_maps);
444 else
446 Lisp_Object submap;
448 GCPRO4 (keymap, pending_maps, item, item_string);
450 submap = get_keymap_1 (def, 0, 1);
452 UNGCPRO;
454 if (NILP (submap))
456 if (!notreal)
458 add_menu_item (lpmm,
459 hmenu,
460 item_string,
461 !NILP (enabled),
462 Fcons (XCONS (item)->car, prefix));
465 else
466 /* Display a submenu. */
468 HMENU new_hmenu = single_keymap_panes (lpmm,
469 submap,
470 item_string,
471 XCONS (item)->car,
472 notreal);
474 if (!notreal)
476 AppendMenu (hmenu, MF_POPUP,
477 (UINT)new_hmenu,
478 (char *) XSTRING (item_string)->data);
485 else if (VECTORP (item))
487 /* Loop over the char values represented in the vector. */
488 int len = XVECTOR (item)->size;
489 int c;
490 for (c = 0; c < len; c++)
492 Lisp_Object character;
493 XSETFASTINT (character, c);
494 item1 = XVECTOR (item)->contents[c];
495 if (CONSP (item1))
497 item_string = XCONS (item1)->car;
498 if (STRINGP (item_string))
500 Lisp_Object def;
502 /* These are the saved equivalent keyboard key sequence
503 and its key-description. */
504 Lisp_Object descrip;
505 Lisp_Object tem, enabled;
507 /* GCPRO because ...enabled_p will call eval
508 and ..._equiv_key may autoload something.
509 Protecting KEYMAP preserves everything we use;
510 aside from that, must protect whatever might be
511 a string. Since there's no GCPRO5, we refetch
512 item_string instead of protecting it. */
513 GCPRO4 (keymap, pending_maps, def, descrip);
514 descrip = def = Qnil;
516 def = menu_item_equiv_key (item_string, item1, &descrip);
517 enabled = menu_item_enabled_p (def, notreal);
519 UNGCPRO;
521 item_string = XCONS (item1)->car;
523 tem = Fkeymapp (def);
524 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
525 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
526 pending_maps);
527 else
529 Lisp_Object submap;
531 GCPRO4 (keymap, pending_maps, descrip, item_string);
533 submap = get_keymap_1 (def, 0, 1);
535 UNGCPRO;
537 if (NILP (submap))
539 if (!notreal)
541 add_menu_item (lpmm,
542 hmenu,
543 item_string,
544 !NILP (enabled),
545 character);
548 else
549 /* Display a submenu. */
551 HMENU new_hmenu = single_keymap_panes (lpmm,
552 submap,
553 Qnil,
554 character,
555 notreal);
557 if (!notreal)
559 AppendMenu (hmenu,MF_POPUP,
560 (UINT)new_hmenu,
561 (char *)XSTRING (item_string)->data);
571 /* Process now any submenus which want to be panes at this level. */
572 while (!NILP (pending_maps))
574 Lisp_Object elt, eltcdr, string;
575 elt = Fcar (pending_maps);
576 eltcdr = XCONS (elt)->cdr;
577 string = XCONS (eltcdr)->car;
578 /* We no longer discard the @ from the beginning of the string here.
579 Instead, we do this in w32menu_show. */
581 HMENU new_hmenu = single_keymap_panes (lpmm,
582 Fcar (elt),
583 string,
584 XCONS (eltcdr)->cdr, notreal);
586 if (!notreal)
588 AppendMenu (hmenu, MF_POPUP,
589 (UINT)new_hmenu,
590 (char *) XSTRING (string)->data);
594 pending_maps = Fcdr (pending_maps);
597 return (hmenu);
600 /* Push all the panes and items of a menu described by the
601 alist-of-alists MENU.
602 This handles old-fashioned calls to x-popup-menu. */
604 static HMENU
605 list_of_panes (lpmm, menu)
606 menu_map * lpmm;
607 Lisp_Object menu;
609 Lisp_Object tail;
610 HMENU hmenu;
612 hmenu = CreateMenu ();
613 if (hmenu == NULL) return NULL;
615 // init_menu_items (lpmm);
617 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
619 Lisp_Object elt, pane_name, pane_data;
620 HMENU new_hmenu;
622 elt = Fcar (tail);
623 pane_name = Fcar (elt);
624 CHECK_STRING (pane_name, 0);
625 pane_data = Fcdr (elt);
626 CHECK_CONS (pane_data, 0);
628 new_hmenu = list_of_items (lpmm, pane_data);
629 if (new_hmenu == NULL) goto error;
631 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
632 (char *) XSTRING (pane_name)->data);
635 return (hmenu);
637 error:
638 DestroyMenu (hmenu);
640 return (NULL);
643 /* Push the items in a single pane defined by the alist PANE. */
645 static HMENU
646 list_of_items (lpmm, pane)
647 menu_map * lpmm;
648 Lisp_Object pane;
650 Lisp_Object tail, item, item1;
651 HMENU hmenu;
653 hmenu = CreateMenu ();
654 if (hmenu == NULL) return NULL;
656 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
658 item = Fcar (tail);
659 if (STRINGP (item))
660 add_menu_item (lpmm, hmenu, item, Qnil, Qnil);
661 else if (NILP (item))
662 add_left_right_boundary ();
663 else
665 CHECK_CONS (item, 0);
666 item1 = Fcar (item);
667 CHECK_STRING (item1, 1);
668 add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item));
672 return (hmenu);
676 HMENU
677 create_menu_items (lpmm, menu, notreal)
678 menu_map * lpmm;
679 Lisp_Object menu;
680 int notreal;
682 Lisp_Object title;
683 Lisp_Object keymap, tem;
684 HMENU hmenu;
686 title = Qnil;
688 /* Decode the menu items from what was specified. */
690 keymap = Fkeymapp (menu);
691 tem = Qnil;
692 if (XTYPE (menu) == Lisp_Cons)
693 tem = Fkeymapp (Fcar (menu));
695 if (!NILP (keymap))
697 /* We were given a keymap. Extract menu info from the keymap. */
698 Lisp_Object prompt;
699 keymap = get_keymap (menu);
701 /* Extract the detailed info to make one pane. */
702 hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
704 #if 0
705 /* Search for a string appearing directly as an element of the keymap.
706 That string is the title of the menu. */
707 prompt = map_prompt (keymap);
709 /* Make that be the pane title of the first pane. */
710 if (!NILP (prompt) && menu_items_n_panes >= 0)
711 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
712 #endif
714 else if (!NILP (tem))
716 /* We were given a list of keymaps. */
717 int nmaps = XFASTINT (Flength (menu));
718 Lisp_Object *maps
719 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
720 int i;
722 title = Qnil;
724 /* The first keymap that has a prompt string
725 supplies the menu title. */
726 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
728 Lisp_Object prompt;
730 maps[i++] = keymap = get_keymap (Fcar (tem));
731 #if 0
732 prompt = map_prompt (keymap);
733 if (NILP (title) && !NILP (prompt))
734 title = prompt;
735 #endif
738 /* Extract the detailed info to make one pane. */
739 hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
741 #if 0
742 /* Make the title be the pane title of the first pane. */
743 if (!NILP (title) && menu_items_n_panes >= 0)
744 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
745 #endif
747 else
749 /* We were given an old-fashioned menu. */
750 title = Fcar (menu);
751 CHECK_STRING (title, 1);
753 hmenu = list_of_panes (lpmm, Fcdr (menu));
756 return (hmenu);
759 /* This is a recursive subroutine of keymap_panes.
760 It handles one keymap, KEYMAP.
761 The other arguments are passed along
762 or point to local variables of the previous function.
763 If NOTREAL is nonzero,
764 don't bother really computing whether an item is enabled. */
766 Lisp_Object
767 get_single_keymap_event (keymap, lpnum)
768 Lisp_Object keymap;
769 int * lpnum;
771 Lisp_Object pending_maps;
772 Lisp_Object tail, item, item1, item_string, table;
773 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
775 pending_maps = Qnil;
777 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
779 /* Look at each key binding, and if it has a menu string,
780 make a menu item from it. */
782 item = XCONS (tail)->car;
784 if (XTYPE (item) == Lisp_Cons)
786 item1 = XCONS (item)->cdr;
788 if (CONSP (item1))
790 item_string = XCONS (item1)->car;
791 if (XTYPE (item_string) == Lisp_String)
793 /* This is the real definition--the function to run. */
795 Lisp_Object def;
797 /* These are the saved equivalent keyboard key sequence
798 and its key-description. */
800 Lisp_Object descrip;
801 Lisp_Object tem, enabled;
803 /* GCPRO because ...enabled_p will call eval
804 and ..._equiv_key may autoload something.
805 Protecting KEYMAP preserves everything we use;
806 aside from that, must protect whatever might be
807 a string. Since there's no GCPRO5, we refetch
808 item_string instead of protecting it. */
810 descrip = def = Qnil;
811 GCPRO3 (keymap, pending_maps, def);
813 def = menu_item_equiv_key (item_string, item1, &descrip);
815 UNGCPRO;
817 item_string = XCONS (item1)->car;
819 tem = Fkeymapp (def);
820 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
822 pending_maps = Fcons (Fcons (def,
823 Fcons (item_string,
824 XCONS (item)->car)),
825 pending_maps);
827 else
829 Lisp_Object submap;
831 GCPRO4 (keymap, pending_maps, item, item_string);
833 submap = get_keymap_1 (def, 0, 1);
835 UNGCPRO;
837 if (NILP (submap))
839 if (--(*lpnum) == 0)
841 return (Fcons (XCONS (item)->car, Qnil));
844 else
845 /* Display a submenu. */
847 Lisp_Object event = get_single_keymap_event (submap,
848 lpnum);
850 if (*lpnum <= 0)
852 if (!NILP (XCONS (item)->car))
853 event = Fcons (XCONS (item)->car, event);
855 return (event);
862 else if (VECTORP (item))
864 /* Loop over the char values represented in the vector. */
865 int len = XVECTOR (item)->size;
866 int c;
867 for (c = 0; c < len; c++)
869 Lisp_Object character;
870 XSETFASTINT (character, c);
871 item1 = XVECTOR (item)->contents[c];
872 if (XTYPE (item1) == Lisp_Cons)
874 item_string = XCONS (item1)->car;
875 if (XTYPE (item_string) == Lisp_String)
877 Lisp_Object def;
879 /* These are the saved equivalent keyboard key sequence
880 and its key-description. */
881 Lisp_Object descrip;
882 Lisp_Object tem, enabled;
884 /* GCPRO because ...enabled_p will call eval
885 and ..._equiv_key may autoload something.
886 Protecting KEYMAP preserves everything we use;
887 aside from that, must protect whatever might be
888 a string. Since there's no GCPRO5, we refetch
889 item_string instead of protecting it. */
890 GCPRO4 (keymap, pending_maps, def, descrip);
891 descrip = def = Qnil;
893 def = menu_item_equiv_key (item_string, item1, &descrip);
895 UNGCPRO;
897 item_string = XCONS (item1)->car;
899 tem = Fkeymapp (def);
900 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
901 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
902 pending_maps);
903 else
905 Lisp_Object submap;
907 GCPRO4 (keymap, pending_maps, descrip, item_string);
909 submap = get_keymap_1 (def, 0, 1);
911 UNGCPRO;
913 if (NILP (submap))
915 if (--(*lpnum) == 0)
917 return (Fcons (character, Qnil));
920 else
921 /* Display a submenu. */
923 Lisp_Object event = get_single_keymap_event (submap,
924 lpnum);
926 if (*lpnum <= 0)
928 if (!NILP (character))
929 event = Fcons (character, event);
931 return (event);
941 /* Process now any submenus which want to be panes at this level. */
942 while (!NILP (pending_maps))
944 Lisp_Object elt, eltcdr, string;
945 elt = Fcar (pending_maps);
946 eltcdr = XCONS (elt)->cdr;
947 string = XCONS (eltcdr)->car;
948 /* We no longer discard the @ from the beginning of the string here.
949 Instead, we do this in w32menu_show. */
951 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
953 if (*lpnum <= 0)
955 if (!NILP (XCONS (eltcdr)->cdr))
956 event = Fcons (XCONS (eltcdr)->cdr, event);
958 return (event);
962 pending_maps = Fcdr (pending_maps);
965 return (Qnil);
968 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
969 and generate menu panes for them in menu_items.
970 If NOTREAL is nonzero,
971 don't bother really computing whether an item is enabled. */
973 static Lisp_Object
974 get_keymap_event (keymaps, nmaps, lpnum)
975 Lisp_Object *keymaps;
976 int nmaps;
977 int * lpnum;
979 int mapno;
980 Lisp_Object event = Qnil;
982 /* Loop over the given keymaps, making a pane for each map.
983 But don't make a pane that is empty--ignore that map instead.
984 P is the number of panes we have made so far. */
985 for (mapno = 0; mapno < nmaps; mapno++)
987 event = get_single_keymap_event (keymaps[mapno], lpnum);
989 if (*lpnum <= 0) break;
992 return (event);
995 static Lisp_Object
996 get_list_of_items_event (pane, lpnum)
997 Lisp_Object pane;
998 int * lpnum;
1000 Lisp_Object tail, item, item1;
1002 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
1004 item = Fcar (tail);
1005 if (STRINGP (item))
1007 if (-- (*lpnum) == 0)
1009 return (Qnil);
1012 else if (!NILP (item))
1014 if (--(*lpnum) == 0)
1016 CHECK_CONS (item, 0);
1017 return (Fcdr (item));
1022 return (Qnil);
1025 /* Push all the panes and items of a menu described by the
1026 alist-of-alists MENU.
1027 This handles old-fashioned calls to x-popup-menu. */
1029 static Lisp_Object
1030 get_list_of_panes_event (menu, lpnum)
1031 Lisp_Object menu;
1032 int * lpnum;
1034 Lisp_Object tail;
1036 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1038 Lisp_Object elt, pane_name, pane_data;
1039 Lisp_Object event;
1041 elt = Fcar (tail);
1042 pane_data = Fcdr (elt);
1043 CHECK_CONS (pane_data, 0);
1045 event = get_list_of_items_event (pane_data, lpnum);
1047 if (*lpnum <= 0)
1049 return (event);
1053 return (Qnil);
1056 Lisp_Object
1057 get_menu_event (menu, lpnum)
1058 Lisp_Object menu;
1059 int * lpnum;
1061 Lisp_Object keymap, tem;
1062 Lisp_Object event;
1064 /* Decode the menu items from what was specified. */
1066 keymap = Fkeymapp (menu);
1067 tem = Qnil;
1068 if (XTYPE (menu) == Lisp_Cons)
1069 tem = Fkeymapp (Fcar (menu));
1071 if (!NILP (keymap))
1073 keymap = get_keymap (menu);
1075 event = get_keymap_event (menu, 1, lpnum);
1077 else if (!NILP (tem))
1079 /* We were given a list of keymaps. */
1080 int nmaps = XFASTINT (Flength (menu));
1081 Lisp_Object *maps
1082 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1083 int i;
1085 /* The first keymap that has a prompt string
1086 supplies the menu title. */
1087 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1089 Lisp_Object prompt;
1091 maps[i++] = keymap = get_keymap (Fcar (tem));
1094 event = get_keymap_event (maps, nmaps, lpnum);
1096 else
1098 /* We were given an old-fashioned menu. */
1099 event = get_list_of_panes_event (Fcdr (menu), lpnum);
1102 return (event);
1105 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1106 "Pop up a deck-of-cards menu and return user's selection.\n\
1107 POSITION is a position specification. This is either a mouse button event\n\
1108 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1109 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1110 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1111 This controls the position of the center of the first line\n\
1112 in the first pane of the menu, not the top left of the menu as a whole.\n\
1113 If POSITION is t, it means to use the current mouse position.\n\
1115 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1116 The menu items come from key bindings that have a menu string as well as\n\
1117 a definition; actually, the \"definition\" in such a key binding looks like\n\
1118 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1119 the keymap as a top-level element.\n\n\
1120 You can also use a list of keymaps as MENU.\n\
1121 Then each keymap makes a separate pane.\n\
1122 When MENU is a keymap or a list of keymaps, the return value\n\
1123 is a list of events.\n\n\
1124 Alternatively, you can specify a menu of multiple panes\n\
1125 with a list of the form (TITLE PANE1 PANE2...),\n\
1126 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1127 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1128 but a string can appear as an item--that makes a nonselectable line\n\
1129 in the menu.\n\
1130 With this form of menu, the return value is VALUE from the chosen item.\n\
1132 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1133 cached information about equivalent key sequences.")
1134 (position, menu)
1135 Lisp_Object position, menu;
1137 int number_of_panes, panes;
1138 Lisp_Object keymap, tem;
1139 int xpos, ypos;
1140 Lisp_Object title;
1141 char *error_name;
1142 Lisp_Object selection;
1143 int i, j;
1144 FRAME_PTR f;
1145 Lisp_Object x, y, window;
1146 int keymaps = 0;
1147 int menubarp = 0;
1148 struct gcpro gcpro1;
1149 HMENU hmenu;
1150 menu_map mm;
1152 if (! NILP (position))
1154 /* Decode the first argument: find the window and the coordinates. */
1155 if (EQ (position, Qt)
1156 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
1158 /* Use the mouse's current position. */
1159 FRAME_PTR new_f = selected_frame;
1160 Lisp_Object bar_window;
1161 int part;
1162 unsigned long time;
1164 if (mouse_position_hook)
1165 (*mouse_position_hook) (&new_f, 1, &bar_window,
1166 &part, &x, &y, &time);
1167 if (new_f != 0)
1168 XSETFRAME (window, new_f);
1169 else
1171 window = selected_window;
1172 XSETFASTINT (x, 0);
1173 XSETFASTINT (y, 0);
1176 else
1178 tem = Fcar (position);
1179 if (CONSP (tem))
1181 window = Fcar (Fcdr (position));
1182 x = Fcar (tem);
1183 y = Fcar (Fcdr (tem));
1185 else
1187 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1188 window = Fcar (tem); /* POSN_WINDOW (tem) */
1189 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1190 x = Fcar (tem);
1191 y = Fcdr (tem);
1193 /* Determine whether this menu is handling a menu bar click. */
1194 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1195 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1196 menubarp = 1;
1200 CHECK_NUMBER (x, 0);
1201 CHECK_NUMBER (y, 0);
1203 /* Decode where to put the menu. */
1205 if (FRAMEP (window))
1207 f = XFRAME (window);
1209 xpos = 0;
1210 ypos = 0;
1212 else if (WINDOWP (window))
1214 CHECK_LIVE_WINDOW (window, 0);
1215 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1217 xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left);
1218 ypos = (f->output_data.w32->line_height * XWINDOW (window)->top);
1220 else
1221 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1222 but I don't want to make one now. */
1223 CHECK_WINDOW (window, 0);
1225 xpos += XINT (x);
1226 ypos += XINT (y);
1229 title = Qnil;
1230 GCPRO1 (title);
1232 discard_menu_items (&mm);
1233 hmenu = create_menu_items (&mm, menu, NILP (position));
1235 if (NILP (position))
1237 discard_menu_items (&mm);
1238 UNGCPRO;
1239 return Qnil;
1242 /* Display them in a menu. */
1243 BLOCK_INPUT;
1245 selection = w32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
1247 UNBLOCK_INPUT;
1249 discard_menu_items (&mm);
1250 DestroyMenu (hmenu);
1252 UNGCPRO;
1254 if (error_name) error (error_name);
1255 return selection;
1258 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1259 "Pop up a dialog box and return user's selection.\n\
1260 POSITION specifies which frame to use.\n\
1261 This is normally a mouse button event or a window or frame.\n\
1262 If POSITION is t, it means to use the frame the mouse is on.\n\
1263 The dialog box appears in the middle of the specified frame.\n\
1265 CONTENTS specifies the alternatives to display in the dialog box.\n\
1266 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1267 Each ITEM is a cons cell (STRING . VALUE).\n\
1268 The return value is VALUE from the chosen item.\n\n\
1269 An ITEM may also be just a string--that makes a nonselectable item.\n\
1270 An ITEM may also be nil--that means to put all preceding items\n\
1271 on the left of the dialog box and all following items on the right.\n\
1272 \(By default, approximately half appear on each side.)")
1273 (position, contents)
1274 Lisp_Object position, contents;
1276 FRAME_PTR f;
1277 Lisp_Object window;
1279 /* Decode the first argument: find the window or frame to use. */
1280 if (EQ (position, Qt))
1282 /* Decode the first argument: find the window and the coordinates. */
1283 if (EQ (position, Qt))
1284 window = selected_window;
1286 else if (CONSP (position))
1288 Lisp_Object tem;
1289 tem = Fcar (position);
1290 if (XTYPE (tem) == Lisp_Cons)
1291 window = Fcar (Fcdr (position));
1292 else
1294 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1295 window = Fcar (tem); /* POSN_WINDOW (tem) */
1298 else if (WINDOWP (position) || FRAMEP (position))
1299 window = position;
1301 /* Decode where to put the menu. */
1303 if (FRAMEP (window))
1304 f = XFRAME (window);
1305 else if (WINDOWP (window))
1307 CHECK_LIVE_WINDOW (window, 0);
1308 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1310 else
1311 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1312 but I don't want to make one now. */
1313 CHECK_WINDOW (window, 0);
1315 #if 1
1316 /* Display a menu with these alternatives
1317 in the middle of frame F. */
1319 Lisp_Object x, y, frame, newpos;
1320 XSETFRAME (frame, f);
1321 XSETINT (x, x_pixel_width (f) / 2);
1322 XSETINT (y, x_pixel_height (f) / 2);
1323 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1325 return Fx_popup_menu (newpos,
1326 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1328 #else
1330 Lisp_Object title;
1331 char *error_name;
1332 Lisp_Object selection;
1334 /* Decode the dialog items from what was specified. */
1335 title = Fcar (contents);
1336 CHECK_STRING (title, 1);
1338 list_of_panes (Fcons (contents, Qnil));
1340 /* Display them in a dialog box. */
1341 BLOCK_INPUT;
1342 selection = w32_dialog_show (f, 0, 0, title, &error_name);
1343 UNBLOCK_INPUT;
1345 discard_menu_items ();
1347 if (error_name) error (error_name);
1348 return selection;
1350 #endif
1353 Lisp_Object
1354 get_frame_menubar_event (f, num)
1355 FRAME_PTR f;
1356 int num;
1358 Lisp_Object tail, items;
1359 int i;
1360 struct gcpro gcpro1;
1362 BLOCK_INPUT;
1364 GCPRO1 (items);
1366 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1367 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1369 for (i = 0; i < XVECTOR (items)->size; i += 4)
1371 Lisp_Object event;
1373 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1375 if (num <= 0)
1377 UNGCPRO;
1378 UNBLOCK_INPUT;
1379 return (Fcons (XVECTOR (items)->contents[i], event));
1383 UNGCPRO;
1384 UNBLOCK_INPUT;
1386 return (Qnil);
1389 void
1390 set_frame_menubar (f, first_time)
1391 FRAME_PTR f;
1392 int first_time;
1394 Lisp_Object tail, items;
1395 HMENU hmenu;
1396 int i;
1397 struct gcpro gcpro1;
1398 menu_map mm;
1399 int count = specpdl_ptr - specpdl;
1401 struct buffer *prev = current_buffer;
1402 Lisp_Object buffer;
1404 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1405 specbind (Qinhibit_quit, Qt);
1406 /* Don't let the debugger step into this code
1407 because it is not reentrant. */
1408 specbind (Qdebug_on_next_call, Qnil);
1410 record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil));
1411 if (NILP (Voverriding_local_map_menu_flag))
1413 specbind (Qoverriding_terminal_local_map, Qnil);
1414 specbind (Qoverriding_local_map, Qnil);
1417 set_buffer_internal_1 (XBUFFER (buffer));
1419 /* Run the Lucid hook. */
1420 call1 (Vrun_hooks, Qactivate_menubar_hook);
1421 /* If it has changed current-menubar from previous value,
1422 really recompute the menubar from the value. */
1423 if (! NILP (Vlucid_menu_bar_dirty_flag))
1424 call0 (Qrecompute_lucid_menubar);
1425 safe_run_hooks (Qmenu_bar_update_hook);
1427 BLOCK_INPUT;
1429 GCPRO1 (items);
1431 items = FRAME_MENU_BAR_ITEMS (f);
1432 if (NILP (items))
1433 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1435 hmenu = CreateMenu ();
1437 if (!hmenu) goto error;
1439 discard_menu_items (&mm);
1440 UNBLOCK_INPUT;
1442 for (i = 0; i < XVECTOR (items)->size; i += 4)
1444 Lisp_Object string;
1445 int keymaps;
1446 CHAR *error;
1447 HMENU new_hmenu;
1449 string = XVECTOR (items)->contents[i + 1];
1450 if (NILP (string))
1451 break;
1453 /* Input must not be blocked here
1454 because we call general Lisp code and internal_condition_case_1. */
1455 new_hmenu = create_menu_items (&mm,
1456 XVECTOR (items)->contents[i + 2],
1459 if (!new_hmenu)
1460 continue;
1462 BLOCK_INPUT;
1463 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1464 (char *) XSTRING (string)->data);
1465 UNBLOCK_INPUT;
1468 BLOCK_INPUT;
1470 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1471 SetMenu (FRAME_W32_WINDOW (f), hmenu);
1472 DestroyMenu (old);
1475 error:
1476 set_buffer_internal_1 (prev);
1477 UNGCPRO;
1478 UNBLOCK_INPUT;
1479 unbind_to (count, Qnil);
1482 void
1483 free_frame_menubar (f)
1484 FRAME_PTR f;
1486 BLOCK_INPUT;
1489 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1490 SetMenu (FRAME_W32_WINDOW (f), NULL);
1491 DestroyMenu (old);
1494 UNBLOCK_INPUT;
1496 /* Called from Fw32_create_frame to create the initial menubar of a frame
1497 before it is mapped, so that the window is mapped with the menubar already
1498 there instead of us tacking it on later and thrashing the window after it
1499 is visible. */
1500 void
1501 initialize_frame_menubar (f)
1502 FRAME_PTR f;
1504 set_frame_menubar (f, 1);
1507 #if 0
1508 /* If the mouse has moved to another menu bar item,
1509 return 1 and unread a button press event for that item.
1510 Otherwise return 0. */
1512 static int
1513 check_mouse_other_menu_bar (f)
1514 FRAME_PTR f;
1516 FRAME_PTR new_f;
1517 Lisp_Object bar_window;
1518 int part;
1519 Lisp_Object x, y;
1520 unsigned long time;
1522 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1524 if (f == new_f && other_menu_bar_item_p (f, x, y))
1526 unread_menu_bar_button (f, x);
1527 return 1;
1530 return 0;
1532 #endif
1535 #if 0
1536 static HMENU
1537 create_menu (keymaps, error)
1538 int keymaps;
1539 char **error;
1541 HMENU hmenu = NULL; /* the menu we are currently working on */
1542 HMENU first_hmenu = NULL;
1544 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1545 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1546 sizeof (Lisp_Object));
1547 int submenu_depth = 0;
1548 int i;
1550 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1552 *error = "Empty menu";
1553 return NULL;
1556 i = 0;
1558 /* Loop over all panes and items, filling in the tree. */
1560 while (i < menu_items_used)
1562 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1564 submenu_stack[submenu_depth++] = hmenu;
1565 i++;
1567 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1569 hmenu = submenu_stack[--submenu_depth];
1570 i++;
1572 #if 0
1573 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1574 && submenu_depth != 0)
1575 i += MENU_ITEMS_PANE_LENGTH;
1576 #endif
1577 /* Ignore a nil in the item list.
1578 It's meaningful only for dialog boxes. */
1579 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1580 i += 1;
1581 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1583 /* Create a new pane. */
1585 Lisp_Object pane_name;
1586 char *pane_string;
1588 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1589 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1591 if (!hmenu || strcmp (pane_string, ""))
1593 HMENU new_hmenu = CreateMenu ();
1595 if (!new_hmenu)
1597 *error = "Could not create menu pane";
1598 goto error;
1601 if (hmenu)
1603 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1606 hmenu = new_hmenu;
1608 if (!first_hmenu) first_hmenu = hmenu;
1610 i += MENU_ITEMS_PANE_LENGTH;
1612 else
1614 /* Create a new item within current pane. */
1616 Lisp_Object item_name, enable, descrip;
1617 UINT fuFlags;
1619 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1620 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1621 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1623 if (((char *) XSTRING (item_name)->data)[0] == 0
1624 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1625 fuFlags = MF_SEPARATOR;
1626 else if (NILP (enable) || !XUINT(enable))
1627 fuFlags = MF_STRING | MF_GRAYED;
1628 else
1629 fuFlags = MF_STRING;
1631 AppendMenu (hmenu,
1632 fuFlags,
1634 (char *) XSTRING (item_name)->data);
1636 // if (!NILP (descrip))
1637 // hmenu->key = (char *) XSTRING (descrip)->data;
1639 i += MENU_ITEMS_ITEM_LENGTH;
1643 return (first_hmenu);
1645 error:
1646 if (first_hmenu) DestroyMenu (first_hmenu);
1647 return (NULL);
1650 #endif
1652 /* w32menu_show actually displays a menu using the panes and items in
1653 menu_items and returns the value selected from it.
1654 There are two versions of w32menu_show, one for Xt and one for Xlib.
1655 Both assume input is blocked by the caller. */
1657 /* F is the frame the menu is for.
1658 X and Y are the frame-relative specified position,
1659 relative to the inside upper left corner of the frame F.
1660 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1661 KEYMAPS is 1 if this menu was specified with keymaps;
1662 in that case, we return a list containing the chosen item's value
1663 and perhaps also the pane's prefix.
1664 TITLE is the specified menu title.
1665 ERROR is a place to store an error message string in case of failure.
1666 (We return nil on failure, but the value doesn't actually matter.) */
1669 static Lisp_Object
1670 w32menu_show (f, x, y, menu, hmenu, error)
1671 FRAME_PTR f;
1672 int x;
1673 int y;
1674 Lisp_Object menu;
1675 HMENU hmenu;
1676 char **error;
1678 int i , menu_selection;
1679 POINT pos;
1681 *error = NULL;
1683 if (!hmenu)
1685 *error = "Empty menu";
1686 return Qnil;
1689 pos.x = x;
1690 pos.y = y;
1692 /* Offset the coordinates to root-relative. */
1693 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1695 #if 0
1696 /* If the mouse moves out of the menu before we show the menu,
1697 don't show it at all. */
1698 if (check_mouse_other_menu_bar (f))
1700 DestroyMenu (hmenu);
1701 return Qnil;
1703 #endif
1705 /* Display the menu. */
1706 menu_selection = TrackPopupMenu (hmenu,
1707 0x10,
1708 pos.x, pos.y,
1710 FRAME_W32_WINDOW (f),
1711 NULL);
1712 if (menu_selection == -1)
1714 *error = "Invalid menu specification";
1715 return Qnil;
1718 /* Find the selected item, and its pane, to return
1719 the proper value. */
1721 #if 1
1722 if (menu_selection > 0)
1724 return get_menu_event (menu, menu_selection);
1726 #else
1727 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1729 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1731 #endif
1733 return Qnil;
1736 #if 0
1737 static char * button_names [] =
1739 "button1", "button2", "button3", "button4", "button5",
1740 "button6", "button7", "button8", "button9", "button10"
1743 static Lisp_Object
1744 w32_dialog_show (f, menubarp, keymaps, title, error)
1745 FRAME_PTR f;
1746 int menubarp;
1747 int keymaps;
1748 Lisp_Object title;
1749 char **error;
1751 int i, nb_buttons=0;
1752 HMENU hmenu;
1753 char dialog_name[6];
1755 /* Number of elements seen so far, before boundary. */
1756 int left_count = 0;
1757 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1758 int boundary_seen = 0;
1760 *error = NULL;
1762 if (menu_items_n_panes > 1)
1764 *error = "Multiple panes in dialog box";
1765 return Qnil;
1768 /* Create a tree of widget_value objects
1769 representing the text label and buttons. */
1771 Lisp_Object pane_name, prefix;
1772 char *pane_string;
1773 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1774 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1775 pane_string = (NILP (pane_name)
1776 ? "" : (char *) XSTRING (pane_name)->data);
1777 prev_wv = malloc_widget_value ();
1778 prev_wv->value = pane_string;
1779 if (keymaps && !NILP (prefix))
1780 prev_wv->name++;
1781 prev_wv->enabled = 1;
1782 prev_wv->name = "message";
1783 first_wv = prev_wv;
1785 /* Loop over all panes and items, filling in the tree. */
1786 i = MENU_ITEMS_PANE_LENGTH;
1787 while (i < menu_items_used)
1790 /* Create a new item within current pane. */
1791 Lisp_Object item_name, enable, descrip;
1792 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1793 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1794 descrip
1795 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1797 if (NILP (item_name))
1799 free_menubar_widget_value_tree (first_wv);
1800 *error = "Submenu in dialog items";
1801 return Qnil;
1803 if (EQ (item_name, Qquote))
1805 /* This is the boundary between left-side elts
1806 and right-side elts. Stop incrementing right_count. */
1807 boundary_seen = 1;
1808 i++;
1809 continue;
1811 if (nb_buttons >= 10)
1813 free_menubar_widget_value_tree (first_wv);
1814 *error = "Too many dialog items";
1815 return Qnil;
1818 wv = malloc_widget_value ();
1819 prev_wv->next = wv;
1820 wv->name = (char *) button_names[nb_buttons];
1821 if (!NILP (descrip))
1822 wv->key = (char *) XSTRING (descrip)->data;
1823 wv->value = (char *) XSTRING (item_name)->data;
1824 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1825 wv->enabled = !NILP (enable);
1826 prev_wv = wv;
1828 if (! boundary_seen)
1829 left_count++;
1831 nb_buttons++;
1832 i += MENU_ITEMS_ITEM_LENGTH;
1835 /* If the boundary was not specified,
1836 by default put half on the left and half on the right. */
1837 if (! boundary_seen)
1838 left_count = nb_buttons - nb_buttons / 2;
1840 wv = malloc_widget_value ();
1841 wv->name = dialog_name;
1843 /* Dialog boxes use a really stupid name encoding
1844 which specifies how many buttons to use
1845 and how many buttons are on the right.
1846 The Q means something also. */
1847 dialog_name[0] = 'Q';
1848 dialog_name[1] = '0' + nb_buttons;
1849 dialog_name[2] = 'B';
1850 dialog_name[3] = 'R';
1851 /* Number of buttons to put on the right. */
1852 dialog_name[4] = '0' + nb_buttons - left_count;
1853 dialog_name[5] = 0;
1854 wv->contents = first_wv;
1855 first_wv = wv;
1858 /* Actually create the dialog. */
1859 dialog_id = ++popup_id_tick;
1860 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1861 f->output_data.w32->widget, 1, 0,
1862 dialog_selection_callback, 0);
1863 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1864 lw_modify_all_widgets (dialog_id, first_wv, True);
1865 #endif
1866 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1867 /* Free the widget_value objects we used to specify the contents. */
1868 free_menubar_widget_value_tree (first_wv);
1870 /* No selection has been chosen yet. */
1871 menu_item_selection = 0;
1873 /* Display the menu. */
1874 lw_pop_up_all_widgets (dialog_id);
1876 /* Process events that apply to the menu. */
1877 while (1)
1879 XEvent event;
1881 XtAppNextEvent (Xt_app_con, &event);
1882 if (event.type == ButtonRelease)
1884 XtDispatchEvent (&event);
1885 break;
1887 else if (event.type == Expose)
1888 process_expose_from_menu (event);
1889 XtDispatchEvent (&event);
1890 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1892 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1894 if (queue_tmp != NULL)
1896 queue_tmp->event = event;
1897 queue_tmp->next = queue;
1898 queue = queue_tmp;
1902 pop_down:
1904 /* State that no mouse buttons are now held.
1905 That is not necessarily true, but the fiction leads to reasonable
1906 results, and it is a pain to ask which are actually held now
1907 or track this in the loop above. */
1908 w32_mouse_grabbed = 0;
1910 /* Unread any events that we got but did not handle. */
1911 while (queue != NULL)
1913 queue_tmp = queue;
1914 XPutBackEvent (XDISPLAY &queue_tmp->event);
1915 queue = queue_tmp->next;
1916 free ((char *)queue_tmp);
1917 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1918 interrupt_input_pending = 1;
1921 /* Find the selected item, and its pane, to return
1922 the proper value. */
1923 if (menu_item_selection != 0)
1925 Lisp_Object prefix;
1927 prefix = Qnil;
1928 i = 0;
1929 while (i < menu_items_used)
1931 Lisp_Object entry;
1933 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1935 prefix
1936 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1937 i += MENU_ITEMS_PANE_LENGTH;
1939 else
1941 entry
1942 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1943 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1945 if (keymaps != 0)
1947 entry = Fcons (entry, Qnil);
1948 if (!NILP (prefix))
1949 entry = Fcons (prefix, entry);
1951 return entry;
1953 i += MENU_ITEMS_ITEM_LENGTH;
1958 return Qnil;
1960 #endif
1962 syms_of_w32menu ()
1964 Qdebug_on_next_call = intern ("debug-on-next-call");
1965 staticpro (&Qdebug_on_next_call);
1967 defsubr (&Sx_popup_menu);
1968 defsubr (&Sx_popup_dialog);