*** empty log message ***
[emacs.git] / src / w32menu.c
blob81d90248178e5dcc2f2f895e753c01f392f6305a
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"
34 /* This may include sys/types.h, and that somehow loses
35 if this is not done before the other system files. */
36 #include "w32term.h"
38 /* Load sys/types.h if not already loaded.
39 In some systems loading it twice is suicidal. */
40 #ifndef makedev
41 #include <sys/types.h>
42 #endif
44 #include "dispextern.h"
46 #define min(x, y) (((x) < (y)) ? (x) : (y))
47 #define max(x, y) (((x) > (y)) ? (x) : (y))
49 typedef struct menu_map
51 Lisp_Object menu_items;
52 int menu_items_allocated;
53 int menu_items_used;
54 } menu_map;
56 extern Lisp_Object Qmenu_enable;
57 extern Lisp_Object Qmenu_bar;
59 static Lisp_Object win32_dialog_show ();
60 static Lisp_Object win32menu_show ();
62 static HMENU keymap_panes ();
63 static HMENU single_keymap_panes ();
64 static HMENU list_of_panes ();
65 static HMENU list_of_items ();
67 static HMENU create_menu_items ();
69 /* Initialize the menu_items structure if we haven't already done so.
70 Also mark it as currently empty. */
72 static void
73 init_menu_items (lpmm)
74 menu_map * lpmm;
76 if (NILP (lpmm->menu_items))
78 lpmm->menu_items_allocated = 60;
79 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
80 Qnil);
83 lpmm->menu_items_used = 0;
86 /* Call when finished using the data for the current menu
87 in menu_items. */
89 static void
90 discard_menu_items (lpmm)
91 menu_map * lpmm;
93 lpmm->menu_items = Qnil;
94 lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
97 /* Make the menu_items vector twice as large. */
99 static void
100 grow_menu_items (lpmm)
101 menu_map * lpmm;
103 Lisp_Object new;
104 int old_size = lpmm->menu_items_allocated;
106 lpmm->menu_items_allocated *= 2;
107 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
108 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
109 old_size * sizeof (Lisp_Object));
111 lpmm->menu_items = new;
114 /* Indicate boundary between left and right. */
116 static void
117 add_left_right_boundary (hmenu)
118 HMENU hmenu;
120 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
123 /* Push one menu item into the current pane.
124 NAME is the string to display. ENABLE if non-nil means
125 this item can be selected. KEY is the key generated by
126 choosing this item. EQUIV is the textual description
127 of the keyboard equivalent for this item (or nil if none). */
129 static void
130 add_menu_item (lpmm, hmenu, name, enable, key)
131 menu_map * lpmm;
132 HMENU hmenu;
133 Lisp_Object name;
134 UINT enable;
135 Lisp_Object key;
137 UINT fuFlags;
139 if (NILP (name)
140 || ((char *) XSTRING (name)->data)[0] == 0
141 || strcmp ((char *) XSTRING (name)->data, "--") == 0)
142 fuFlags = MF_SEPARATOR;
143 else if (enable)
144 fuFlags = MF_STRING;
145 else
146 fuFlags = MF_STRING | MF_GRAYED;
148 AppendMenu (hmenu,
149 fuFlags,
150 lpmm->menu_items_used + 1,
151 (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data);
153 lpmm->menu_items_used++;
154 #if 0
155 if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
156 grow_menu_items (lpmm);
158 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
159 Lisp_Cons,
160 key);
161 #endif
164 /* Figure out the current keyboard equivalent of a menu item ITEM1.
165 The item string for menu display should be ITEM_STRING.
166 Store the equivalent keyboard key sequence's
167 textual description into *DESCRIP_PTR.
168 Also cache them in the item itself.
169 Return the real definition to execute. */
171 static Lisp_Object
172 menu_item_equiv_key (item_string, item1, descrip_ptr)
173 Lisp_Object item_string;
174 Lisp_Object item1;
175 Lisp_Object *descrip_ptr;
177 /* This is the real definition--the function to run. */
178 Lisp_Object def;
179 /* This is the sublist that records cached equiv key data
180 so we can save time. */
181 Lisp_Object cachelist;
182 /* These are the saved equivalent keyboard key sequence
183 and its key-description. */
184 Lisp_Object savedkey, descrip;
185 Lisp_Object def1;
186 int changed = 0;
187 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
189 /* If a help string follows the item string, skip it. */
190 if (CONSP (XCONS (item1)->cdr)
191 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
192 item1 = XCONS (item1)->cdr;
194 def = Fcdr (item1);
196 /* Get out the saved equivalent-keyboard-key info. */
197 cachelist = savedkey = descrip = Qnil;
198 if (CONSP (def) && CONSP (XCONS (def)->car)
199 && (NILP (XCONS (XCONS (def)->car)->car)
200 || VECTORP (XCONS (XCONS (def)->car)->car)))
202 cachelist = XCONS (def)->car;
203 def = XCONS (def)->cdr;
204 savedkey = XCONS (cachelist)->car;
205 descrip = XCONS (cachelist)->cdr;
208 GCPRO4 (def, def1, savedkey, descrip);
210 /* Is it still valid? */
211 def1 = Qnil;
212 if (!NILP (savedkey))
213 def1 = Fkey_binding (savedkey, Qnil);
214 /* If not, update it. */
215 if (! EQ (def1, def)
216 /* If the command is an alias for another
217 (such as easymenu.el and lmenu.el set it up),
218 check if the original command matches the cached command. */
219 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
220 && EQ (def1, XSYMBOL (def)->function))
221 /* If something had no key binding before, don't recheck it--
222 doing that takes too much time and makes menus too slow. */
223 && !(!NILP (cachelist) && NILP (savedkey)))
225 changed = 1;
226 descrip = Qnil;
227 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
228 /* If the command is an alias for another
229 (such as easymenu.el and lmenu.el set it up),
230 see if the original command name has equivalent keys. */
231 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
232 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
233 Qnil, Qt, Qnil);
235 if (VECTORP (savedkey)
236 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
237 savedkey = Qnil;
238 if (!NILP (savedkey))
240 descrip = Fkey_description (savedkey);
241 descrip = concat2 (make_string (" (", 3), descrip);
242 descrip = concat2 (descrip, make_string (")", 1));
246 /* Cache the data we just got in a sublist of the menu binding. */
247 if (NILP (cachelist))
248 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
249 else if (changed)
251 XCONS (cachelist)->car = savedkey;
252 XCONS (cachelist)->cdr = descrip;
255 UNGCPRO;
256 *descrip_ptr = descrip;
257 return def;
260 /* This is used as the handler when calling internal_condition_case_1. */
262 static Lisp_Object
263 menu_item_enabled_p_1 (arg)
264 Lisp_Object arg;
266 return Qnil;
269 /* Return non-nil if the command DEF is enabled when used as a menu item.
270 This is based on looking for a menu-enable property.
271 If NOTREAL is set, don't bother really computing this. */
273 static Lisp_Object
274 menu_item_enabled_p (def, notreal)
275 Lisp_Object def;
277 Lisp_Object enabled, tem;
279 enabled = Qt;
280 if (notreal)
281 return enabled;
282 if (XTYPE (def) == Lisp_Symbol)
284 /* No property, or nil, means enable.
285 Otherwise, enable if value is not nil. */
286 tem = Fget (def, Qmenu_enable);
287 if (!NILP (tem))
288 /* (condition-case nil (eval tem)
289 (error nil)) */
290 enabled = internal_condition_case_1 (Feval, tem, Qerror,
291 menu_item_enabled_p_1);
293 return enabled;
296 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
297 and generate menu panes for them in menu_items.
298 If NOTREAL is nonzero,
299 don't bother really computing whether an item is enabled. */
301 static HMENU
302 keymap_panes (lpmm, keymaps, nmaps, notreal)
303 menu_map * lpmm;
304 Lisp_Object *keymaps;
305 int nmaps;
306 int notreal;
308 int mapno;
310 // init_menu_items (lpmm);
312 if (nmaps > 1)
314 HMENU hmenu;
316 if (!notreal)
318 hmenu = CreateMenu ();
320 if (!hmenu) return (NULL);
322 else
324 hmenu = NULL;
327 /* Loop over the given keymaps, making a pane for each map.
328 But don't make a pane that is empty--ignore that map instead.
329 P is the number of panes we have made so far. */
330 for (mapno = 0; mapno < nmaps; mapno++)
332 HMENU new_hmenu;
334 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
335 Qnil, Qnil, notreal);
337 if (!notreal && new_hmenu)
339 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
343 return (hmenu);
345 else
347 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
351 /* This is a recursive subroutine of keymap_panes.
352 It handles one keymap, KEYMAP.
353 The other arguments are passed along
354 or point to local variables of the previous function.
355 If NOTREAL is nonzero,
356 don't bother really computing whether an item is enabled. */
358 HMENU
359 single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
360 menu_map * lpmm;
361 Lisp_Object keymap;
362 Lisp_Object pane_name;
363 Lisp_Object prefix;
364 int notreal;
366 Lisp_Object pending_maps;
367 Lisp_Object tail, item, item1, item_string, table;
368 HMENU hmenu;
369 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
371 if (!notreal)
373 hmenu = CreateMenu ();
374 if (hmenu == NULL) return NULL;
376 else
378 hmenu = NULL;
381 pending_maps = Qnil;
383 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
385 /* Look at each key binding, and if it has a menu string,
386 make a menu item from it. */
388 item = XCONS (tail)->car;
390 if (CONSP (item))
392 item1 = XCONS (item)->cdr;
394 if (XTYPE (item1) == Lisp_Cons)
396 item_string = XCONS (item1)->car;
397 if (XTYPE (item_string) == Lisp_String)
399 /* This is the real definition--the function to run. */
401 Lisp_Object def;
403 /* These are the saved equivalent keyboard key sequence
404 and its key-description. */
406 Lisp_Object descrip;
407 Lisp_Object tem, enabled;
409 /* GCPRO because ...enabled_p will call eval
410 and ..._equiv_key may autoload something.
411 Protecting KEYMAP preserves everything we use;
412 aside from that, must protect whatever might be
413 a string. Since there's no GCPRO5, we refetch
414 item_string instead of protecting it. */
416 descrip = def = Qnil;
417 GCPRO4 (keymap, pending_maps, def, prefix);
419 def = menu_item_equiv_key (item_string, item1, &descrip);
420 enabled = menu_item_enabled_p (def, notreal);
422 UNGCPRO;
424 item_string = XCONS (item1)->car;
426 tem = Fkeymapp (def);
427 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
429 pending_maps = Fcons (Fcons (def,
430 Fcons (item_string,
431 XCONS (item)->car)),
432 pending_maps);
434 else
436 Lisp_Object submap;
438 GCPRO4 (keymap, pending_maps, item, item_string);
440 submap = get_keymap_1 (def, 0, 1);
442 UNGCPRO;
444 if (NILP (submap))
446 if (!notreal)
448 add_menu_item (lpmm,
449 hmenu,
450 item_string,
451 !NILP (enabled),
452 Fcons (XCONS (item)->car, prefix));
455 else
456 /* Display a submenu. */
458 HMENU new_hmenu = single_keymap_panes (lpmm,
459 submap,
460 item_string,
461 XCONS (item)->car,
462 notreal);
464 if (!notreal)
466 AppendMenu (hmenu, MF_POPUP,
467 (UINT)new_hmenu,
468 (char *) XSTRING (item_string)->data);
475 else if (VECTORP (item))
477 /* Loop over the char values represented in the vector. */
478 int len = XVECTOR (item)->size;
479 int c;
480 for (c = 0; c < len; c++)
482 Lisp_Object character;
483 XSETFASTINT (character, c);
484 item1 = XVECTOR (item)->contents[c];
485 if (CONSP (item1))
487 item_string = XCONS (item1)->car;
488 if (STRINGP (item_string))
490 Lisp_Object def;
492 /* These are the saved equivalent keyboard key sequence
493 and its key-description. */
494 Lisp_Object descrip;
495 Lisp_Object tem, enabled;
497 /* GCPRO because ...enabled_p will call eval
498 and ..._equiv_key may autoload something.
499 Protecting KEYMAP preserves everything we use;
500 aside from that, must protect whatever might be
501 a string. Since there's no GCPRO5, we refetch
502 item_string instead of protecting it. */
503 GCPRO4 (keymap, pending_maps, def, descrip);
504 descrip = def = Qnil;
506 def = menu_item_equiv_key (item_string, item1, &descrip);
507 enabled = menu_item_enabled_p (def, notreal);
509 UNGCPRO;
511 item_string = XCONS (item1)->car;
513 tem = Fkeymapp (def);
514 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
515 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
516 pending_maps);
517 else
519 Lisp_Object submap;
521 GCPRO4 (keymap, pending_maps, descrip, item_string);
523 submap = get_keymap_1 (def, 0, 1);
525 UNGCPRO;
527 if (NILP (submap))
529 if (!notreal)
531 add_menu_item (lpmm,
532 hmenu,
533 item_string,
534 !NILP (enabled),
535 character);
538 else
539 /* Display a submenu. */
541 HMENU new_hmenu = single_keymap_panes (lpmm,
542 submap,
543 Qnil,
544 character,
545 notreal);
547 if (!notreal)
549 AppendMenu (hmenu,MF_POPUP,
550 (UINT)new_hmenu,
551 (char *)XSTRING (item_string)->data);
561 /* Process now any submenus which want to be panes at this level. */
562 while (!NILP (pending_maps))
564 Lisp_Object elt, eltcdr, string;
565 elt = Fcar (pending_maps);
566 eltcdr = XCONS (elt)->cdr;
567 string = XCONS (eltcdr)->car;
568 /* We no longer discard the @ from the beginning of the string here.
569 Instead, we do this in win32menu_show. */
571 HMENU new_hmenu = single_keymap_panes (lpmm,
572 Fcar (elt),
573 string,
574 XCONS (eltcdr)->cdr, notreal);
576 if (!notreal)
578 AppendMenu (hmenu, MF_POPUP,
579 (UINT)new_hmenu,
580 (char *) XSTRING (string)->data);
584 pending_maps = Fcdr (pending_maps);
587 return (hmenu);
590 /* Push all the panes and items of a menu described by the
591 alist-of-alists MENU.
592 This handles old-fashioned calls to x-popup-menu. */
594 static HMENU
595 list_of_panes (lpmm, menu)
596 menu_map * lpmm;
597 Lisp_Object menu;
599 Lisp_Object tail;
600 HMENU hmenu;
602 hmenu = CreateMenu ();
603 if (hmenu == NULL) return NULL;
605 // init_menu_items (lpmm);
607 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
609 Lisp_Object elt, pane_name, pane_data;
610 HMENU new_hmenu;
612 elt = Fcar (tail);
613 pane_name = Fcar (elt);
614 CHECK_STRING (pane_name, 0);
615 pane_data = Fcdr (elt);
616 CHECK_CONS (pane_data, 0);
618 new_hmenu = list_of_items (lpmm, pane_data);
619 if (new_hmenu == NULL) goto error;
621 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
622 (char *) XSTRING (pane_name)->data);
625 return (hmenu);
627 error:
628 DestroyMenu (hmenu);
630 return (NULL);
633 /* Push the items in a single pane defined by the alist PANE. */
635 static HMENU
636 list_of_items (lpmm, pane)
637 menu_map * lpmm;
638 Lisp_Object pane;
640 Lisp_Object tail, item, item1;
641 HMENU hmenu;
643 hmenu = CreateMenu ();
644 if (hmenu == NULL) return NULL;
646 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
648 item = Fcar (tail);
649 if (STRINGP (item))
650 add_menu_item (lpmm, hmenu, item, Qnil, Qnil);
651 else if (NILP (item))
652 add_left_right_boundary ();
653 else
655 CHECK_CONS (item, 0);
656 item1 = Fcar (item);
657 CHECK_STRING (item1, 1);
658 add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item));
662 return (hmenu);
666 HMENU
667 create_menu_items (lpmm, menu, notreal)
668 menu_map * lpmm;
669 Lisp_Object menu;
670 int notreal;
672 Lisp_Object title;
673 Lisp_Object keymap, tem;
674 HMENU hmenu;
676 title = Qnil;
678 /* Decode the menu items from what was specified. */
680 keymap = Fkeymapp (menu);
681 tem = Qnil;
682 if (XTYPE (menu) == Lisp_Cons)
683 tem = Fkeymapp (Fcar (menu));
685 if (!NILP (keymap))
687 /* We were given a keymap. Extract menu info from the keymap. */
688 Lisp_Object prompt;
689 keymap = get_keymap (menu);
691 /* Extract the detailed info to make one pane. */
692 hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
694 #if 0
695 /* Search for a string appearing directly as an element of the keymap.
696 That string is the title of the menu. */
697 prompt = map_prompt (keymap);
699 /* Make that be the pane title of the first pane. */
700 if (!NILP (prompt) && menu_items_n_panes >= 0)
701 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
702 #endif
704 else if (!NILP (tem))
706 /* We were given a list of keymaps. */
707 int nmaps = XFASTINT (Flength (menu));
708 Lisp_Object *maps
709 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
710 int i;
712 title = Qnil;
714 /* The first keymap that has a prompt string
715 supplies the menu title. */
716 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
718 Lisp_Object prompt;
720 maps[i++] = keymap = get_keymap (Fcar (tem));
721 #if 0
722 prompt = map_prompt (keymap);
723 if (NILP (title) && !NILP (prompt))
724 title = prompt;
725 #endif
728 /* Extract the detailed info to make one pane. */
729 hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
731 #if 0
732 /* Make the title be the pane title of the first pane. */
733 if (!NILP (title) && menu_items_n_panes >= 0)
734 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
735 #endif
737 else
739 /* We were given an old-fashioned menu. */
740 title = Fcar (menu);
741 CHECK_STRING (title, 1);
743 hmenu = list_of_panes (lpmm, Fcdr (menu));
746 return (hmenu);
749 /* This is a recursive subroutine of keymap_panes.
750 It handles one keymap, KEYMAP.
751 The other arguments are passed along
752 or point to local variables of the previous function.
753 If NOTREAL is nonzero,
754 don't bother really computing whether an item is enabled. */
756 Lisp_Object
757 get_single_keymap_event (keymap, lpnum)
758 Lisp_Object keymap;
759 int * lpnum;
761 Lisp_Object pending_maps;
762 Lisp_Object tail, item, item1, item_string, table;
763 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
765 pending_maps = Qnil;
767 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
769 /* Look at each key binding, and if it has a menu string,
770 make a menu item from it. */
772 item = XCONS (tail)->car;
774 if (XTYPE (item) == Lisp_Cons)
776 item1 = XCONS (item)->cdr;
778 if (CONSP (item1))
780 item_string = XCONS (item1)->car;
781 if (XTYPE (item_string) == Lisp_String)
783 /* This is the real definition--the function to run. */
785 Lisp_Object def;
787 /* These are the saved equivalent keyboard key sequence
788 and its key-description. */
790 Lisp_Object descrip;
791 Lisp_Object tem, enabled;
793 /* GCPRO because ...enabled_p will call eval
794 and ..._equiv_key may autoload something.
795 Protecting KEYMAP preserves everything we use;
796 aside from that, must protect whatever might be
797 a string. Since there's no GCPRO5, we refetch
798 item_string instead of protecting it. */
800 descrip = def = Qnil;
801 GCPRO3 (keymap, pending_maps, def);
803 def = menu_item_equiv_key (item_string, item1, &descrip);
805 UNGCPRO;
807 item_string = XCONS (item1)->car;
809 tem = Fkeymapp (def);
810 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
812 pending_maps = Fcons (Fcons (def,
813 Fcons (item_string,
814 XCONS (item)->car)),
815 pending_maps);
817 else
819 Lisp_Object submap;
821 GCPRO4 (keymap, pending_maps, item, item_string);
823 submap = get_keymap_1 (def, 0, 1);
825 UNGCPRO;
827 if (NILP (submap))
829 if (--(*lpnum) == 0)
831 return (Fcons (XCONS (item)->car, Qnil));
834 else
835 /* Display a submenu. */
837 Lisp_Object event = get_single_keymap_event (submap,
838 lpnum);
840 if (*lpnum <= 0)
842 if (!NILP (XCONS (item)->car))
843 event = Fcons (XCONS (item)->car, event);
845 return (event);
852 else if (VECTORP (item))
854 /* Loop over the char values represented in the vector. */
855 int len = XVECTOR (item)->size;
856 int c;
857 for (c = 0; c < len; c++)
859 Lisp_Object character;
860 XSETFASTINT (character, c);
861 item1 = XVECTOR (item)->contents[c];
862 if (XTYPE (item1) == Lisp_Cons)
864 item_string = XCONS (item1)->car;
865 if (XTYPE (item_string) == Lisp_String)
867 Lisp_Object def;
869 /* These are the saved equivalent keyboard key sequence
870 and its key-description. */
871 Lisp_Object descrip;
872 Lisp_Object tem, enabled;
874 /* GCPRO because ...enabled_p will call eval
875 and ..._equiv_key may autoload something.
876 Protecting KEYMAP preserves everything we use;
877 aside from that, must protect whatever might be
878 a string. Since there's no GCPRO5, we refetch
879 item_string instead of protecting it. */
880 GCPRO4 (keymap, pending_maps, def, descrip);
881 descrip = def = Qnil;
883 def = menu_item_equiv_key (item_string, item1, &descrip);
885 UNGCPRO;
887 item_string = XCONS (item1)->car;
889 tem = Fkeymapp (def);
890 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
891 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
892 pending_maps);
893 else
895 Lisp_Object submap;
897 GCPRO4 (keymap, pending_maps, descrip, item_string);
899 submap = get_keymap_1 (def, 0, 1);
901 UNGCPRO;
903 if (NILP (submap))
905 if (--(*lpnum) == 0)
907 return (Fcons (character, Qnil));
910 else
911 /* Display a submenu. */
913 Lisp_Object event = get_single_keymap_event (submap,
914 lpnum);
916 if (*lpnum <= 0)
918 if (!NILP (character))
919 event = Fcons (character, event);
921 return (event);
931 /* Process now any submenus which want to be panes at this level. */
932 while (!NILP (pending_maps))
934 Lisp_Object elt, eltcdr, string;
935 elt = Fcar (pending_maps);
936 eltcdr = XCONS (elt)->cdr;
937 string = XCONS (eltcdr)->car;
938 /* We no longer discard the @ from the beginning of the string here.
939 Instead, we do this in win32menu_show. */
941 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
943 if (*lpnum <= 0)
945 if (!NILP (XCONS (eltcdr)->cdr))
946 event = Fcons (XCONS (eltcdr)->cdr, event);
948 return (event);
952 pending_maps = Fcdr (pending_maps);
955 return (Qnil);
958 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
959 and generate menu panes for them in menu_items.
960 If NOTREAL is nonzero,
961 don't bother really computing whether an item is enabled. */
963 static Lisp_Object
964 get_keymap_event (keymaps, nmaps, lpnum)
965 Lisp_Object *keymaps;
966 int nmaps;
967 int * lpnum;
969 int mapno;
970 Lisp_Object event = Qnil;
972 /* Loop over the given keymaps, making a pane for each map.
973 But don't make a pane that is empty--ignore that map instead.
974 P is the number of panes we have made so far. */
975 for (mapno = 0; mapno < nmaps; mapno++)
977 event = get_single_keymap_event (keymaps[mapno], lpnum);
979 if (*lpnum <= 0) break;
982 return (event);
985 static Lisp_Object
986 get_list_of_items_event (pane, lpnum)
987 Lisp_Object pane;
988 int * lpnum;
990 Lisp_Object tail, item, item1;
992 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
994 item = Fcar (tail);
995 if (STRINGP (item))
997 if (-- (*lpnum) == 0)
999 return (Qnil);
1002 else if (!NILP (item))
1004 if (--(*lpnum) == 0)
1006 CHECK_CONS (item, 0);
1007 return (Fcdr (item));
1012 return (Qnil);
1015 /* Push all the panes and items of a menu described by the
1016 alist-of-alists MENU.
1017 This handles old-fashioned calls to x-popup-menu. */
1019 static Lisp_Object
1020 get_list_of_panes_event (menu, lpnum)
1021 Lisp_Object menu;
1022 int * lpnum;
1024 Lisp_Object tail;
1026 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1028 Lisp_Object elt, pane_name, pane_data;
1029 Lisp_Object event;
1031 elt = Fcar (tail);
1032 pane_data = Fcdr (elt);
1033 CHECK_CONS (pane_data, 0);
1035 event = get_list_of_items_event (pane_data, lpnum);
1037 if (*lpnum <= 0)
1039 return (event);
1043 return (Qnil);
1046 Lisp_Object
1047 get_menu_event (menu, lpnum)
1048 Lisp_Object menu;
1049 int * lpnum;
1051 Lisp_Object keymap, tem;
1052 Lisp_Object event;
1054 /* Decode the menu items from what was specified. */
1056 keymap = Fkeymapp (menu);
1057 tem = Qnil;
1058 if (XTYPE (menu) == Lisp_Cons)
1059 tem = Fkeymapp (Fcar (menu));
1061 if (!NILP (keymap))
1063 keymap = get_keymap (menu);
1065 event = get_keymap_event (menu, 1, lpnum);
1067 else if (!NILP (tem))
1069 /* We were given a list of keymaps. */
1070 int nmaps = XFASTINT (Flength (menu));
1071 Lisp_Object *maps
1072 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1073 int i;
1075 /* The first keymap that has a prompt string
1076 supplies the menu title. */
1077 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1079 Lisp_Object prompt;
1081 maps[i++] = keymap = get_keymap (Fcar (tem));
1084 event = get_keymap_event (maps, nmaps, lpnum);
1086 else
1088 /* We were given an old-fashioned menu. */
1089 event = get_list_of_panes_event (Fcdr (menu), lpnum);
1092 return (event);
1095 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1096 "Pop up a deck-of-cards menu and return user's selection.\n\
1097 POSITION is a position specification. This is either a mouse button event\n\
1098 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1099 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1100 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1101 This controls the position of the center of the first line\n\
1102 in the first pane of the menu, not the top left of the menu as a whole.\n\
1103 If POSITION is t, it means to use the current mouse position.\n\
1105 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1106 The menu items come from key bindings that have a menu string as well as\n\
1107 a definition; actually, the \"definition\" in such a key binding looks like\n\
1108 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1109 the keymap as a top-level element.\n\n\
1110 You can also use a list of keymaps as MENU.\n\
1111 Then each keymap makes a separate pane.\n\
1112 When MENU is a keymap or a list of keymaps, the return value\n\
1113 is a list of events.\n\n\
1114 Alternatively, you can specify a menu of multiple panes\n\
1115 with a list of the form (TITLE PANE1 PANE2...),\n\
1116 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1117 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1118 but a string can appear as an item--that makes a nonselectable line\n\
1119 in the menu.\n\
1120 With this form of menu, the return value is VALUE from the chosen item.\n\
1122 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1123 cached information about equivalent key sequences.")
1124 (position, menu)
1125 Lisp_Object position, menu;
1127 int number_of_panes, panes;
1128 Lisp_Object keymap, tem;
1129 int xpos, ypos;
1130 Lisp_Object title;
1131 char *error_name;
1132 Lisp_Object selection;
1133 int i, j;
1134 FRAME_PTR f;
1135 Lisp_Object x, y, window;
1136 int keymaps = 0;
1137 int menubarp = 0;
1138 struct gcpro gcpro1;
1139 HMENU hmenu;
1140 menu_map mm;
1142 if (! NILP (position))
1144 /* Decode the first argument: find the window and the coordinates. */
1145 if (EQ (position, Qt))
1147 /* Use the mouse's current position. */
1148 FRAME_PTR new_f = 0;
1149 Lisp_Object bar_window;
1150 int part;
1151 unsigned long time;
1153 if (mouse_position_hook)
1154 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1155 if (new_f != 0)
1156 XSETFRAME (window, new_f);
1157 else
1159 window = selected_window;
1160 XSETFASTINT (x, 0);
1161 XSETFASTINT (y, 0);
1164 else
1166 tem = Fcar (position);
1167 if (CONSP (tem))
1169 window = Fcar (Fcdr (position));
1170 x = Fcar (tem);
1171 y = Fcar (Fcdr (tem));
1173 else
1175 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1176 window = Fcar (tem); /* POSN_WINDOW (tem) */
1177 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1178 x = Fcar (tem);
1179 y = Fcdr (tem);
1181 /* Determine whether this menu is handling a menu bar click. */
1182 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1183 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1184 menubarp = 1;
1188 CHECK_NUMBER (x, 0);
1189 CHECK_NUMBER (y, 0);
1191 /* Decode where to put the menu. */
1193 if (FRAMEP (window))
1195 f = XFRAME (window);
1197 xpos = 0;
1198 ypos = 0;
1200 else if (WINDOWP (window))
1202 CHECK_LIVE_WINDOW (window, 0);
1203 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1205 xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left);
1206 ypos = (f->output_data.win32->line_height * XWINDOW (window)->top);
1208 else
1209 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1210 but I don't want to make one now. */
1211 CHECK_WINDOW (window, 0);
1213 xpos += XINT (x);
1214 ypos += XINT (y);
1217 title = Qnil;
1218 GCPRO1 (title);
1220 discard_menu_items (&mm);
1221 hmenu = create_menu_items (&mm, menu, NILP (position));
1223 if (NILP (position))
1225 discard_menu_items (&mm);
1226 UNGCPRO;
1227 return Qnil;
1230 /* Display them in a menu. */
1231 BLOCK_INPUT;
1233 selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
1235 UNBLOCK_INPUT;
1237 discard_menu_items (&mm);
1238 DestroyMenu (hmenu);
1240 UNGCPRO;
1242 if (error_name) error (error_name);
1243 return selection;
1246 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1247 "Pop up a dialog box and return user's selection.\n\
1248 POSITION specifies which frame to use.\n\
1249 This is normally a mouse button event or a window or frame.\n\
1250 If POSITION is t, it means to use the frame the mouse is on.\n\
1251 The dialog box appears in the middle of the specified frame.\n\
1253 CONTENTS specifies the alternatives to display in the dialog box.\n\
1254 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1255 Each ITEM is a cons cell (STRING . VALUE).\n\
1256 The return value is VALUE from the chosen item.\n\n\
1257 An ITEM may also be just a string--that makes a nonselectable item.\n\
1258 An ITEM may also be nil--that means to put all preceding items\n\
1259 on the left of the dialog box and all following items on the right.\n\
1260 \(By default, approximately half appear on each side.)")
1261 (position, contents)
1262 Lisp_Object position, contents;
1264 FRAME_PTR f;
1265 Lisp_Object window;
1267 /* Decode the first argument: find the window or frame to use. */
1268 if (EQ (position, Qt))
1270 /* Decode the first argument: find the window and the coordinates. */
1271 if (EQ (position, Qt))
1272 window = selected_window;
1274 else if (CONSP (position))
1276 Lisp_Object tem;
1277 tem = Fcar (position);
1278 if (XTYPE (tem) == Lisp_Cons)
1279 window = Fcar (Fcdr (position));
1280 else
1282 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1283 window = Fcar (tem); /* POSN_WINDOW (tem) */
1286 else if (WINDOWP (position) || FRAMEP (position))
1287 window = position;
1289 /* Decode where to put the menu. */
1291 if (FRAMEP (window))
1292 f = XFRAME (window);
1293 else if (WINDOWP (window))
1295 CHECK_LIVE_WINDOW (window, 0);
1296 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1298 else
1299 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1300 but I don't want to make one now. */
1301 CHECK_WINDOW (window, 0);
1303 #if 1
1304 /* Display a menu with these alternatives
1305 in the middle of frame F. */
1307 Lisp_Object x, y, frame, newpos;
1308 XSETFRAME (frame, f);
1309 XSETINT (x, x_pixel_width (f) / 2);
1310 XSETINT (y, x_pixel_height (f) / 2);
1311 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1313 return Fx_popup_menu (newpos,
1314 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1316 #else
1318 Lisp_Object title;
1319 char *error_name;
1320 Lisp_Object selection;
1322 /* Decode the dialog items from what was specified. */
1323 title = Fcar (contents);
1324 CHECK_STRING (title, 1);
1326 list_of_panes (Fcons (contents, Qnil));
1328 /* Display them in a dialog box. */
1329 BLOCK_INPUT;
1330 selection = win32_dialog_show (f, 0, 0, title, &error_name);
1331 UNBLOCK_INPUT;
1333 discard_menu_items ();
1335 if (error_name) error (error_name);
1336 return selection;
1338 #endif
1341 Lisp_Object
1342 get_frame_menubar_event (f, num)
1343 FRAME_PTR f;
1344 int num;
1346 Lisp_Object tail, items;
1347 int i;
1348 struct gcpro gcpro1;
1350 BLOCK_INPUT;
1352 GCPRO1 (items);
1354 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1355 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1357 for (i = 0; i < XVECTOR (items)->size; i += 3)
1359 Lisp_Object event;
1361 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1363 if (num <= 0)
1365 UNGCPRO;
1366 UNBLOCK_INPUT;
1367 return (Fcons (XVECTOR (items)->contents[i], event));
1371 UNGCPRO;
1372 UNBLOCK_INPUT;
1374 return (Qnil);
1377 void
1378 set_frame_menubar (f, first_time)
1379 FRAME_PTR f;
1380 int first_time;
1382 Lisp_Object tail, items;
1383 HMENU hmenu;
1384 int i;
1385 struct gcpro gcpro1;
1386 menu_map mm;
1388 BLOCK_INPUT;
1390 GCPRO1 (items);
1392 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1393 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1395 hmenu = CreateMenu ();
1397 if (!hmenu) goto error;
1399 discard_menu_items (&mm);
1401 for (i = 0; i < XVECTOR (items)->size; i += 3)
1403 Lisp_Object string;
1404 int keymaps;
1405 CHAR *error;
1406 HMENU new_hmenu;
1408 string = XVECTOR (items)->contents[i + 1];
1409 if (NILP (string))
1410 break;
1412 new_hmenu = create_menu_items (&mm,
1413 XVECTOR (items)->contents[i + 2],
1416 if (!new_hmenu)
1417 continue;
1419 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1420 (char *) XSTRING (string)->data);
1424 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1425 SetMenu (FRAME_WIN32_WINDOW (f), hmenu);
1426 DestroyMenu (old);
1429 error:
1430 UNGCPRO;
1431 UNBLOCK_INPUT;
1434 void
1435 free_frame_menubar (f)
1436 FRAME_PTR f;
1438 BLOCK_INPUT;
1441 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1442 SetMenu (FRAME_WIN32_WINDOW (f), NULL);
1443 DestroyMenu (old);
1446 UNBLOCK_INPUT;
1448 /* Called from Fwin32_create_frame to create the initial menubar of a frame
1449 before it is mapped, so that the window is mapped with the menubar already
1450 there instead of us tacking it on later and thrashing the window after it
1451 is visible. */
1452 void
1453 initialize_frame_menubar (f)
1454 FRAME_PTR f;
1456 set_frame_menubar (f, 1);
1459 #if 0
1460 /* If the mouse has moved to another menu bar item,
1461 return 1 and unread a button press event for that item.
1462 Otherwise return 0. */
1464 static int
1465 check_mouse_other_menu_bar (f)
1466 FRAME_PTR f;
1468 FRAME_PTR new_f;
1469 Lisp_Object bar_window;
1470 int part;
1471 Lisp_Object x, y;
1472 unsigned long time;
1474 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1476 if (f == new_f && other_menu_bar_item_p (f, x, y))
1478 unread_menu_bar_button (f, x);
1479 return 1;
1482 return 0;
1484 #endif
1487 #if 0
1488 static HMENU
1489 create_menu (keymaps, error)
1490 int keymaps;
1491 char **error;
1493 HMENU hmenu = NULL; /* the menu we are currently working on */
1494 HMENU first_hmenu = NULL;
1496 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1497 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1498 sizeof (Lisp_Object));
1499 int submenu_depth = 0;
1500 int i;
1502 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1504 *error = "Empty menu";
1505 return NULL;
1508 i = 0;
1510 /* Loop over all panes and items, filling in the tree. */
1512 while (i < menu_items_used)
1514 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1516 submenu_stack[submenu_depth++] = hmenu;
1517 i++;
1519 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1521 hmenu = submenu_stack[--submenu_depth];
1522 i++;
1524 #if 0
1525 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1526 && submenu_depth != 0)
1527 i += MENU_ITEMS_PANE_LENGTH;
1528 #endif
1529 /* Ignore a nil in the item list.
1530 It's meaningful only for dialog boxes. */
1531 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1532 i += 1;
1533 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1535 /* Create a new pane. */
1537 Lisp_Object pane_name;
1538 char *pane_string;
1540 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1541 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1543 if (!hmenu || strcmp (pane_string, ""))
1545 HMENU new_hmenu = CreateMenu ();
1547 if (!new_hmenu)
1549 *error = "Could not create menu pane";
1550 goto error;
1553 if (hmenu)
1555 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1558 hmenu = new_hmenu;
1560 if (!first_hmenu) first_hmenu = hmenu;
1562 i += MENU_ITEMS_PANE_LENGTH;
1564 else
1566 /* Create a new item within current pane. */
1568 Lisp_Object item_name, enable, descrip;
1569 UINT fuFlags;
1571 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1572 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1573 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1575 if (((char *) XSTRING (item_name)->data)[0] == 0
1576 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1577 fuFlags = MF_SEPARATOR;
1578 else if (NILP (enable) || !XUINT(enable))
1579 fuFlags = MF_STRING | MF_GRAYED;
1580 else
1581 fuFlags = MF_STRING;
1583 AppendMenu (hmenu,
1584 fuFlags,
1586 (char *) XSTRING (item_name)->data);
1588 // if (!NILP (descrip))
1589 // hmenu->key = (char *) XSTRING (descrip)->data;
1591 i += MENU_ITEMS_ITEM_LENGTH;
1595 return (first_hmenu);
1597 error:
1598 if (first_hmenu) DestroyMenu (first_hmenu);
1599 return (NULL);
1602 #endif
1604 /* win32menu_show actually displays a menu using the panes and items in
1605 menu_items and returns the value selected from it.
1606 There are two versions of win32menu_show, one for Xt and one for Xlib.
1607 Both assume input is blocked by the caller. */
1609 /* F is the frame the menu is for.
1610 X and Y are the frame-relative specified position,
1611 relative to the inside upper left corner of the frame F.
1612 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1613 KEYMAPS is 1 if this menu was specified with keymaps;
1614 in that case, we return a list containing the chosen item's value
1615 and perhaps also the pane's prefix.
1616 TITLE is the specified menu title.
1617 ERROR is a place to store an error message string in case of failure.
1618 (We return nil on failure, but the value doesn't actually matter.) */
1621 static Lisp_Object
1622 win32menu_show (f, x, y, menu, hmenu, error)
1623 FRAME_PTR f;
1624 int x;
1625 int y;
1626 Lisp_Object menu;
1627 HMENU hmenu;
1628 char **error;
1630 int i , menu_selection;
1631 POINT pos;
1633 *error = NULL;
1635 if (!hmenu)
1637 *error = "Empty menu";
1638 return Qnil;
1641 pos.x = x;
1642 pos.y = y;
1644 /* Offset the coordinates to root-relative. */
1645 ClientToScreen (FRAME_WIN32_WINDOW (f), &pos);
1647 #if 0
1648 /* If the mouse moves out of the menu before we show the menu,
1649 don't show it at all. */
1650 if (check_mouse_other_menu_bar (f))
1652 DestroyMenu (hmenu);
1653 return Qnil;
1655 #endif
1657 /* Display the menu. */
1658 menu_selection = TrackPopupMenu (hmenu,
1659 0x10,
1660 pos.x, pos.y,
1662 FRAME_WIN32_WINDOW (f),
1663 NULL);
1664 if (menu_selection == -1)
1666 *error = "Invalid menu specification";
1667 return Qnil;
1670 /* Find the selected item, and its pane, to return
1671 the proper value. */
1673 #if 1
1674 if (menu_selection > 0)
1676 return get_menu_event (menu, menu_selection);
1678 #else
1679 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1681 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1683 #endif
1685 return Qnil;
1688 #if 0
1689 static char * button_names [] =
1691 "button1", "button2", "button3", "button4", "button5",
1692 "button6", "button7", "button8", "button9", "button10"
1695 static Lisp_Object
1696 win32_dialog_show (f, menubarp, keymaps, title, error)
1697 FRAME_PTR f;
1698 int menubarp;
1699 int keymaps;
1700 Lisp_Object title;
1701 char **error;
1703 int i, nb_buttons=0;
1704 HMENU hmenu;
1705 char dialog_name[6];
1707 /* Number of elements seen so far, before boundary. */
1708 int left_count = 0;
1709 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1710 int boundary_seen = 0;
1712 *error = NULL;
1714 if (menu_items_n_panes > 1)
1716 *error = "Multiple panes in dialog box";
1717 return Qnil;
1720 /* Create a tree of widget_value objects
1721 representing the text label and buttons. */
1723 Lisp_Object pane_name, prefix;
1724 char *pane_string;
1725 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1726 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1727 pane_string = (NILP (pane_name)
1728 ? "" : (char *) XSTRING (pane_name)->data);
1729 prev_wv = malloc_widget_value ();
1730 prev_wv->value = pane_string;
1731 if (keymaps && !NILP (prefix))
1732 prev_wv->name++;
1733 prev_wv->enabled = 1;
1734 prev_wv->name = "message";
1735 first_wv = prev_wv;
1737 /* Loop over all panes and items, filling in the tree. */
1738 i = MENU_ITEMS_PANE_LENGTH;
1739 while (i < menu_items_used)
1742 /* Create a new item within current pane. */
1743 Lisp_Object item_name, enable, descrip;
1744 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1745 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1746 descrip
1747 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1749 if (NILP (item_name))
1751 free_menubar_widget_value_tree (first_wv);
1752 *error = "Submenu in dialog items";
1753 return Qnil;
1755 if (EQ (item_name, Qquote))
1757 /* This is the boundary between left-side elts
1758 and right-side elts. Stop incrementing right_count. */
1759 boundary_seen = 1;
1760 i++;
1761 continue;
1763 if (nb_buttons >= 10)
1765 free_menubar_widget_value_tree (first_wv);
1766 *error = "Too many dialog items";
1767 return Qnil;
1770 wv = malloc_widget_value ();
1771 prev_wv->next = wv;
1772 wv->name = (char *) button_names[nb_buttons];
1773 if (!NILP (descrip))
1774 wv->key = (char *) XSTRING (descrip)->data;
1775 wv->value = (char *) XSTRING (item_name)->data;
1776 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1777 wv->enabled = !NILP (enable);
1778 prev_wv = wv;
1780 if (! boundary_seen)
1781 left_count++;
1783 nb_buttons++;
1784 i += MENU_ITEMS_ITEM_LENGTH;
1787 /* If the boundary was not specified,
1788 by default put half on the left and half on the right. */
1789 if (! boundary_seen)
1790 left_count = nb_buttons - nb_buttons / 2;
1792 wv = malloc_widget_value ();
1793 wv->name = dialog_name;
1795 /* Dialog boxes use a really stupid name encoding
1796 which specifies how many buttons to use
1797 and how many buttons are on the right.
1798 The Q means something also. */
1799 dialog_name[0] = 'Q';
1800 dialog_name[1] = '0' + nb_buttons;
1801 dialog_name[2] = 'B';
1802 dialog_name[3] = 'R';
1803 /* Number of buttons to put on the right. */
1804 dialog_name[4] = '0' + nb_buttons - left_count;
1805 dialog_name[5] = 0;
1806 wv->contents = first_wv;
1807 first_wv = wv;
1810 /* Actually create the dialog. */
1811 dialog_id = ++popup_id_tick;
1812 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1813 f->output_data.win32->widget, 1, 0,
1814 dialog_selection_callback, 0);
1815 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
1816 lw_modify_all_widgets (dialog_id, first_wv, True);
1817 #endif
1818 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1819 /* Free the widget_value objects we used to specify the contents. */
1820 free_menubar_widget_value_tree (first_wv);
1822 /* No selection has been chosen yet. */
1823 menu_item_selection = 0;
1825 /* Display the menu. */
1826 lw_pop_up_all_widgets (dialog_id);
1828 /* Process events that apply to the menu. */
1829 while (1)
1831 XEvent event;
1833 XtAppNextEvent (Xt_app_con, &event);
1834 if (event.type == ButtonRelease)
1836 XtDispatchEvent (&event);
1837 break;
1839 else if (event.type == Expose)
1840 process_expose_from_menu (event);
1841 XtDispatchEvent (&event);
1842 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1844 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1846 if (queue_tmp != NULL)
1848 queue_tmp->event = event;
1849 queue_tmp->next = queue;
1850 queue = queue_tmp;
1854 pop_down:
1856 /* State that no mouse buttons are now held.
1857 That is not necessarily true, but the fiction leads to reasonable
1858 results, and it is a pain to ask which are actually held now
1859 or track this in the loop above. */
1860 win32_mouse_grabbed = 0;
1862 /* Unread any events that we got but did not handle. */
1863 while (queue != NULL)
1865 queue_tmp = queue;
1866 XPutBackEvent (XDISPLAY &queue_tmp->event);
1867 queue = queue_tmp->next;
1868 free ((char *)queue_tmp);
1869 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1870 interrupt_input_pending = 1;
1873 /* Find the selected item, and its pane, to return
1874 the proper value. */
1875 if (menu_item_selection != 0)
1877 Lisp_Object prefix;
1879 prefix = Qnil;
1880 i = 0;
1881 while (i < menu_items_used)
1883 Lisp_Object entry;
1885 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1887 prefix
1888 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1889 i += MENU_ITEMS_PANE_LENGTH;
1891 else
1893 entry
1894 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1895 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1897 if (keymaps != 0)
1899 entry = Fcons (entry, Qnil);
1900 if (!NILP (prefix))
1901 entry = Fcons (prefix, entry);
1903 return entry;
1905 i += MENU_ITEMS_ITEM_LENGTH;
1910 return Qnil;
1912 #endif
1914 syms_of_win32menu ()
1916 defsubr (&Sx_popup_menu);
1917 defsubr (&Sx_popup_dialog);