(win32_read_socket): Never block reading from input queue.
[emacs.git] / src / w32menu.c
blobeb6b18fa21d023686ddfb0eb968a7a9e5610371e
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)
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 win32_dialog_show ();
70 static Lisp_Object win32menu_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 win32menu_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 win32menu_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))
1157 /* Use the mouse's current position. */
1158 FRAME_PTR new_f = 0;
1159 Lisp_Object bar_window;
1160 int part;
1161 unsigned long time;
1163 if (mouse_position_hook)
1164 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1165 if (new_f != 0)
1166 XSETFRAME (window, new_f);
1167 else
1169 window = selected_window;
1170 XSETFASTINT (x, 0);
1171 XSETFASTINT (y, 0);
1174 else
1176 tem = Fcar (position);
1177 if (CONSP (tem))
1179 window = Fcar (Fcdr (position));
1180 x = Fcar (tem);
1181 y = Fcar (Fcdr (tem));
1183 else
1185 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1186 window = Fcar (tem); /* POSN_WINDOW (tem) */
1187 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1188 x = Fcar (tem);
1189 y = Fcdr (tem);
1191 /* Determine whether this menu is handling a menu bar click. */
1192 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1193 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1194 menubarp = 1;
1198 CHECK_NUMBER (x, 0);
1199 CHECK_NUMBER (y, 0);
1201 /* Decode where to put the menu. */
1203 if (FRAMEP (window))
1205 f = XFRAME (window);
1207 xpos = 0;
1208 ypos = 0;
1210 else if (WINDOWP (window))
1212 CHECK_LIVE_WINDOW (window, 0);
1213 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1215 xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left);
1216 ypos = (f->output_data.win32->line_height * XWINDOW (window)->top);
1218 else
1219 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1220 but I don't want to make one now. */
1221 CHECK_WINDOW (window, 0);
1223 xpos += XINT (x);
1224 ypos += XINT (y);
1227 title = Qnil;
1228 GCPRO1 (title);
1230 discard_menu_items (&mm);
1231 hmenu = create_menu_items (&mm, menu, NILP (position));
1233 if (NILP (position))
1235 discard_menu_items (&mm);
1236 UNGCPRO;
1237 return Qnil;
1240 /* Display them in a menu. */
1241 BLOCK_INPUT;
1243 selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
1245 UNBLOCK_INPUT;
1247 discard_menu_items (&mm);
1248 DestroyMenu (hmenu);
1250 UNGCPRO;
1252 if (error_name) error (error_name);
1253 return selection;
1256 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1257 "Pop up a dialog box and return user's selection.\n\
1258 POSITION specifies which frame to use.\n\
1259 This is normally a mouse button event or a window or frame.\n\
1260 If POSITION is t, it means to use the frame the mouse is on.\n\
1261 The dialog box appears in the middle of the specified frame.\n\
1263 CONTENTS specifies the alternatives to display in the dialog box.\n\
1264 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1265 Each ITEM is a cons cell (STRING . VALUE).\n\
1266 The return value is VALUE from the chosen item.\n\n\
1267 An ITEM may also be just a string--that makes a nonselectable item.\n\
1268 An ITEM may also be nil--that means to put all preceding items\n\
1269 on the left of the dialog box and all following items on the right.\n\
1270 \(By default, approximately half appear on each side.)")
1271 (position, contents)
1272 Lisp_Object position, contents;
1274 FRAME_PTR f;
1275 Lisp_Object window;
1277 /* Decode the first argument: find the window or frame to use. */
1278 if (EQ (position, Qt))
1280 /* Decode the first argument: find the window and the coordinates. */
1281 if (EQ (position, Qt))
1282 window = selected_window;
1284 else if (CONSP (position))
1286 Lisp_Object tem;
1287 tem = Fcar (position);
1288 if (XTYPE (tem) == Lisp_Cons)
1289 window = Fcar (Fcdr (position));
1290 else
1292 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1293 window = Fcar (tem); /* POSN_WINDOW (tem) */
1296 else if (WINDOWP (position) || FRAMEP (position))
1297 window = position;
1299 /* Decode where to put the menu. */
1301 if (FRAMEP (window))
1302 f = XFRAME (window);
1303 else if (WINDOWP (window))
1305 CHECK_LIVE_WINDOW (window, 0);
1306 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1308 else
1309 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1310 but I don't want to make one now. */
1311 CHECK_WINDOW (window, 0);
1313 #if 1
1314 /* Display a menu with these alternatives
1315 in the middle of frame F. */
1317 Lisp_Object x, y, frame, newpos;
1318 XSETFRAME (frame, f);
1319 XSETINT (x, x_pixel_width (f) / 2);
1320 XSETINT (y, x_pixel_height (f) / 2);
1321 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1323 return Fx_popup_menu (newpos,
1324 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1326 #else
1328 Lisp_Object title;
1329 char *error_name;
1330 Lisp_Object selection;
1332 /* Decode the dialog items from what was specified. */
1333 title = Fcar (contents);
1334 CHECK_STRING (title, 1);
1336 list_of_panes (Fcons (contents, Qnil));
1338 /* Display them in a dialog box. */
1339 BLOCK_INPUT;
1340 selection = win32_dialog_show (f, 0, 0, title, &error_name);
1341 UNBLOCK_INPUT;
1343 discard_menu_items ();
1345 if (error_name) error (error_name);
1346 return selection;
1348 #endif
1351 Lisp_Object
1352 get_frame_menubar_event (f, num)
1353 FRAME_PTR f;
1354 int num;
1356 Lisp_Object tail, items;
1357 int i;
1358 struct gcpro gcpro1;
1360 BLOCK_INPUT;
1362 GCPRO1 (items);
1364 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1365 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1367 for (i = 0; i < XVECTOR (items)->size; i += 4)
1369 Lisp_Object event;
1371 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1373 if (num <= 0)
1375 UNGCPRO;
1376 UNBLOCK_INPUT;
1377 return (Fcons (XVECTOR (items)->contents[i], event));
1381 UNGCPRO;
1382 UNBLOCK_INPUT;
1384 return (Qnil);
1387 void
1388 set_frame_menubar (f, first_time)
1389 FRAME_PTR f;
1390 int first_time;
1392 Lisp_Object tail, items;
1393 HMENU hmenu;
1394 int i;
1395 struct gcpro gcpro1;
1396 menu_map mm;
1397 int count = specpdl_ptr - specpdl;
1399 struct buffer *prev = current_buffer;
1400 Lisp_Object buffer;
1402 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1403 specbind (Qinhibit_quit, Qt);
1404 /* Don't let the debugger step into this code
1405 because it is not reentrant. */
1406 specbind (Qdebug_on_next_call, Qnil);
1408 record_unwind_protect (Fstore_match_data, Fmatch_data ());
1409 if (NILP (Voverriding_local_map_menu_flag))
1411 specbind (Qoverriding_terminal_local_map, Qnil);
1412 specbind (Qoverriding_local_map, Qnil);
1415 set_buffer_internal_1 (XBUFFER (buffer));
1417 /* Run the Lucid hook. */
1418 call1 (Vrun_hooks, Qactivate_menubar_hook);
1419 /* If it has changed current-menubar from previous value,
1420 really recompute the menubar from the value. */
1421 if (! NILP (Vlucid_menu_bar_dirty_flag))
1422 call0 (Qrecompute_lucid_menubar);
1423 safe_run_hooks (Qmenu_bar_update_hook);
1425 BLOCK_INPUT;
1427 GCPRO1 (items);
1429 items = FRAME_MENU_BAR_ITEMS (f);
1430 if (NILP (items))
1431 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1433 hmenu = CreateMenu ();
1435 if (!hmenu) goto error;
1437 discard_menu_items (&mm);
1438 UNBLOCK_INPUT;
1440 for (i = 0; i < XVECTOR (items)->size; i += 4)
1442 Lisp_Object string;
1443 int keymaps;
1444 CHAR *error;
1445 HMENU new_hmenu;
1447 string = XVECTOR (items)->contents[i + 1];
1448 if (NILP (string))
1449 break;
1451 /* Input must not be blocked here
1452 because we call general Lisp code and internal_condition_case_1. */
1453 new_hmenu = create_menu_items (&mm,
1454 XVECTOR (items)->contents[i + 2],
1457 if (!new_hmenu)
1458 continue;
1460 BLOCK_INPUT;
1461 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1462 (char *) XSTRING (string)->data);
1463 UNBLOCK_INPUT;
1466 BLOCK_INPUT;
1468 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1469 SetMenu (FRAME_WIN32_WINDOW (f), hmenu);
1470 DestroyMenu (old);
1473 error:
1474 set_buffer_internal_1 (prev);
1475 UNGCPRO;
1476 UNBLOCK_INPUT;
1477 unbind_to (count, Qnil);
1480 void
1481 free_frame_menubar (f)
1482 FRAME_PTR f;
1484 BLOCK_INPUT;
1487 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1488 SetMenu (FRAME_WIN32_WINDOW (f), NULL);
1489 DestroyMenu (old);
1492 UNBLOCK_INPUT;
1494 /* Called from Fwin32_create_frame to create the initial menubar of a frame
1495 before it is mapped, so that the window is mapped with the menubar already
1496 there instead of us tacking it on later and thrashing the window after it
1497 is visible. */
1498 void
1499 initialize_frame_menubar (f)
1500 FRAME_PTR f;
1502 set_frame_menubar (f, 1);
1505 #if 0
1506 /* If the mouse has moved to another menu bar item,
1507 return 1 and unread a button press event for that item.
1508 Otherwise return 0. */
1510 static int
1511 check_mouse_other_menu_bar (f)
1512 FRAME_PTR f;
1514 FRAME_PTR new_f;
1515 Lisp_Object bar_window;
1516 int part;
1517 Lisp_Object x, y;
1518 unsigned long time;
1520 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1522 if (f == new_f && other_menu_bar_item_p (f, x, y))
1524 unread_menu_bar_button (f, x);
1525 return 1;
1528 return 0;
1530 #endif
1533 #if 0
1534 static HMENU
1535 create_menu (keymaps, error)
1536 int keymaps;
1537 char **error;
1539 HMENU hmenu = NULL; /* the menu we are currently working on */
1540 HMENU first_hmenu = NULL;
1542 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1543 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1544 sizeof (Lisp_Object));
1545 int submenu_depth = 0;
1546 int i;
1548 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1550 *error = "Empty menu";
1551 return NULL;
1554 i = 0;
1556 /* Loop over all panes and items, filling in the tree. */
1558 while (i < menu_items_used)
1560 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1562 submenu_stack[submenu_depth++] = hmenu;
1563 i++;
1565 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1567 hmenu = submenu_stack[--submenu_depth];
1568 i++;
1570 #if 0
1571 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1572 && submenu_depth != 0)
1573 i += MENU_ITEMS_PANE_LENGTH;
1574 #endif
1575 /* Ignore a nil in the item list.
1576 It's meaningful only for dialog boxes. */
1577 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1578 i += 1;
1579 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1581 /* Create a new pane. */
1583 Lisp_Object pane_name;
1584 char *pane_string;
1586 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1587 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1589 if (!hmenu || strcmp (pane_string, ""))
1591 HMENU new_hmenu = CreateMenu ();
1593 if (!new_hmenu)
1595 *error = "Could not create menu pane";
1596 goto error;
1599 if (hmenu)
1601 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1604 hmenu = new_hmenu;
1606 if (!first_hmenu) first_hmenu = hmenu;
1608 i += MENU_ITEMS_PANE_LENGTH;
1610 else
1612 /* Create a new item within current pane. */
1614 Lisp_Object item_name, enable, descrip;
1615 UINT fuFlags;
1617 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1618 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1619 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1621 if (((char *) XSTRING (item_name)->data)[0] == 0
1622 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1623 fuFlags = MF_SEPARATOR;
1624 else if (NILP (enable) || !XUINT(enable))
1625 fuFlags = MF_STRING | MF_GRAYED;
1626 else
1627 fuFlags = MF_STRING;
1629 AppendMenu (hmenu,
1630 fuFlags,
1632 (char *) XSTRING (item_name)->data);
1634 // if (!NILP (descrip))
1635 // hmenu->key = (char *) XSTRING (descrip)->data;
1637 i += MENU_ITEMS_ITEM_LENGTH;
1641 return (first_hmenu);
1643 error:
1644 if (first_hmenu) DestroyMenu (first_hmenu);
1645 return (NULL);
1648 #endif
1650 /* win32menu_show actually displays a menu using the panes and items in
1651 menu_items and returns the value selected from it.
1652 There are two versions of win32menu_show, one for Xt and one for Xlib.
1653 Both assume input is blocked by the caller. */
1655 /* F is the frame the menu is for.
1656 X and Y are the frame-relative specified position,
1657 relative to the inside upper left corner of the frame F.
1658 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1659 KEYMAPS is 1 if this menu was specified with keymaps;
1660 in that case, we return a list containing the chosen item's value
1661 and perhaps also the pane's prefix.
1662 TITLE is the specified menu title.
1663 ERROR is a place to store an error message string in case of failure.
1664 (We return nil on failure, but the value doesn't actually matter.) */
1667 static Lisp_Object
1668 win32menu_show (f, x, y, menu, hmenu, error)
1669 FRAME_PTR f;
1670 int x;
1671 int y;
1672 Lisp_Object menu;
1673 HMENU hmenu;
1674 char **error;
1676 int i , menu_selection;
1677 POINT pos;
1679 *error = NULL;
1681 if (!hmenu)
1683 *error = "Empty menu";
1684 return Qnil;
1687 pos.x = x;
1688 pos.y = y;
1690 /* Offset the coordinates to root-relative. */
1691 ClientToScreen (FRAME_WIN32_WINDOW (f), &pos);
1693 #if 0
1694 /* If the mouse moves out of the menu before we show the menu,
1695 don't show it at all. */
1696 if (check_mouse_other_menu_bar (f))
1698 DestroyMenu (hmenu);
1699 return Qnil;
1701 #endif
1703 /* Display the menu. */
1704 menu_selection = TrackPopupMenu (hmenu,
1705 0x10,
1706 pos.x, pos.y,
1708 FRAME_WIN32_WINDOW (f),
1709 NULL);
1710 if (menu_selection == -1)
1712 *error = "Invalid menu specification";
1713 return Qnil;
1716 /* Find the selected item, and its pane, to return
1717 the proper value. */
1719 #if 1
1720 if (menu_selection > 0)
1722 return get_menu_event (menu, menu_selection);
1724 #else
1725 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1727 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1729 #endif
1731 return Qnil;
1734 #if 0
1735 static char * button_names [] =
1737 "button1", "button2", "button3", "button4", "button5",
1738 "button6", "button7", "button8", "button9", "button10"
1741 static Lisp_Object
1742 win32_dialog_show (f, menubarp, keymaps, title, error)
1743 FRAME_PTR f;
1744 int menubarp;
1745 int keymaps;
1746 Lisp_Object title;
1747 char **error;
1749 int i, nb_buttons=0;
1750 HMENU hmenu;
1751 char dialog_name[6];
1753 /* Number of elements seen so far, before boundary. */
1754 int left_count = 0;
1755 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1756 int boundary_seen = 0;
1758 *error = NULL;
1760 if (menu_items_n_panes > 1)
1762 *error = "Multiple panes in dialog box";
1763 return Qnil;
1766 /* Create a tree of widget_value objects
1767 representing the text label and buttons. */
1769 Lisp_Object pane_name, prefix;
1770 char *pane_string;
1771 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1772 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1773 pane_string = (NILP (pane_name)
1774 ? "" : (char *) XSTRING (pane_name)->data);
1775 prev_wv = malloc_widget_value ();
1776 prev_wv->value = pane_string;
1777 if (keymaps && !NILP (prefix))
1778 prev_wv->name++;
1779 prev_wv->enabled = 1;
1780 prev_wv->name = "message";
1781 first_wv = prev_wv;
1783 /* Loop over all panes and items, filling in the tree. */
1784 i = MENU_ITEMS_PANE_LENGTH;
1785 while (i < menu_items_used)
1788 /* Create a new item within current pane. */
1789 Lisp_Object item_name, enable, descrip;
1790 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1791 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1792 descrip
1793 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1795 if (NILP (item_name))
1797 free_menubar_widget_value_tree (first_wv);
1798 *error = "Submenu in dialog items";
1799 return Qnil;
1801 if (EQ (item_name, Qquote))
1803 /* This is the boundary between left-side elts
1804 and right-side elts. Stop incrementing right_count. */
1805 boundary_seen = 1;
1806 i++;
1807 continue;
1809 if (nb_buttons >= 10)
1811 free_menubar_widget_value_tree (first_wv);
1812 *error = "Too many dialog items";
1813 return Qnil;
1816 wv = malloc_widget_value ();
1817 prev_wv->next = wv;
1818 wv->name = (char *) button_names[nb_buttons];
1819 if (!NILP (descrip))
1820 wv->key = (char *) XSTRING (descrip)->data;
1821 wv->value = (char *) XSTRING (item_name)->data;
1822 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1823 wv->enabled = !NILP (enable);
1824 prev_wv = wv;
1826 if (! boundary_seen)
1827 left_count++;
1829 nb_buttons++;
1830 i += MENU_ITEMS_ITEM_LENGTH;
1833 /* If the boundary was not specified,
1834 by default put half on the left and half on the right. */
1835 if (! boundary_seen)
1836 left_count = nb_buttons - nb_buttons / 2;
1838 wv = malloc_widget_value ();
1839 wv->name = dialog_name;
1841 /* Dialog boxes use a really stupid name encoding
1842 which specifies how many buttons to use
1843 and how many buttons are on the right.
1844 The Q means something also. */
1845 dialog_name[0] = 'Q';
1846 dialog_name[1] = '0' + nb_buttons;
1847 dialog_name[2] = 'B';
1848 dialog_name[3] = 'R';
1849 /* Number of buttons to put on the right. */
1850 dialog_name[4] = '0' + nb_buttons - left_count;
1851 dialog_name[5] = 0;
1852 wv->contents = first_wv;
1853 first_wv = wv;
1856 /* Actually create the dialog. */
1857 dialog_id = ++popup_id_tick;
1858 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1859 f->output_data.win32->widget, 1, 0,
1860 dialog_selection_callback, 0);
1861 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1862 lw_modify_all_widgets (dialog_id, first_wv, True);
1863 #endif
1864 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1865 /* Free the widget_value objects we used to specify the contents. */
1866 free_menubar_widget_value_tree (first_wv);
1868 /* No selection has been chosen yet. */
1869 menu_item_selection = 0;
1871 /* Display the menu. */
1872 lw_pop_up_all_widgets (dialog_id);
1874 /* Process events that apply to the menu. */
1875 while (1)
1877 XEvent event;
1879 XtAppNextEvent (Xt_app_con, &event);
1880 if (event.type == ButtonRelease)
1882 XtDispatchEvent (&event);
1883 break;
1885 else if (event.type == Expose)
1886 process_expose_from_menu (event);
1887 XtDispatchEvent (&event);
1888 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1890 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1892 if (queue_tmp != NULL)
1894 queue_tmp->event = event;
1895 queue_tmp->next = queue;
1896 queue = queue_tmp;
1900 pop_down:
1902 /* State that no mouse buttons are now held.
1903 That is not necessarily true, but the fiction leads to reasonable
1904 results, and it is a pain to ask which are actually held now
1905 or track this in the loop above. */
1906 win32_mouse_grabbed = 0;
1908 /* Unread any events that we got but did not handle. */
1909 while (queue != NULL)
1911 queue_tmp = queue;
1912 XPutBackEvent (XDISPLAY &queue_tmp->event);
1913 queue = queue_tmp->next;
1914 free ((char *)queue_tmp);
1915 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1916 interrupt_input_pending = 1;
1919 /* Find the selected item, and its pane, to return
1920 the proper value. */
1921 if (menu_item_selection != 0)
1923 Lisp_Object prefix;
1925 prefix = Qnil;
1926 i = 0;
1927 while (i < menu_items_used)
1929 Lisp_Object entry;
1931 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1933 prefix
1934 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1935 i += MENU_ITEMS_PANE_LENGTH;
1937 else
1939 entry
1940 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1941 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1943 if (keymaps != 0)
1945 entry = Fcons (entry, Qnil);
1946 if (!NILP (prefix))
1947 entry = Fcons (prefix, entry);
1949 return entry;
1951 i += MENU_ITEMS_ITEM_LENGTH;
1956 return Qnil;
1958 #endif
1960 syms_of_win32menu ()
1962 Qdebug_on_next_call = intern ("debug-on-next-call");
1963 staticpro (&Qdebug_on_next_call);
1965 defsubr (&Sx_popup_menu);
1966 defsubr (&Sx_popup_dialog);