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