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