(Coding Conventions): Node renamed from Style Tips.
[bpt/emacs.git] / src / w32menu.c
CommitLineData
e9e23e23 1/* Menu support for GNU Emacs on the Microsoft W32 API.
ee78dc32
GV
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. */
ef06882d
GV
1155 if (EQ (position, Qt)
1156 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
ee78dc32
GV
1157 {
1158 /* Use the mouse's current position. */
ef06882d 1159 FRAME_PTR new_f = selected_frame;
ee78dc32
GV
1160 Lisp_Object bar_window;
1161 int part;
1162 unsigned long time;
1163
1164 if (mouse_position_hook)
ef06882d
GV
1165 (*mouse_position_hook) (&new_f, 1, &bar_window,
1166 &part, &x, &y, &time);
ee78dc32
GV
1167 if (new_f != 0)
1168 XSETFRAME (window, new_f);
1169 else
1170 {
1171 window = selected_window;
1172 XSETFASTINT (x, 0);
1173 XSETFASTINT (y, 0);
1174 }
1175 }
1176 else
1177 {
1178 tem = Fcar (position);
1179 if (CONSP (tem))
1180 {
1181 window = Fcar (Fcdr (position));
1182 x = Fcar (tem);
1183 y = Fcar (Fcdr (tem));
1184 }
1185 else
1186 {
1187 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1188 window = Fcar (tem); /* POSN_WINDOW (tem) */
1189 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1190 x = Fcar (tem);
1191 y = Fcdr (tem);
1192
1193 /* Determine whether this menu is handling a menu bar click. */
1194 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1195 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1196 menubarp = 1;
1197 }
1198 }
1199
1200 CHECK_NUMBER (x, 0);
1201 CHECK_NUMBER (y, 0);
1202
1203 /* Decode where to put the menu. */
1204
1205 if (FRAMEP (window))
1206 {
1207 f = XFRAME (window);
1208
1209 xpos = 0;
1210 ypos = 0;
1211 }
1212 else if (WINDOWP (window))
1213 {
1214 CHECK_LIVE_WINDOW (window, 0);
1215 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1216
fbd6baed
GV
1217 xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left);
1218 ypos = (f->output_data.w32->line_height * XWINDOW (window)->top);
ee78dc32
GV
1219 }
1220 else
1221 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1222 but I don't want to make one now. */
1223 CHECK_WINDOW (window, 0);
1224
1225 xpos += XINT (x);
1226 ypos += XINT (y);
1227 }
1228
1229 title = Qnil;
1230 GCPRO1 (title);
1231
1232 discard_menu_items (&mm);
1233 hmenu = create_menu_items (&mm, menu, NILP (position));
1234
1235 if (NILP (position))
1236 {
1237 discard_menu_items (&mm);
1238 UNGCPRO;
1239 return Qnil;
1240 }
1241
1242 /* Display them in a menu. */
1243 BLOCK_INPUT;
1244
fbd6baed 1245 selection = w32menu_show (f, xpos, ypos, menu, &hmenu, &error_name);
ee78dc32
GV
1246
1247 UNBLOCK_INPUT;
1248
1249 discard_menu_items (&mm);
1250 DestroyMenu (hmenu);
1251
1252 UNGCPRO;
1253
1254 if (error_name) error (error_name);
1255 return selection;
1256}
1257
1258DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1259 "Pop up a dialog box and return user's selection.\n\
1260POSITION specifies which frame to use.\n\
1261This is normally a mouse button event or a window or frame.\n\
1262If POSITION is t, it means to use the frame the mouse is on.\n\
1263The dialog box appears in the middle of the specified frame.\n\
1264\n\
1265CONTENTS specifies the alternatives to display in the dialog box.\n\
1266It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1267Each ITEM is a cons cell (STRING . VALUE).\n\
1268The return value is VALUE from the chosen item.\n\n\
1269An ITEM may also be just a string--that makes a nonselectable item.\n\
1270An ITEM may also be nil--that means to put all preceding items\n\
1271on the left of the dialog box and all following items on the right.\n\
1272\(By default, approximately half appear on each side.)")
1273 (position, contents)
1274 Lisp_Object position, contents;
1275{
1276 FRAME_PTR f;
1277 Lisp_Object window;
1278
1279 /* Decode the first argument: find the window or frame to use. */
1280 if (EQ (position, Qt))
1281 {
1282 /* Decode the first argument: find the window and the coordinates. */
1283 if (EQ (position, Qt))
1284 window = selected_window;
1285 }
1286 else if (CONSP (position))
1287 {
1288 Lisp_Object tem;
1289 tem = Fcar (position);
1290 if (XTYPE (tem) == Lisp_Cons)
1291 window = Fcar (Fcdr (position));
1292 else
1293 {
1294 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1295 window = Fcar (tem); /* POSN_WINDOW (tem) */
1296 }
1297 }
1298 else if (WINDOWP (position) || FRAMEP (position))
1299 window = position;
1300
1301 /* Decode where to put the menu. */
1302
1303 if (FRAMEP (window))
1304 f = XFRAME (window);
1305 else if (WINDOWP (window))
1306 {
1307 CHECK_LIVE_WINDOW (window, 0);
1308 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1309 }
1310 else
1311 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1312 but I don't want to make one now. */
1313 CHECK_WINDOW (window, 0);
1314
1315#if 1
1316 /* Display a menu with these alternatives
1317 in the middle of frame F. */
1318 {
1319 Lisp_Object x, y, frame, newpos;
1320 XSETFRAME (frame, f);
1321 XSETINT (x, x_pixel_width (f) / 2);
1322 XSETINT (y, x_pixel_height (f) / 2);
1323 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1324
1325 return Fx_popup_menu (newpos,
1326 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1327 }
1328#else
1329 {
1330 Lisp_Object title;
1331 char *error_name;
1332 Lisp_Object selection;
1333
1334 /* Decode the dialog items from what was specified. */
1335 title = Fcar (contents);
1336 CHECK_STRING (title, 1);
1337
1338 list_of_panes (Fcons (contents, Qnil));
1339
1340 /* Display them in a dialog box. */
1341 BLOCK_INPUT;
fbd6baed 1342 selection = w32_dialog_show (f, 0, 0, title, &error_name);
ee78dc32
GV
1343 UNBLOCK_INPUT;
1344
1345 discard_menu_items ();
1346
1347 if (error_name) error (error_name);
1348 return selection;
1349 }
1350#endif
1351}
1352
1353Lisp_Object
1354get_frame_menubar_event (f, num)
1355 FRAME_PTR f;
1356 int num;
1357{
1358 Lisp_Object tail, items;
1359 int i;
1360 struct gcpro gcpro1;
1361
1362 BLOCK_INPUT;
1363
1364 GCPRO1 (items);
1365
1366 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1367 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1368
d2ff1bf3 1369 for (i = 0; i < XVECTOR (items)->size; i += 4)
ee78dc32
GV
1370 {
1371 Lisp_Object event;
1372
1373 event = get_menu_event (XVECTOR (items)->contents[i + 2], &num);
1374
1375 if (num <= 0)
1376 {
1377 UNGCPRO;
1378 UNBLOCK_INPUT;
1379 return (Fcons (XVECTOR (items)->contents[i], event));
1380 }
1381 }
1382
1383 UNGCPRO;
1384 UNBLOCK_INPUT;
1385
1386 return (Qnil);
1387}
1388
1389void
1390set_frame_menubar (f, first_time)
1391 FRAME_PTR f;
1392 int first_time;
1393{
1394 Lisp_Object tail, items;
1395 HMENU hmenu;
1396 int i;
1397 struct gcpro gcpro1;
1398 menu_map mm;
fdc12c4d
RS
1399 int count = specpdl_ptr - specpdl;
1400
1401 struct buffer *prev = current_buffer;
1402 Lisp_Object buffer;
1403
1404 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1405 specbind (Qinhibit_quit, Qt);
1406 /* Don't let the debugger step into this code
1407 because it is not reentrant. */
1408 specbind (Qdebug_on_next_call, Qnil);
1409
7935c738 1410 record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil));
fdc12c4d
RS
1411 if (NILP (Voverriding_local_map_menu_flag))
1412 {
1413 specbind (Qoverriding_terminal_local_map, Qnil);
1414 specbind (Qoverriding_local_map, Qnil);
1415 }
1416
1417 set_buffer_internal_1 (XBUFFER (buffer));
1418
1419 /* Run the Lucid hook. */
1420 call1 (Vrun_hooks, Qactivate_menubar_hook);
1421 /* If it has changed current-menubar from previous value,
1422 really recompute the menubar from the value. */
1423 if (! NILP (Vlucid_menu_bar_dirty_flag))
1424 call0 (Qrecompute_lucid_menubar);
1425 safe_run_hooks (Qmenu_bar_update_hook);
ee78dc32
GV
1426
1427 BLOCK_INPUT;
1428
1429 GCPRO1 (items);
1430
fdc12c4d
RS
1431 items = FRAME_MENU_BAR_ITEMS (f);
1432 if (NILP (items))
ee78dc32
GV
1433 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1434
1435 hmenu = CreateMenu ();
1436
1437 if (!hmenu) goto error;
1438
1439 discard_menu_items (&mm);
fdc12c4d 1440 UNBLOCK_INPUT;
ee78dc32 1441
d2ff1bf3 1442 for (i = 0; i < XVECTOR (items)->size; i += 4)
ee78dc32
GV
1443 {
1444 Lisp_Object string;
1445 int keymaps;
1446 CHAR *error;
1447 HMENU new_hmenu;
1448
1449 string = XVECTOR (items)->contents[i + 1];
1450 if (NILP (string))
1451 break;
1452
fdc12c4d
RS
1453 /* Input must not be blocked here
1454 because we call general Lisp code and internal_condition_case_1. */
ee78dc32
GV
1455 new_hmenu = create_menu_items (&mm,
1456 XVECTOR (items)->contents[i + 2],
1457 0);
1458
1459 if (!new_hmenu)
1460 continue;
1461
fdc12c4d 1462 BLOCK_INPUT;
ee78dc32
GV
1463 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1464 (char *) XSTRING (string)->data);
fdc12c4d 1465 UNBLOCK_INPUT;
ee78dc32
GV
1466 }
1467
fdc12c4d 1468 BLOCK_INPUT;
ee78dc32 1469 {
fbd6baed
GV
1470 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1471 SetMenu (FRAME_W32_WINDOW (f), hmenu);
ee78dc32
GV
1472 DestroyMenu (old);
1473 }
1474
1475 error:
fdc12c4d 1476 set_buffer_internal_1 (prev);
ee78dc32
GV
1477 UNGCPRO;
1478 UNBLOCK_INPUT;
fdc12c4d 1479 unbind_to (count, Qnil);
ee78dc32
GV
1480}
1481
1482void
1483free_frame_menubar (f)
1484 FRAME_PTR f;
1485{
1486 BLOCK_INPUT;
1487
1488 {
fbd6baed
GV
1489 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1490 SetMenu (FRAME_W32_WINDOW (f), NULL);
ee78dc32
GV
1491 DestroyMenu (old);
1492 }
1493
1494 UNBLOCK_INPUT;
1495}
fbd6baed 1496/* Called from Fw32_create_frame to create the initial menubar of a frame
ee78dc32
GV
1497 before it is mapped, so that the window is mapped with the menubar already
1498 there instead of us tacking it on later and thrashing the window after it
1499 is visible. */
1500void
1501initialize_frame_menubar (f)
1502 FRAME_PTR f;
1503{
1504 set_frame_menubar (f, 1);
1505}
1506\f
1507#if 0
1508/* If the mouse has moved to another menu bar item,
1509 return 1 and unread a button press event for that item.
1510 Otherwise return 0. */
1511
1512static int
1513check_mouse_other_menu_bar (f)
1514 FRAME_PTR f;
1515{
1516 FRAME_PTR new_f;
1517 Lisp_Object bar_window;
1518 int part;
1519 Lisp_Object x, y;
1520 unsigned long time;
1521
ef06882d 1522 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
ee78dc32
GV
1523
1524 if (f == new_f && other_menu_bar_item_p (f, x, y))
1525 {
1526 unread_menu_bar_button (f, x);
1527 return 1;
1528 }
1529
1530 return 0;
1531}
1532#endif
1533\f
1534
1535#if 0
1536static HMENU
1537create_menu (keymaps, error)
1538 int keymaps;
1539 char **error;
1540{
1541 HMENU hmenu = NULL; /* the menu we are currently working on */
1542 HMENU first_hmenu = NULL;
1543
1544 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1545 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1546 sizeof (Lisp_Object));
1547 int submenu_depth = 0;
1548 int i;
1549
1550 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1551 {
1552 *error = "Empty menu";
1553 return NULL;
1554 }
1555
1556 i = 0;
1557
1558 /* Loop over all panes and items, filling in the tree. */
1559
1560 while (i < menu_items_used)
1561 {
1562 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1563 {
1564 submenu_stack[submenu_depth++] = hmenu;
1565 i++;
1566 }
1567 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1568 {
1569 hmenu = submenu_stack[--submenu_depth];
1570 i++;
1571 }
1572#if 0
1573else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1574 && submenu_depth != 0)
1575 i += MENU_ITEMS_PANE_LENGTH;
1576#endif
1577 /* Ignore a nil in the item list.
1578 It's meaningful only for dialog boxes. */
1579else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1580 i += 1;
1581else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1582 {
1583 /* Create a new pane. */
1584
1585 Lisp_Object pane_name;
1586 char *pane_string;
1587
1588 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1589 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1590
1591 if (!hmenu || strcmp (pane_string, ""))
1592 {
1593 HMENU new_hmenu = CreateMenu ();
1594
1595 if (!new_hmenu)
1596 {
1597 *error = "Could not create menu pane";
1598 goto error;
1599 }
1600
1601 if (hmenu)
1602 {
1603 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1604 }
1605
1606 hmenu = new_hmenu;
1607
1608 if (!first_hmenu) first_hmenu = hmenu;
1609 }
1610 i += MENU_ITEMS_PANE_LENGTH;
1611 }
1612else
1613 {
1614 /* Create a new item within current pane. */
1615
1616 Lisp_Object item_name, enable, descrip;
1617 UINT fuFlags;
1618
1619 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1620 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1621 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1622
1623 if (((char *) XSTRING (item_name)->data)[0] == 0
1624 || strcmp ((char *) XSTRING (item_name)->data, "--") == 0)
1625 fuFlags = MF_SEPARATOR;
1626 else if (NILP (enable) || !XUINT(enable))
1627 fuFlags = MF_STRING | MF_GRAYED;
1628 else
1629 fuFlags = MF_STRING;
1630
1631 AppendMenu (hmenu,
1632 fuFlags,
1633 i,
1634 (char *) XSTRING (item_name)->data);
1635
1636 // if (!NILP (descrip))
1637 // hmenu->key = (char *) XSTRING (descrip)->data;
1638
1639 i += MENU_ITEMS_ITEM_LENGTH;
1640 }
1641}
1642
1643 return (first_hmenu);
1644
1645 error:
1646 if (first_hmenu) DestroyMenu (first_hmenu);
1647 return (NULL);
1648}
1649
1650#endif
1651
fbd6baed 1652/* w32menu_show actually displays a menu using the panes and items in
ee78dc32 1653 menu_items and returns the value selected from it.
fbd6baed 1654 There are two versions of w32menu_show, one for Xt and one for Xlib.
ee78dc32
GV
1655 Both assume input is blocked by the caller. */
1656
1657/* F is the frame the menu is for.
1658 X and Y are the frame-relative specified position,
1659 relative to the inside upper left corner of the frame F.
1660 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1661 KEYMAPS is 1 if this menu was specified with keymaps;
1662 in that case, we return a list containing the chosen item's value
1663 and perhaps also the pane's prefix.
1664 TITLE is the specified menu title.
1665 ERROR is a place to store an error message string in case of failure.
1666 (We return nil on failure, but the value doesn't actually matter.) */
1667
1668
1669static Lisp_Object
fbd6baed 1670w32menu_show (f, x, y, menu, hmenu, error)
ee78dc32
GV
1671 FRAME_PTR f;
1672 int x;
1673 int y;
1674 Lisp_Object menu;
1675 HMENU hmenu;
1676 char **error;
1677{
1678 int i , menu_selection;
1679 POINT pos;
1680
1681 *error = NULL;
1682
1683 if (!hmenu)
1684 {
1685 *error = "Empty menu";
1686 return Qnil;
1687 }
1688
1689 pos.x = x;
1690 pos.y = y;
1691
1692 /* Offset the coordinates to root-relative. */
fbd6baed 1693 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
ee78dc32
GV
1694
1695#if 0
1696 /* If the mouse moves out of the menu before we show the menu,
1697 don't show it at all. */
1698 if (check_mouse_other_menu_bar (f))
1699 {
1700 DestroyMenu (hmenu);
1701 return Qnil;
1702 }
1703#endif
1704
1705 /* Display the menu. */
1706 menu_selection = TrackPopupMenu (hmenu,
1707 0x10,
1708 pos.x, pos.y,
1709 0,
fbd6baed 1710 FRAME_W32_WINDOW (f),
ee78dc32
GV
1711 NULL);
1712 if (menu_selection == -1)
1713 {
1714 *error = "Invalid menu specification";
1715 return Qnil;
1716 }
1717
1718 /* Find the selected item, and its pane, to return
1719 the proper value. */
1720
1721#if 1
1722 if (menu_selection > 0)
1723 {
1724 return get_menu_event (menu, menu_selection);
1725 }
1726#else
1727 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1728 {
1729 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1730 }
1731#endif
1732
1733 return Qnil;
1734}
1735
1736#if 0
1737static char * button_names [] =
1738{
1739 "button1", "button2", "button3", "button4", "button5",
1740 "button6", "button7", "button8", "button9", "button10"
1741};
1742
1743static Lisp_Object
fbd6baed 1744w32_dialog_show (f, menubarp, keymaps, title, error)
ee78dc32
GV
1745 FRAME_PTR f;
1746 int menubarp;
1747 int keymaps;
1748 Lisp_Object title;
1749 char **error;
1750{
1751 int i, nb_buttons=0;
1752 HMENU hmenu;
1753 char dialog_name[6];
1754
1755 /* Number of elements seen so far, before boundary. */
1756 int left_count = 0;
1757 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1758 int boundary_seen = 0;
1759
1760 *error = NULL;
1761
1762 if (menu_items_n_panes > 1)
1763 {
1764 *error = "Multiple panes in dialog box";
1765 return Qnil;
1766 }
1767
1768 /* Create a tree of widget_value objects
1769 representing the text label and buttons. */
1770 {
1771 Lisp_Object pane_name, prefix;
1772 char *pane_string;
1773 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1774 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1775 pane_string = (NILP (pane_name)
1776 ? "" : (char *) XSTRING (pane_name)->data);
1777 prev_wv = malloc_widget_value ();
1778 prev_wv->value = pane_string;
1779 if (keymaps && !NILP (prefix))
1780 prev_wv->name++;
1781 prev_wv->enabled = 1;
1782 prev_wv->name = "message";
1783 first_wv = prev_wv;
1784
1785 /* Loop over all panes and items, filling in the tree. */
1786 i = MENU_ITEMS_PANE_LENGTH;
1787 while (i < menu_items_used)
1788 {
1789
1790 /* Create a new item within current pane. */
1791 Lisp_Object item_name, enable, descrip;
1792 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1793 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1794 descrip
1795 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1796
1797 if (NILP (item_name))
1798 {
1799 free_menubar_widget_value_tree (first_wv);
1800 *error = "Submenu in dialog items";
1801 return Qnil;
1802 }
1803 if (EQ (item_name, Qquote))
1804 {
1805 /* This is the boundary between left-side elts
1806 and right-side elts. Stop incrementing right_count. */
1807 boundary_seen = 1;
1808 i++;
1809 continue;
1810 }
1811 if (nb_buttons >= 10)
1812 {
1813 free_menubar_widget_value_tree (first_wv);
1814 *error = "Too many dialog items";
1815 return Qnil;
1816 }
1817
1818 wv = malloc_widget_value ();
1819 prev_wv->next = wv;
1820 wv->name = (char *) button_names[nb_buttons];
1821 if (!NILP (descrip))
1822 wv->key = (char *) XSTRING (descrip)->data;
1823 wv->value = (char *) XSTRING (item_name)->data;
1824 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1825 wv->enabled = !NILP (enable);
1826 prev_wv = wv;
1827
1828 if (! boundary_seen)
1829 left_count++;
1830
1831 nb_buttons++;
1832 i += MENU_ITEMS_ITEM_LENGTH;
1833 }
1834
1835 /* If the boundary was not specified,
1836 by default put half on the left and half on the right. */
1837 if (! boundary_seen)
1838 left_count = nb_buttons - nb_buttons / 2;
1839
1840 wv = malloc_widget_value ();
1841 wv->name = dialog_name;
1842
1843 /* Dialog boxes use a really stupid name encoding
1844 which specifies how many buttons to use
1845 and how many buttons are on the right.
1846 The Q means something also. */
1847 dialog_name[0] = 'Q';
1848 dialog_name[1] = '0' + nb_buttons;
1849 dialog_name[2] = 'B';
1850 dialog_name[3] = 'R';
1851 /* Number of buttons to put on the right. */
1852 dialog_name[4] = '0' + nb_buttons - left_count;
1853 dialog_name[5] = 0;
1854 wv->contents = first_wv;
1855 first_wv = wv;
1856 }
1857
1858 /* Actually create the dialog. */
1859 dialog_id = ++popup_id_tick;
1860 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
fbd6baed 1861 f->output_data.w32->widget, 1, 0,
ee78dc32
GV
1862 dialog_selection_callback, 0);
1863#if 0 /* This causes crashes, and seems to be redundant -- rms. */
1864 lw_modify_all_widgets (dialog_id, first_wv, True);
1865#endif
1866 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1867 /* Free the widget_value objects we used to specify the contents. */
1868 free_menubar_widget_value_tree (first_wv);
1869
1870 /* No selection has been chosen yet. */
1871 menu_item_selection = 0;
1872
1873 /* Display the menu. */
1874 lw_pop_up_all_widgets (dialog_id);
1875
1876 /* Process events that apply to the menu. */
1877 while (1)
1878 {
1879 XEvent event;
1880
1881 XtAppNextEvent (Xt_app_con, &event);
1882 if (event.type == ButtonRelease)
1883 {
1884 XtDispatchEvent (&event);
1885 break;
1886 }
1887 else if (event.type == Expose)
1888 process_expose_from_menu (event);
1889 XtDispatchEvent (&event);
1890 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
1891 {
1892 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
1893
1894 if (queue_tmp != NULL)
1895 {
1896 queue_tmp->event = event;
1897 queue_tmp->next = queue;
1898 queue = queue_tmp;
1899 }
1900 }
1901 }
1902 pop_down:
1903
1904 /* State that no mouse buttons are now held.
1905 That is not necessarily true, but the fiction leads to reasonable
1906 results, and it is a pain to ask which are actually held now
1907 or track this in the loop above. */
fbd6baed 1908 w32_mouse_grabbed = 0;
ee78dc32
GV
1909
1910 /* Unread any events that we got but did not handle. */
1911 while (queue != NULL)
1912 {
1913 queue_tmp = queue;
1914 XPutBackEvent (XDISPLAY &queue_tmp->event);
1915 queue = queue_tmp->next;
1916 free ((char *)queue_tmp);
1917 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
1918 interrupt_input_pending = 1;
1919 }
1920
1921 /* Find the selected item, and its pane, to return
1922 the proper value. */
1923 if (menu_item_selection != 0)
1924 {
1925 Lisp_Object prefix;
1926
1927 prefix = Qnil;
1928 i = 0;
1929 while (i < menu_items_used)
1930 {
1931 Lisp_Object entry;
1932
1933 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1934 {
1935 prefix
1936 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1937 i += MENU_ITEMS_PANE_LENGTH;
1938 }
1939 else
1940 {
1941 entry
1942 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1943 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
1944 {
1945 if (keymaps != 0)
1946 {
1947 entry = Fcons (entry, Qnil);
1948 if (!NILP (prefix))
1949 entry = Fcons (prefix, entry);
1950 }
1951 return entry;
1952 }
1953 i += MENU_ITEMS_ITEM_LENGTH;
1954 }
1955 }
1956 }
1957
1958 return Qnil;
1959}
1960#endif
1961
fbd6baed 1962syms_of_w32menu ()
ee78dc32 1963{
fdc12c4d
RS
1964 Qdebug_on_next_call = intern ("debug-on-next-call");
1965 staticpro (&Qdebug_on_next_call);
1966
ee78dc32
GV
1967 defsubr (&Sx_popup_menu);
1968 defsubr (&Sx_popup_dialog);
1969}