Initial revision
[bpt/emacs.git] / src / w32menu.c
CommitLineData
ee78dc32
GV
1/* X Communication module for terminals which understand the X protocol.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20/* Written by Kevin Gallo. */
21
22#include <signal.h>
23#include <config.h>
24
25#include <stdio.h>
26#include "lisp.h"
27#include "termhooks.h"
28#include "frame.h"
29#include "window.h"
30#include "keyboard.h"
31#include "blockinput.h"
32
33/* This may include sys/types.h, and that somehow loses
34 if this is not done before the other system files. */
35#include "w32term.h"
36
37/* Load sys/types.h if not already loaded.
38 In some systems loading it twice is suicidal. */
39#ifndef makedev
40#include <sys/types.h>
41#endif
42
43#include "dispextern.h"
44
45#define min(x, y) (((x) < (y)) ? (x) : (y))
46#define max(x, y) (((x) > (y)) ? (x) : (y))
47
48typedef struct menu_map
49{
50 Lisp_Object menu_items;
51 int menu_items_allocated;
52 int menu_items_used;
53} menu_map;
54
55extern Lisp_Object Qmenu_enable;
56extern Lisp_Object Qmenu_bar;
57
58static Lisp_Object win32_dialog_show ();
59static Lisp_Object win32menu_show ();
60
61static HMENU keymap_panes ();
62static HMENU single_keymap_panes ();
63static HMENU list_of_panes ();
64static HMENU list_of_items ();
65
66static HMENU create_menu_items ();
67
68/* Initialize the menu_items structure if we haven't already done so.
69 Also mark it as currently empty. */
70
71static void
72init_menu_items (lpmm)
73 menu_map * lpmm;
74{
75 if (NILP (lpmm->menu_items))
76 {
77 lpmm->menu_items_allocated = 60;
78 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
79 Qnil);
80 }
81
82 lpmm->menu_items_used = 0;
83}
84
85/* Call when finished using the data for the current menu
86 in menu_items. */
87
88static void
89discard_menu_items (lpmm)
90 menu_map * lpmm;
91{
92 lpmm->menu_items = Qnil;
93 lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
94}
95
96/* Make the menu_items vector twice as large. */
97
98static void
99grow_menu_items (lpmm)
100 menu_map * lpmm;
101{
102 Lisp_Object new;
103 int old_size = lpmm->menu_items_allocated;
104
105 lpmm->menu_items_allocated *= 2;
106 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
107 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
108 old_size * sizeof (Lisp_Object));
109
110 lpmm->menu_items = new;
111}
112
113/* Indicate boundary between left and right. */
114
115static void
116add_left_right_boundary (hmenu)
117 HMENU hmenu;
118{
119 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
120}
121
122/* Push one menu item into the current pane.
123 NAME is the string to display. ENABLE if non-nil means
124 this item can be selected. KEY is the key generated by
125 choosing this item. EQUIV is the textual description
126 of the keyboard equivalent for this item (or nil if none). */
127
128static void
129add_menu_item (lpmm, hmenu, name, enable, key)
130 menu_map * lpmm;
131 HMENU hmenu;
132 Lisp_Object name;
133 UINT enable;
134 Lisp_Object key;
135{
136 UINT fuFlags;
137
138 if (NILP (name)
139 || ((char *) XSTRING (name)->data)[0] == 0
140 || strcmp ((char *) XSTRING (name)->data, "--") == 0)
141 fuFlags = MF_SEPARATOR;
142 else if (enable)
143 fuFlags = MF_STRING;
144 else
145 fuFlags = MF_STRING | MF_GRAYED;
146
147 AppendMenu (hmenu,
148 fuFlags,
149 lpmm->menu_items_used + 1,
150 (fuFlags == MF_SEPARATOR)?NULL: (char *) XSTRING (name)->data);
151
152 lpmm->menu_items_used++;
153#if 0
154 if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
155 grow_menu_items (lpmm);
156
157 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
158 Lisp_Cons,
159 key);
160#endif
161}
162\f
163/* Figure out the current keyboard equivalent of a menu item ITEM1.
164 The item string for menu display should be ITEM_STRING.
165 Store the equivalent keyboard key sequence's
166 textual description into *DESCRIP_PTR.
167 Also cache them in the item itself.
168 Return the real definition to execute. */
169
170static Lisp_Object
171menu_item_equiv_key (item_string, item1, descrip_ptr)
172 Lisp_Object item_string;
173 Lisp_Object item1;
174 Lisp_Object *descrip_ptr;
175{
176 /* This is the real definition--the function to run. */
177 Lisp_Object def;
178 /* This is the sublist that records cached equiv key data
179 so we can save time. */
180 Lisp_Object cachelist;
181 /* These are the saved equivalent keyboard key sequence
182 and its key-description. */
183 Lisp_Object savedkey, descrip;
184 Lisp_Object def1;
185 int changed = 0;
186 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
187
188 /* If a help string follows the item string, skip it. */
189 if (CONSP (XCONS (item1)->cdr)
190 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
191 item1 = XCONS (item1)->cdr;
192
193 def = Fcdr (item1);
194
195 /* Get out the saved equivalent-keyboard-key info. */
196 cachelist = savedkey = descrip = Qnil;
197 if (CONSP (def) && CONSP (XCONS (def)->car)
198 && (NILP (XCONS (XCONS (def)->car)->car)
199 || VECTORP (XCONS (XCONS (def)->car)->car)))
200 {
201 cachelist = XCONS (def)->car;
202 def = XCONS (def)->cdr;
203 savedkey = XCONS (cachelist)->car;
204 descrip = XCONS (cachelist)->cdr;
205 }
206
207 GCPRO4 (def, def1, savedkey, descrip);
208
209 /* Is it still valid? */
210 def1 = Qnil;
211 if (!NILP (savedkey))
212 def1 = Fkey_binding (savedkey, Qnil);
213 /* If not, update it. */
214 if (! EQ (def1, def)
215 /* If the command is an alias for another
216 (such as easymenu.el and lmenu.el set it up),
217 check if the original command matches the cached command. */
218 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
219 && EQ (def1, XSYMBOL (def)->function))
220 /* If something had no key binding before, don't recheck it--
221 doing that takes too much time and makes menus too slow. */
222 && !(!NILP (cachelist) && NILP (savedkey)))
223 {
224 changed = 1;
225 descrip = Qnil;
226 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
227 /* If the command is an alias for another
228 (such as easymenu.el and lmenu.el set it up),
229 see if the original command name has equivalent keys. */
230 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
231 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
232 Qnil, Qt, Qnil);
233
234 if (VECTORP (savedkey)
235 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
236 savedkey = Qnil;
237 if (!NILP (savedkey))
238 {
239 descrip = Fkey_description (savedkey);
240 descrip = concat2 (make_string (" (", 3), descrip);
241 descrip = concat2 (descrip, make_string (")", 1));
242 }
243 }
244
245 /* Cache the data we just got in a sublist of the menu binding. */
246 if (NILP (cachelist))
247 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
248 else if (changed)
249 {
250 XCONS (cachelist)->car = savedkey;
251 XCONS (cachelist)->cdr = descrip;
252 }
253
254 UNGCPRO;
255 *descrip_ptr = descrip;
256 return def;
257}
258
259/* This is used as the handler when calling internal_condition_case_1. */
260
261static Lisp_Object
262menu_item_enabled_p_1 (arg)
263 Lisp_Object arg;
264{
265 return Qnil;
266}
267
268/* Return non-nil if the command DEF is enabled when used as a menu item.
269 This is based on looking for a menu-enable property.
270 If NOTREAL is set, don't bother really computing this. */
271
272static Lisp_Object
273menu_item_enabled_p (def, notreal)
274 Lisp_Object def;
275{
276 Lisp_Object enabled, tem;
277
278 enabled = Qt;
279 if (notreal)
280 return enabled;
281 if (XTYPE (def) == Lisp_Symbol)
282 {
283 /* No property, or nil, means enable.
284 Otherwise, enable if value is not nil. */
285 tem = Fget (def, Qmenu_enable);
286 if (!NILP (tem))
287 /* (condition-case nil (eval tem)
288 (error nil)) */
289 enabled = internal_condition_case_1 (Feval, tem, Qerror,
290 menu_item_enabled_p_1);
291 }
292 return enabled;
293}
294\f
295/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
296 and generate menu panes for them in menu_items.
297 If NOTREAL is nonzero,
298 don't bother really computing whether an item is enabled. */
299
300static HMENU
301keymap_panes (lpmm, keymaps, nmaps, notreal)
302 menu_map * lpmm;
303 Lisp_Object *keymaps;
304 int nmaps;
305 int notreal;
306{
307 int mapno;
308
309 // init_menu_items (lpmm);
310
311 if (nmaps > 1)
312 {
313 HMENU hmenu;
314
315 if (!notreal)
316 {
317 hmenu = CreateMenu ();
318
319 if (!hmenu) return (NULL);
320 }
321 else
322 {
323 hmenu = NULL;
324 }
325
326 /* Loop over the given keymaps, making a pane for each map.
327 But don't make a pane that is empty--ignore that map instead.
328 P is the number of panes we have made so far. */
329 for (mapno = 0; mapno < nmaps; mapno++)
330 {
331 HMENU new_hmenu;
332
333 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
334 Qnil, Qnil, notreal);
335
336 if (!notreal && new_hmenu)
337 {
338 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
339 }
340 }
341
342 return (hmenu);
343 }
344 else
345 {
346 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
347 }
348}
349
350/* This is a recursive subroutine of keymap_panes.
351 It handles one keymap, KEYMAP.
352 The other arguments are passed along
353 or point to local variables of the previous function.
354 If NOTREAL is nonzero,
355 don't bother really computing whether an item is enabled. */
356
357HMENU
358single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
359 menu_map * lpmm;
360 Lisp_Object keymap;
361 Lisp_Object pane_name;
362 Lisp_Object prefix;
363 int notreal;
364{
365 Lisp_Object pending_maps;
366 Lisp_Object tail, item, item1, item_string, table;
367 HMENU hmenu;
368 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
369
370 if (!notreal)
371 {
372 hmenu = CreateMenu ();
373 if (hmenu == NULL) return NULL;
374 }
375 else
376 {
377 hmenu = NULL;
378 }
379
380 pending_maps = Qnil;
381
382 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
383 {
384 /* Look at each key binding, and if it has a menu string,
385 make a menu item from it. */
386
387 item = XCONS (tail)->car;
388
389 if (CONSP (item))
390 {
391 item1 = XCONS (item)->cdr;
392
393 if (XTYPE (item1) == Lisp_Cons)
394 {
395 item_string = XCONS (item1)->car;
396 if (XTYPE (item_string) == Lisp_String)
397 {
398 /* This is the real definition--the function to run. */
399
400 Lisp_Object def;
401
402 /* These are the saved equivalent keyboard key sequence
403 and its key-description. */
404
405 Lisp_Object descrip;
406 Lisp_Object tem, enabled;
407
408 /* GCPRO because ...enabled_p will call eval
409 and ..._equiv_key may autoload something.
410 Protecting KEYMAP preserves everything we use;
411 aside from that, must protect whatever might be
412 a string. Since there's no GCPRO5, we refetch
413 item_string instead of protecting it. */
414
415 descrip = def = Qnil;
416 GCPRO4 (keymap, pending_maps, def, prefix);
417
418 def = menu_item_equiv_key (item_string, item1, &descrip);
419 enabled = menu_item_enabled_p (def, notreal);
420
421 UNGCPRO;
422
423 item_string = XCONS (item1)->car;
424
425 tem = Fkeymapp (def);
426 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
427 {
428 pending_maps = Fcons (Fcons (def,
429 Fcons (item_string,
430 XCONS (item)->car)),
431 pending_maps);
432 }
433 else
434 {
435 Lisp_Object submap;
436
437 GCPRO4 (keymap, pending_maps, item, item_string);
438
439 submap = get_keymap_1 (def, 0, 1);
440
441 UNGCPRO;
442
443 if (NILP (submap))
444 {
445 if (!notreal)
446 {
447 add_menu_item (lpmm,
448 hmenu,
449 item_string,
450 !NILP (enabled),
451 Fcons (XCONS (item)->car, prefix));
452 }
453 }
454 else
455 /* Display a submenu. */
456 {
457 HMENU new_hmenu = single_keymap_panes (lpmm,
458 submap,
459 item_string,
460 XCONS (item)->car,
461 notreal);
462
463 if (!notreal)
464 {
465 AppendMenu (hmenu, MF_POPUP,
466 (UINT)new_hmenu,
467 (char *) XSTRING (item_string)->data);
468 }
469 }
470 }
471 }
472 }
473 }
474 else if (VECTORP (item))
475 {
476 /* Loop over the char values represented in the vector. */
477 int len = XVECTOR (item)->size;
478 int c;
479 for (c = 0; c < len; c++)
480 {
481 Lisp_Object character;
482 XSETFASTINT (character, c);
483 item1 = XVECTOR (item)->contents[c];
484 if (CONSP (item1))
485 {
486 item_string = XCONS (item1)->car;
487 if (STRINGP (item_string))
488 {
489 Lisp_Object def;
490
491 /* These are the saved equivalent keyboard key sequence
492 and its key-description. */
493 Lisp_Object descrip;
494 Lisp_Object tem, enabled;
495
496 /* GCPRO because ...enabled_p will call eval
497 and ..._equiv_key may autoload something.
498 Protecting KEYMAP preserves everything we use;
499 aside from that, must protect whatever might be
500 a string. Since there's no GCPRO5, we refetch
501 item_string instead of protecting it. */
502 GCPRO4 (keymap, pending_maps, def, descrip);
503 descrip = def = Qnil;
504
505 def = menu_item_equiv_key (item_string, item1, &descrip);
506 enabled = menu_item_enabled_p (def, notreal);
507
508 UNGCPRO;
509
510 item_string = XCONS (item1)->car;
511
512 tem = Fkeymapp (def);
513 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
514 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
515 pending_maps);
516 else
517 {
518 Lisp_Object submap;
519
520 GCPRO4 (keymap, pending_maps, descrip, item_string);
521
522 submap = get_keymap_1 (def, 0, 1);
523
524 UNGCPRO;
525
526 if (NILP (submap))
527 {
528 if (!notreal)
529 {
530 add_menu_item (lpmm,
531 hmenu,
532 item_string,
533 !NILP (enabled),
534 character);
535 }
536 }
537 else
538 /* Display a submenu. */
539 {
540 HMENU new_hmenu = single_keymap_panes (lpmm,
541 submap,
542 Qnil,
543 character,
544 notreal);
545
546 if (!notreal)
547 {
548 AppendMenu (hmenu,MF_POPUP,
549 (UINT)new_hmenu,
550 (char *)XSTRING (item_string)->data);
551 }
552 }
553 }
554 }
555 }
556 }
557 }
558 }
559
560 /* Process now any submenus which want to be panes at this level. */
561 while (!NILP (pending_maps))
562 {
563 Lisp_Object elt, eltcdr, string;
564 elt = Fcar (pending_maps);
565 eltcdr = XCONS (elt)->cdr;
566 string = XCONS (eltcdr)->car;
567 /* We no longer discard the @ from the beginning of the string here.
568 Instead, we do this in win32menu_show. */
569 {
570 HMENU new_hmenu = single_keymap_panes (lpmm,
571 Fcar (elt),
572 string,
573 XCONS (eltcdr)->cdr, notreal);
574
575 if (!notreal)
576 {
577 AppendMenu (hmenu, MF_POPUP,
578 (UINT)new_hmenu,
579 (char *) XSTRING (string)->data);
580 }
581 }
582
583 pending_maps = Fcdr (pending_maps);
584 }
585
586 return (hmenu);
587}
588\f
589/* Push all the panes and items of a menu decsribed by the
590 alist-of-alists MENU.
591 This handles old-fashioned calls to x-popup-menu. */
592
593static HMENU
594list_of_panes (lpmm, menu)
595 menu_map * lpmm;
596 Lisp_Object menu;
597{
598 Lisp_Object tail;
599 HMENU hmenu;
600
601 hmenu = CreateMenu ();
602 if (hmenu == NULL) return NULL;
603
604 // init_menu_items (lpmm);
605
606 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
607 {
608 Lisp_Object elt, pane_name, pane_data;
609 HMENU new_hmenu;
610
611 elt = Fcar (tail);
612 pane_name = Fcar (elt);
613 CHECK_STRING (pane_name, 0);
614 pane_data = Fcdr (elt);
615 CHECK_CONS (pane_data, 0);
616
617 new_hmenu = list_of_items (lpmm, pane_data);
618 if (new_hmenu == NULL) goto error;
619
620 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
621 (char *) XSTRING (pane_name)->data);
622 }
623
624 return (hmenu);
625
626 error:
627 DestroyMenu (hmenu);
628
629 return (NULL);
630}
631
632/* Push the items in a single pane defined by the alist PANE. */
633
634static HMENU
635list_of_items (lpmm, pane)
636 menu_map * lpmm;
637 Lisp_Object pane;
638{
639 Lisp_Object tail, item, item1;
640 HMENU hmenu;
641
642 hmenu = CreateMenu ();
643 if (hmenu == NULL) return NULL;
644
645 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
646 {
647 item = Fcar (tail);
648 if (STRINGP (item))
649 add_menu_item (lpmm, hmenu, item, Qnil, Qnil);
650 else if (NILP (item))
651 add_left_right_boundary ();
652 else
653 {
654 CHECK_CONS (item, 0);
655 item1 = Fcar (item);
656 CHECK_STRING (item1, 1);
657 add_menu_item (lpmm, hmenu, item1, Qt, Fcdr (item));
658 }
659 }
660
661 return (hmenu);
662}
663\f
664
665HMENU
666create_menu_items (lpmm, menu, notreal)
667 menu_map * lpmm;
668 Lisp_Object menu;
669 int notreal;
670{
671 Lisp_Object title;
672 Lisp_Object keymap, tem;
673 HMENU hmenu;
674
675 title = Qnil;
676
677 /* Decode the menu items from what was specified. */
678
679 keymap = Fkeymapp (menu);
680 tem = Qnil;
681 if (XTYPE (menu) == Lisp_Cons)
682 tem = Fkeymapp (Fcar (menu));
683
684 if (!NILP (keymap))
685 {
686 /* We were given a keymap. Extract menu info from the keymap. */
687 Lisp_Object prompt;
688 keymap = get_keymap (menu);
689
690 /* Extract the detailed info to make one pane. */
691 hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
692
693#if 0
694 /* Search for a string appearing directly as an element of the keymap.
695 That string is the title of the menu. */
696 prompt = map_prompt (keymap);
697
698 /* Make that be the pane title of the first pane. */
699 if (!NILP (prompt) && menu_items_n_panes >= 0)
700 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
701#endif
702 }
703 else if (!NILP (tem))
704 {
705 /* We were given a list of keymaps. */
706 int nmaps = XFASTINT (Flength (menu));
707 Lisp_Object *maps
708 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
709 int i;
710
711 title = Qnil;
712
713 /* The first keymap that has a prompt string
714 supplies the menu title. */
715 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
716 {
717 Lisp_Object prompt;
718
719 maps[i++] = keymap = get_keymap (Fcar (tem));
720#if 0
721 prompt = map_prompt (keymap);
722 if (NILP (title) && !NILP (prompt))
723 title = prompt;
724#endif
725 }
726
727 /* Extract the detailed info to make one pane. */
728 hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
729
730#if 0
731 /* Make the title be the pane title of the first pane. */
732 if (!NILP (title) && menu_items_n_panes >= 0)
733 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
734#endif
735 }
736 else
737 {
738 /* We were given an old-fashioned menu. */
739 title = Fcar (menu);
740 CHECK_STRING (title, 1);
741
742 hmenu = list_of_panes (lpmm, Fcdr (menu));
743 }
744
745 return (hmenu);
746}
747
748/* This is a recursive subroutine of keymap_panes.
749 It handles one keymap, KEYMAP.
750 The other arguments are passed along
751 or point to local variables of the previous function.
752 If NOTREAL is nonzero,
753 don't bother really computing whether an item is enabled. */
754
755Lisp_Object
756get_single_keymap_event (keymap, lpnum)
757 Lisp_Object keymap;
758 int * lpnum;
759{
760 Lisp_Object pending_maps;
761 Lisp_Object tail, item, item1, item_string, table;
762 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
763
764 pending_maps = Qnil;
765
766 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
767 {
768 /* Look at each key binding, and if it has a menu string,
769 make a menu item from it. */
770
771 item = XCONS (tail)->car;
772
773 if (XTYPE (item) == Lisp_Cons)
774 {
775 item1 = XCONS (item)->cdr;
776
777 if (CONSP (item1))
778 {
779 item_string = XCONS (item1)->car;
780 if (XTYPE (item_string) == Lisp_String)
781 {
782 /* This is the real definition--the function to run. */
783
784 Lisp_Object def;
785
786 /* These are the saved equivalent keyboard key sequence
787 and its key-description. */
788
789 Lisp_Object descrip;
790 Lisp_Object tem, enabled;
791
792 /* GCPRO because ...enabled_p will call eval
793 and ..._equiv_key may autoload something.
794 Protecting KEYMAP preserves everything we use;
795 aside from that, must protect whatever might be
796 a string. Since there's no GCPRO5, we refetch
797 item_string instead of protecting it. */
798
799 descrip = def = Qnil;
800 GCPRO3 (keymap, pending_maps, def);
801
802 def = menu_item_equiv_key (item_string, item1, &descrip);
803
804 UNGCPRO;
805
806 item_string = XCONS (item1)->car;
807
808 tem = Fkeymapp (def);
809 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
810 {
811 pending_maps = Fcons (Fcons (def,
812 Fcons (item_string,
813 XCONS (item)->car)),
814 pending_maps);
815 }
816 else
817 {
818 Lisp_Object submap;
819
820 GCPRO4 (keymap, pending_maps, item, item_string);
821
822 submap = get_keymap_1 (def, 0, 1);
823
824 UNGCPRO;
825
826 if (NILP (submap))
827 {
828 if (--(*lpnum) == 0)
829 {
830 return (Fcons (XCONS (item)->car, Qnil));
831 }
832 }
833 else
834 /* Display a submenu. */
835 {
836 Lisp_Object event = get_single_keymap_event (submap,
837 lpnum);
838
839 if (*lpnum <= 0)
840 {
841 if (!NILP (XCONS (item)->car))
842 event = Fcons (XCONS (item)->car, event);
843
844 return (event);
845 }
846 }
847 }
848 }
849 }
850 }
851 else if (VECTORP (item))
852 {
853 /* Loop over the char values represented in the vector. */
854 int len = XVECTOR (item)->size;
855 int c;
856 for (c = 0; c < len; c++)
857 {
858 Lisp_Object character;
859 XSETFASTINT (character, c);
860 item1 = XVECTOR (item)->contents[c];
861 if (XTYPE (item1) == Lisp_Cons)
862 {
863 item_string = XCONS (item1)->car;
864 if (XTYPE (item_string) == Lisp_String)
865 {
866 Lisp_Object def;
867
868 /* These are the saved equivalent keyboard key sequence
869 and its key-description. */
870 Lisp_Object descrip;
871 Lisp_Object tem, enabled;
872
873 /* GCPRO because ...enabled_p will call eval
874 and ..._equiv_key may autoload something.
875 Protecting KEYMAP preserves everything we use;
876 aside from that, must protect whatever might be
877 a string. Since there's no GCPRO5, we refetch
878 item_string instead of protecting it. */
879 GCPRO4 (keymap, pending_maps, def, descrip);
880 descrip = def = Qnil;
881
882 def = menu_item_equiv_key (item_string, item1, &descrip);
883
884 UNGCPRO;
885
886 item_string = XCONS (item1)->car;
887
888 tem = Fkeymapp (def);
889 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
890 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
891 pending_maps);
892 else
893 {
894 Lisp_Object submap;
895
896 GCPRO4 (keymap, pending_maps, descrip, item_string);
897
898 submap = get_keymap_1 (def, 0, 1);
899
900 UNGCPRO;
901
902 if (NILP (submap))
903 {
904 if (--(*lpnum) == 0)
905 {
906 return (Fcons (character, Qnil));
907 }
908 }
909 else
910 /* Display a submenu. */
911 {
912 Lisp_Object event = get_single_keymap_event (submap,
913 lpnum);
914
915 if (*lpnum <= 0)
916 {
917 if (!NILP (character))
918 event = Fcons (character, event);
919
920 return (event);
921 }
922 }
923 }
924 }
925 }
926 }
927 }
928 }
929
930 /* Process now any submenus which want to be panes at this level. */
931 while (!NILP (pending_maps))
932 {
933 Lisp_Object elt, eltcdr, string;
934 elt = Fcar (pending_maps);
935 eltcdr = XCONS (elt)->cdr;
936 string = XCONS (eltcdr)->car;
937 /* We no longer discard the @ from the beginning of the string here.
938 Instead, we do this in win32menu_show. */
939 {
940 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
941
942 if (*lpnum <= 0)
943 {
944 if (!NILP (XCONS (eltcdr)->cdr))
945 event = Fcons (XCONS (eltcdr)->cdr, event);
946
947 return (event);
948 }
949 }
950
951 pending_maps = Fcdr (pending_maps);
952 }
953
954 return (Qnil);
955}
956
957/* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
958 and generate menu panes for them in menu_items.
959 If NOTREAL is nonzero,
960 don't bother really computing whether an item is enabled. */
961
962static Lisp_Object
963get_keymap_event (keymaps, nmaps, lpnum)
964 Lisp_Object *keymaps;
965 int nmaps;
966 int * lpnum;
967{
968 int mapno;
969 Lisp_Object event = Qnil;
970
971 /* Loop over the given keymaps, making a pane for each map.
972 But don't make a pane that is empty--ignore that map instead.
973 P is the number of panes we have made so far. */
974 for (mapno = 0; mapno < nmaps; mapno++)
975 {
976 event = get_single_keymap_event (keymaps[mapno], lpnum);
977
978 if (*lpnum <= 0) break;
979 }
980
981 return (event);
982}
983
984static Lisp_Object
985get_list_of_items_event (pane, lpnum)
986 Lisp_Object pane;
987 int * lpnum;
988{
989 Lisp_Object tail, item, item1;
990
991 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
992 {
993 item = Fcar (tail);
994 if (STRINGP (item))
995 {
996 if (-- (*lpnum) == 0)
997 {
998 return (Qnil);
999 }
1000 }
1001 else if (!NILP (item))
1002 {
1003 if (--(*lpnum) == 0)
1004 {
1005 CHECK_CONS (item, 0);
1006 return (Fcdr (item));
1007 }
1008 }
1009 }
1010
1011 return (Qnil);
1012}
1013
1014/* Push all the panes and items of a menu decsribed by the
1015 alist-of-alists MENU.
1016 This handles old-fashioned calls to x-popup-menu. */
1017
1018static Lisp_Object
1019get_list_of_panes_event (menu, lpnum)
1020 Lisp_Object menu;
1021 int * lpnum;
1022{
1023 Lisp_Object tail;
1024
1025 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1026 {
1027 Lisp_Object elt, pane_name, pane_data;
1028 Lisp_Object event;
1029
1030 elt = Fcar (tail);
1031 pane_data = Fcdr (elt);
1032 CHECK_CONS (pane_data, 0);
1033
1034 event = get_list_of_items_event (pane_data, lpnum);
1035
1036 if (*lpnum <= 0)
1037 {
1038 return (event);
1039 }
1040 }
1041
1042 return (Qnil);
1043}
1044
1045Lisp_Object
1046get_menu_event (menu, lpnum)
1047 Lisp_Object menu;
1048 int * lpnum;
1049{
1050 Lisp_Object keymap, tem;
1051 Lisp_Object event;
1052
1053 /* Decode the menu items from what was specified. */
1054
1055 keymap = Fkeymapp (menu);
1056 tem = Qnil;
1057 if (XTYPE (menu) == Lisp_Cons)
1058 tem = Fkeymapp (Fcar (menu));
1059
1060 if (!NILP (keymap))
1061 {
1062 keymap = get_keymap (menu);
1063
1064 event = get_keymap_event (menu, 1, lpnum);
1065 }
1066 else if (!NILP (tem))
1067 {
1068 /* We were given a list of keymaps. */
1069 int nmaps = XFASTINT (Flength (menu));
1070 Lisp_Object *maps
1071 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1072 int i;
1073
1074 /* The first keymap that has a prompt string
1075 supplies the menu title. */
1076 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1077 {
1078 Lisp_Object prompt;
1079
1080 maps[i++] = keymap = get_keymap (Fcar (tem));
1081 }
1082
1083 event = get_keymap_event (maps, nmaps, lpnum);
1084 }
1085 else
1086 {
1087 /* We were given an old-fashioned menu. */
1088 event = get_list_of_panes_event (Fcdr (menu), lpnum);
1089 }
1090
1091 return (event);
1092}
1093
1094DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1095 "Pop up a deck-of-cards menu and return user's selection.\n\
1096POSITION is a position specification. This is either a mouse button event\n\
1097or a list ((XOFFSET YOFFSET) WINDOW)\n\
1098where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1099corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1100This controls the position of the center of the first line\n\
1101in the first pane of the menu, not the top left of the menu as a whole.\n\
1102If POSITION is t, it means to use the current mouse position.\n\
1103\n\
1104MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1105The menu items come from key bindings that have a menu string as well as\n\
1106a definition; actually, the \"definition\" in such a key binding looks like\n\
1107\(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1108the keymap as a top-level element.\n\n\
1109You can also use a list of keymaps as MENU.\n\
1110 Then each keymap makes a separate pane.\n\
1111When MENU is a keymap or a list of keymaps, the return value\n\
1112is a list of events.\n\n\
1113Alternatively, you can specify a menu of multiple panes\n\
1114 with a list of the form (TITLE PANE1 PANE2...),\n\
1115where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1116Each ITEM is normally a cons cell (STRING . VALUE);\n\
1117but a string can appear as an item--that makes a nonselectable line\n\
1118in the menu.\n\
1119With this form of menu, the return value is VALUE from the chosen item.\n\
1120\n\
1121If POSITION is nil, don't display the menu at all, just precalculate the\n\
1122cached information about equivalent key sequences.")
1123 (position, menu)
1124 Lisp_Object position, menu;
1125{
1126 int number_of_panes, panes;
1127 Lisp_Object keymap, tem;
1128 int xpos, ypos;
1129 Lisp_Object title;
1130 char *error_name;
1131 Lisp_Object selection;
1132 int i, j;
1133 FRAME_PTR f;
1134 Lisp_Object x, y, window;
1135 int keymaps = 0;
1136 int menubarp = 0;
1137 struct gcpro gcpro1;
1138 HMENU hmenu;
1139 menu_map mm;
1140
1141 if (! NILP (position))
1142 {
1143 /* Decode the first argument: find the window and the coordinates. */
1144 if (EQ (position, Qt))
1145 {
1146 /* Use the mouse's current position. */
1147 FRAME_PTR new_f = 0;
1148 Lisp_Object bar_window;
1149 int part;
1150 unsigned long time;
1151
1152 if (mouse_position_hook)
1153 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1154 if (new_f != 0)
1155 XSETFRAME (window, new_f);
1156 else
1157 {
1158 window = selected_window;
1159 XSETFASTINT (x, 0);
1160 XSETFASTINT (y, 0);
1161 }
1162 }
1163 else
1164 {
1165 tem = Fcar (position);
1166 if (CONSP (tem))
1167 {
1168 window = Fcar (Fcdr (position));
1169 x = Fcar (tem);
1170 y = Fcar (Fcdr (tem));
1171 }
1172 else
1173 {
1174 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1175 window = Fcar (tem); /* POSN_WINDOW (tem) */
1176 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1177 x = Fcar (tem);
1178 y = Fcdr (tem);
1179
1180 /* Determine whether this menu is handling a menu bar click. */
1181 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1182 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1183 menubarp = 1;
1184 }
1185 }
1186
1187 CHECK_NUMBER (x, 0);
1188 CHECK_NUMBER (y, 0);
1189
1190 /* Decode where to put the menu. */
1191
1192 if (FRAMEP (window))
1193 {
1194 f = XFRAME (window);
1195
1196 xpos = 0;
1197 ypos = 0;
1198 }
1199 else if (WINDOWP (window))
1200 {
1201 CHECK_LIVE_WINDOW (window, 0);
1202 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1203
1204 xpos = (FONT_WIDTH (f->output_data.win32->font) * XWINDOW (window)->left);
1205 ypos = (f->output_data.win32->line_height * XWINDOW (window)->top);
1206 }
1207 else
1208 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1209 but I don't want to make one now. */
1210 CHECK_WINDOW (window, 0);
1211
1212 xpos += XINT (x);
1213 ypos += XINT (y);
1214 }
1215
1216 title = Qnil;
1217 GCPRO1 (title);
1218
1219 discard_menu_items (&mm);
1220 hmenu = create_menu_items (&mm, menu, NILP (position));
1221
1222 if (NILP (position))
1223 {
1224 discard_menu_items (&mm);
1225 UNGCPRO;
1226 return Qnil;
1227 }
1228
1229 /* Display them in a menu. */
1230 BLOCK_INPUT;
1231
1232 selection = win32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
1233
1234 UNBLOCK_INPUT;
1235
1236 discard_menu_items (&mm);
1237 DestroyMenu (hmenu);
1238
1239 UNGCPRO;
1240
1241 if (error_name) error (error_name);
1242 return selection;
1243}
1244
1245DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1246 "Pop up a dialog box and return user's selection.\n\
1247POSITION specifies which frame to use.\n\
1248This is normally a mouse button event or a window or frame.\n\
1249If POSITION is t, it means to use the frame the mouse is on.\n\
1250The dialog box appears in the middle of the specified frame.\n\
1251\n\
1252CONTENTS specifies the alternatives to display in the dialog box.\n\
1253It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1254Each ITEM is a cons cell (STRING . VALUE).\n\
1255The return value is VALUE from the chosen item.\n\n\
1256An ITEM may also be just a string--that makes a nonselectable item.\n\
1257An ITEM may also be nil--that means to put all preceding items\n\
1258on the left of the dialog box and all following items on the right.\n\
1259\(By default, approximately half appear on each side.)")
1260 (position, contents)
1261 Lisp_Object position, contents;
1262{
1263 FRAME_PTR f;
1264 Lisp_Object window;
1265
1266 /* Decode the first argument: find the window or frame to use. */
1267 if (EQ (position, Qt))
1268 {
1269 /* Decode the first argument: find the window and the coordinates. */
1270 if (EQ (position, Qt))
1271 window = selected_window;
1272 }
1273 else if (CONSP (position))
1274 {
1275 Lisp_Object tem;
1276 tem = Fcar (position);
1277 if (XTYPE (tem) == Lisp_Cons)
1278 window = Fcar (Fcdr (position));
1279 else
1280 {
1281 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1282 window = Fcar (tem); /* POSN_WINDOW (tem) */
1283 }
1284 }
1285 else if (WINDOWP (position) || FRAMEP (position))
1286 window = position;
1287
1288 /* Decode where to put the menu. */
1289
1290 if (FRAMEP (window))
1291 f = XFRAME (window);
1292 else if (WINDOWP (window))
1293 {
1294 CHECK_LIVE_WINDOW (window, 0);
1295 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1296 }
1297 else
1298 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1299 but I don't want to make one now. */
1300 CHECK_WINDOW (window, 0);
1301
1302#if 1
1303 /* Display a menu with these alternatives
1304 in the middle of frame F. */
1305 {
1306 Lisp_Object x, y, frame, newpos;
1307 XSETFRAME (frame, f);
1308 XSETINT (x, x_pixel_width (f) / 2);
1309 XSETINT (y, x_pixel_height (f) / 2);
1310 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1311
1312 return Fx_popup_menu (newpos,
1313 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1314 }
1315#else
1316 {
1317 Lisp_Object title;
1318 char *error_name;
1319 Lisp_Object selection;
1320
1321 /* Decode the dialog items from what was specified. */
1322 title = Fcar (contents);
1323 CHECK_STRING (title, 1);
1324
1325 list_of_panes (Fcons (contents, Qnil));
1326
1327 /* Display them in a dialog box. */
1328 BLOCK_INPUT;
1329 selection = win32_dialog_show (f, 0, 0, title, &error_name);
1330 UNBLOCK_INPUT;
1331
1332 discard_menu_items ();
1333
1334 if (error_name) error (error_name);
1335 return selection;
1336 }
1337#endif
1338}
1339
1340Lisp_Object
1341get_frame_menubar_event (f, num)
1342 FRAME_PTR f;
1343 int num;
1344{
1345 Lisp_Object tail, items;
1346 int i;
1347 struct gcpro gcpro1;
1348
1349 BLOCK_INPUT;
1350
1351 GCPRO1 (items);
1352
1353 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1354 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1355
1356 for (i = 0; i < XVECTOR (items)->size; i += 3)
1357 {
1358 Lisp_Object event;
1359
1360 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1361
1362 if (num <= 0)
1363 {
1364 UNGCPRO;
1365 UNBLOCK_INPUT;
1366 return (Fcons (XVECTOR (items)->contents[i], event));
1367 }
1368 }
1369
1370 UNGCPRO;
1371 UNBLOCK_INPUT;
1372
1373 return (Qnil);
1374}
1375
1376void
1377set_frame_menubar (f, first_time)
1378 FRAME_PTR f;
1379 int first_time;
1380{
1381 Lisp_Object tail, items;
1382 HMENU hmenu;
1383 int i;
1384 struct gcpro gcpro1;
1385 menu_map mm;
1386
1387 BLOCK_INPUT;
1388
1389 GCPRO1 (items);
1390
1391 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1392 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1393
1394 hmenu = CreateMenu ();
1395
1396 if (!hmenu) goto error;
1397
1398 discard_menu_items (&mm);
1399
1400 for (i = 0; i < XVECTOR (items)->size; i += 3)
1401 {
1402 Lisp_Object string;
1403 int keymaps;
1404 CHAR *error;
1405 HMENU new_hmenu;
1406
1407 string = XVECTOR (items)->contents[i + 1];
1408 if (NILP (string))
1409 break;
1410
1411 new_hmenu = create_menu_items (&mm,
1412 XVECTOR (items)->contents[i + 2],
1413 0);
1414
1415 if (!new_hmenu)
1416 continue;
1417
1418 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1419 (char *) XSTRING (string)->data);
1420 }
1421
1422 {
1423 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1424 SetMenu (FRAME_WIN32_WINDOW (f), hmenu);
1425 DestroyMenu (old);
1426 }
1427
1428 error:
1429 UNGCPRO;
1430 UNBLOCK_INPUT;
1431}
1432
1433void
1434free_frame_menubar (f)
1435 FRAME_PTR f;
1436{
1437 BLOCK_INPUT;
1438
1439 {
1440 HMENU old = GetMenu (FRAME_WIN32_WINDOW (f));
1441 SetMenu (FRAME_WIN32_WINDOW (f), NULL);
1442 DestroyMenu (old);
1443 }
1444
1445 UNBLOCK_INPUT;
1446}
1447/* Called from Fwin32_create_frame to create the inital menubar of a frame
1448 before it is mapped, so that the window is mapped with the menubar already
1449 there instead of us tacking it on later and thrashing the window after it
1450 is visible. */
1451void
1452initialize_frame_menubar (f)
1453 FRAME_PTR f;
1454{
1455 set_frame_menubar (f, 1);
1456}
1457\f
1458#if 0
1459/* If the mouse has moved to another menu bar item,
1460 return 1 and unread a button press event for that item.
1461 Otherwise return 0. */
1462
1463static int
1464check_mouse_other_menu_bar (f)
1465 FRAME_PTR f;
1466{
1467 FRAME_PTR new_f;
1468 Lisp_Object bar_window;
1469 int part;
1470 Lisp_Object x, y;
1471 unsigned long time;
1472
1473 (*mouse_position_hook) (&new_f, &bar_window, &part, &x, &y, &time);
1474
1475 if (f == new_f && other_menu_bar_item_p (f, x, y))
1476 {
1477 unread_menu_bar_button (f, x);
1478 return 1;
1479 }
1480
1481 return 0;
1482}
1483#endif
1484\f
1485
1486#if 0
1487static HMENU
1488create_menu (keymaps, error)
1489 int keymaps;
1490 char **error;
1491{
1492 HMENU hmenu = NULL; /* the menu we are currently working on */
1493 HMENU first_hmenu = NULL;
1494
1495 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1496 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1497 sizeof (Lisp_Object));
1498 int submenu_depth = 0;
1499 int i;
1500
1501 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1502 {
1503 *error = "Empty menu";
1504 return NULL;
1505 }
1506
1507 i = 0;
1508
1509 /* Loop over all panes and items, filling in the tree. */
1510
1511 while (i < menu_items_used)
1512 {
1513 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1514 {
1515 submenu_stack[submenu_depth++] = hmenu;
1516 i++;
1517 }
1518 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1519 {
1520 hmenu = submenu_stack[--submenu_depth];
1521 i++;
1522 }
1523#if 0
1524else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1525 && submenu_depth != 0)
1526 i += MENU_ITEMS_PANE_LENGTH;
1527#endif
1528 /* Ignore a nil in the item list.
1529 It's meaningful only for dialog boxes. */
1530else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1531 i += 1;
1532else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1533 {
1534 /* Create a new pane. */
1535
1536 Lisp_Object pane_name;
1537 char *pane_string;
1538
1539 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1540 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1541
1542 if (!hmenu || strcmp (pane_string, ""))
1543 {
1544 HMENU new_hmenu = CreateMenu ();
1545
1546 if (!new_hmenu)
1547 {
1548 *error = "Could not create menu pane";
1549 goto error;
1550 }
1551
1552 if (hmenu)
1553 {
1554 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1555 }
1556
1557 hmenu = new_hmenu;
1558
1559 if (!first_hmenu) first_hmenu = hmenu;
1560 }
1561 i += MENU_ITEMS_PANE_LENGTH;
1562 }
1563else
1564 {
1565 /* Create a new item within current pane. */
1566
1567 Lisp_Object item_name, enable, descrip;
1568 UINT fuFlags;
1569
1570 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1571 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1572 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1573
1574 if (((char *) XSTRING (item_name)->data)[0] == 0
1575 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1576 fuFlags = MF_SEPARATOR;
1577 else if (NILP (enable) || !XUINT(enable))
1578 fuFlags = MF_STRING | MF_GRAYED;
1579 else
1580 fuFlags = MF_STRING;
1581
1582 AppendMenu (hmenu,
1583 fuFlags,
1584 i,
1585 (char *) XSTRING (item_name)->data);
1586
1587 // if (!NILP (descrip))
1588 // hmenu->key = (char *) XSTRING (descrip)->data;
1589
1590 i += MENU_ITEMS_ITEM_LENGTH;
1591 }
1592}
1593
1594 return (first_hmenu);
1595
1596 error:
1597 if (first_hmenu) DestroyMenu (first_hmenu);
1598 return (NULL);
1599}
1600
1601#endif
1602
1603/* win32menu_show actually displays a menu using the panes and items in
1604 menu_items and returns the value selected from it.
1605 There are two versions of win32menu_show, one for Xt and one for Xlib.
1606 Both assume input is blocked by the caller. */
1607
1608/* F is the frame the menu is for.
1609 X and Y are the frame-relative specified position,
1610 relative to the inside upper left corner of the frame F.
1611 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1612 KEYMAPS is 1 if this menu was specified with keymaps;
1613 in that case, we return a list containing the chosen item's value
1614 and perhaps also the pane's prefix.
1615 TITLE is the specified menu title.
1616 ERROR is a place to store an error message string in case of failure.
1617 (We return nil on failure, but the value doesn't actually matter.) */
1618
1619
1620static Lisp_Object
1621win32menu_show (f, x, y, menu, hmenu, error)
1622 FRAME_PTR f;
1623 int x;
1624 int y;
1625 Lisp_Object menu;
1626 HMENU hmenu;
1627 char **error;
1628{
1629 int i , menu_selection;
1630 POINT pos;
1631
1632 *error = NULL;
1633
1634 if (!hmenu)
1635 {
1636 *error = "Empty menu";
1637 return Qnil;
1638 }
1639
1640 pos.x = x;
1641 pos.y = y;
1642
1643 /* Offset the coordinates to root-relative. */
1644 ClientToScreen (FRAME_WIN32_WINDOW (f), &pos);
1645
1646#if 0
1647 /* If the mouse moves out of the menu before we show the menu,
1648 don't show it at all. */
1649 if (check_mouse_other_menu_bar (f))
1650 {
1651 DestroyMenu (hmenu);
1652 return Qnil;
1653 }
1654#endif
1655
1656 /* Display the menu. */
1657 menu_selection = TrackPopupMenu (hmenu,
1658 0x10,
1659 pos.x, pos.y,
1660 0,
1661 FRAME_WIN32_WINDOW (f),
1662 NULL);
1663 if (menu_selection == -1)
1664 {
1665 *error = "Invalid menu specification";
1666 return Qnil;
1667 }
1668
1669 /* Find the selected item, and its pane, to return
1670 the proper value. */
1671
1672#if 1
1673 if (menu_selection > 0)
1674 {
1675 return get_menu_event (menu, menu_selection);
1676 }
1677#else
1678 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1679 {
1680 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1681 }
1682#endif
1683
1684 return Qnil;
1685}
1686
1687#if 0
1688static char * button_names [] =
1689{
1690 "button1", "button2", "button3", "button4", "button5",
1691 "button6", "button7", "button8", "button9", "button10"
1692};
1693
1694static Lisp_Object
1695win32_dialog_show (f, menubarp, keymaps, title, error)
1696 FRAME_PTR f;
1697 int menubarp;
1698 int keymaps;
1699 Lisp_Object title;
1700 char **error;
1701{
1702 int i, nb_buttons=0;
1703 HMENU hmenu;
1704 char dialog_name[6];
1705
1706 /* Number of elements seen so far, before boundary. */
1707 int left_count = 0;
1708 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1709 int boundary_seen = 0;
1710
1711 *error = NULL;
1712
1713 if (menu_items_n_panes > 1)
1714 {
1715 *error = "Multiple panes in dialog box";
1716 return Qnil;
1717 }
1718
1719 /* Create a tree of widget_value objects
1720 representing the text label and buttons. */
1721 {
1722 Lisp_Object pane_name, prefix;
1723 char *pane_string;
1724 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1725 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1726 pane_string = (NILP (pane_name)
1727 ? "" : (char *) XSTRING (pane_name)->data);
1728 prev_wv = malloc_widget_value ();
1729 prev_wv->value = pane_string;
1730 if (keymaps && !NILP (prefix))
1731 prev_wv->name++;
1732 prev_wv->enabled = 1;
1733 prev_wv->name = "message";
1734 first_wv = prev_wv;
1735
1736 /* Loop over all panes and items, filling in the tree. */
1737 i = MENU_ITEMS_PANE_LENGTH;
1738 while (i < menu_items_used)
1739 {
1740
1741 /* Create a new item within current pane. */
1742 Lisp_Object item_name, enable, descrip;
1743 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1744 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1745 descrip
1746 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1747
1748 if (NILP (item_name))
1749 {
1750 free_menubar_widget_value_tree (first_wv);
1751 *error = "Submenu in dialog items";
1752 return Qnil;
1753 }
1754 if (EQ (item_name, Qquote))
1755 {
1756 /* This is the boundary between left-side elts
1757 and right-side elts. Stop incrementing right_count. */
1758 boundary_seen = 1;
1759 i++;
1760 continue;
1761 }
1762 if (nb_buttons >= 10)
1763 {
1764 free_menubar_widget_value_tree (first_wv);
1765 *error = "Too many dialog items";
1766 return Qnil;
1767 }
1768
1769 wv = malloc_widget_value ();
1770 prev_wv->next = wv;
1771 wv->name = (char *) button_names[nb_buttons];
1772 if (!NILP (descrip))
1773 wv->key = (char *) XSTRING (descrip)->data;
1774 wv->value = (char *) XSTRING (item_name)->data;
1775 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1776 wv->enabled = !NILP (enable);
1777 prev_wv = wv;
1778
1779 if (! boundary_seen)
1780 left_count++;
1781
1782 nb_buttons++;
1783 i += MENU_ITEMS_ITEM_LENGTH;
1784 }
1785
1786 /* If the boundary was not specified,
1787 by default put half on the left and half on the right. */
1788 if (! boundary_seen)
1789 left_count = nb_buttons - nb_buttons / 2;
1790
1791 wv = malloc_widget_value ();
1792 wv->name = dialog_name;
1793
1794 /* Dialog boxes use a really stupid name encoding
1795 which specifies how many buttons to use
1796 and how many buttons are on the right.
1797 The Q means something also. */
1798 dialog_name[0] = 'Q';
1799 dialog_name[1] = '0' + nb_buttons;
1800 dialog_name[2] = 'B';
1801 dialog_name[3] = 'R';
1802 /* Number of buttons to put on the right. */
1803 dialog_name[4] = '0' + nb_buttons - left_count;
1804 dialog_name[5] = 0;
1805 wv->contents = first_wv;
1806 first_wv = wv;
1807 }
1808
1809 /* Actually create the dialog. */
1810 dialog_id = ++popup_id_tick;
1811 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1812 f->output_data.win32->widget, 1, 0,
1813 dialog_selection_callback, 0);
1814#if 0 /* This causes crashes, and seems to be redundant -- rms. */
1815 lw_modify_all_widgets (dialog_id, first_wv, True);
1816#endif
1817 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1818 /* Free the widget_value objects we used to specify the contents. */
1819 free_menubar_widget_value_tree (first_wv);
1820
1821 /* No selection has been chosen yet. */
1822 menu_item_selection = 0;
1823
1824 /* Display the menu. */
1825 lw_pop_up_all_widgets (dialog_id);
1826
1827 /* Process events that apply to the menu. */
1828 while (1)
1829 {
1830 XEvent event;
1831
1832 XtAppNextEvent (Xt_app_con, &event);
1833 if (event.type == ButtonRelease)
1834 {
1835 XtDispatchEvent (&event);
1836 break;
1837 }
1838 else if (event.type == Expose)
1839 process_expose_from_menu (event);
1840 XtDispatchEvent (&event);
1841 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1842 {
1843 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1844
1845 if (queue_tmp != NULL)
1846 {
1847 queue_tmp->event = event;
1848 queue_tmp->next = queue;
1849 queue = queue_tmp;
1850 }
1851 }
1852 }
1853 pop_down:
1854
1855 /* State that no mouse buttons are now held.
1856 That is not necessarily true, but the fiction leads to reasonable
1857 results, and it is a pain to ask which are actually held now
1858 or track this in the loop above. */
1859 win32_mouse_grabbed = 0;
1860
1861 /* Unread any events that we got but did not handle. */
1862 while (queue != NULL)
1863 {
1864 queue_tmp = queue;
1865 XPutBackEvent (XDISPLAY &queue_tmp->event);
1866 queue = queue_tmp->next;
1867 free ((char *)queue_tmp);
1868 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1869 interrupt_input_pending = 1;
1870 }
1871
1872 /* Find the selected item, and its pane, to return
1873 the proper value. */
1874 if (menu_item_selection != 0)
1875 {
1876 Lisp_Object prefix;
1877
1878 prefix = Qnil;
1879 i = 0;
1880 while (i < menu_items_used)
1881 {
1882 Lisp_Object entry;
1883
1884 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1885 {
1886 prefix
1887 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1888 i += MENU_ITEMS_PANE_LENGTH;
1889 }
1890 else
1891 {
1892 entry
1893 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1894 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1895 {
1896 if (keymaps != 0)
1897 {
1898 entry = Fcons (entry, Qnil);
1899 if (!NILP (prefix))
1900 entry = Fcons (prefix, entry);
1901 }
1902 return entry;
1903 }
1904 i += MENU_ITEMS_ITEM_LENGTH;
1905 }
1906 }
1907 }
1908
1909 return Qnil;
1910}
1911#endif
1912
1913syms_of_win32menu ()
1914{
1915 defsubr (&Sx_popup_menu);
1916 defsubr (&Sx_popup_dialog);
1917}