Deal with `#'s in variable references.
[emacs.git] / src / w32menu.c
blob73f1dcb920bc9f8ca43776c458ac8083aacac2bb
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Written by Kevin Gallo. */
23 #include <signal.h>
24 #include <config.h>
26 #include <stdio.h>
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "keyboard.h"
32 #include "blockinput.h"
33 #include "buffer.h"
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"
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
45 #include "dispextern.h"
47 #define min(x, y) (((x) < (y)) ? (x) : (y))
48 #define max(x, y) (((x) > (y)) ? (x) : (y))
50 typedef struct menu_map
52 Lisp_Object menu_items;
53 int menu_items_allocated;
54 int menu_items_used;
55 } menu_map;
57 Lisp_Object Qdebug_on_next_call;
59 extern Lisp_Object Qmenu_enable;
60 extern Lisp_Object Qmenu_bar;
62 extern Lisp_Object Voverriding_local_map;
63 extern Lisp_Object Voverriding_local_map_menu_flag;
65 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
67 extern Lisp_Object Qmenu_bar_update_hook;
69 void set_frame_menubar ();
71 static Lisp_Object w32_dialog_show ();
72 static Lisp_Object w32menu_show ();
74 static HMENU keymap_panes ();
75 static HMENU single_keymap_panes ();
76 static HMENU list_of_panes ();
77 static HMENU list_of_items ();
79 static HMENU create_menu_items ();
81 /* Initialize the menu_items structure if we haven't already done so.
82 Also mark it as currently empty. */
84 #if 0
85 static void
86 init_menu_items (lpmm)
87 menu_map * lpmm;
89 if (NILP (lpmm->menu_items))
91 lpmm->menu_items_allocated = 60;
92 lpmm->menu_items = Fmake_vector (make_number (lpmm->menu_items_allocated),
93 Qnil);
96 lpmm->menu_items_used = 0;
99 /* Make the menu_items vector twice as large. */
101 static void
102 grow_menu_items (lpmm)
103 menu_map * lpmm;
105 Lisp_Object new;
106 int old_size = lpmm->menu_items_allocated;
108 lpmm->menu_items_allocated *= 2;
109 new = Fmake_vector (make_number (lpmm->menu_items_allocated), Qnil);
110 bcopy (XVECTOR (lpmm->menu_items)->contents, XVECTOR (new)->contents,
111 old_size * sizeof (Lisp_Object));
113 lpmm->menu_items = new;
115 #endif
117 /* Call when finished using the data for the current menu
118 in menu_items. */
120 static void
121 discard_menu_items (lpmm)
122 menu_map * lpmm;
124 #if 0
125 lpmm->menu_items = Qnil;
126 #endif
127 lpmm->menu_items_allocated = lpmm->menu_items_used = 0;
130 /* Is this item a separator? */
131 static int
132 name_is_separator (name)
133 Lisp_Object name;
135 int isseparator = (((char *)XSTRING (name)->data)[0] == 0);
137 if (!isseparator)
139 /* Check if name string consists of only dashes ('-') */
140 char *string = (char *)XSTRING (name)->data;
141 while (*string == '-') string++;
142 isseparator = (*string == 0);
145 return isseparator;
149 /* Indicate boundary between left and right. */
151 static void
152 add_left_right_boundary (hmenu)
153 HMENU hmenu;
155 AppendMenu (hmenu, MF_MENUBARBREAK, 0, NULL);
158 /* Push one menu item into the current pane.
159 NAME is the string to display. ENABLE if non-nil means
160 this item can be selected. KEY is the key generated by
161 choosing this item. EQUIV is the textual description
162 of the keyboard equivalent for this item (or nil if none). */
164 static void
165 add_menu_item (lpmm, hmenu, name, enable, key, equiv)
166 menu_map * lpmm;
167 HMENU hmenu;
168 Lisp_Object name;
169 UINT enable;
170 Lisp_Object key;
171 Lisp_Object equiv;
173 UINT fuFlags;
174 Lisp_Object out_string;
176 if (NILP (name) || name_is_separator (name))
177 fuFlags = MF_SEPARATOR;
178 else
180 if (enable)
181 fuFlags = MF_STRING;
182 else
183 fuFlags = MF_STRING | MF_GRAYED;
185 if (!NILP (equiv))
187 out_string = concat2 (name, make_string ("\t", 1));
188 out_string = concat2 (out_string, equiv);
190 else
191 out_string = name;
194 AppendMenu (hmenu,
195 fuFlags,
196 lpmm->menu_items_used + 1,
197 (fuFlags == MF_SEPARATOR)?NULL:
198 (char *) XSTRING (out_string)->data);
200 lpmm->menu_items_used++;
201 #if 0
202 if (lpmm->menu_items_used >= lpmm->menu_items_allocated)
203 grow_menu_items (lpmm);
205 XSET (XVECTOR (lpmm->menu_items)->contents[lpmm->menu_items_used++],
206 Lisp_Cons,
207 key);
208 #endif
211 /* Figure out the current keyboard equivalent of a menu item ITEM1.
212 The item string for menu display should be ITEM_STRING.
213 Store the equivalent keyboard key sequence's
214 textual description into *DESCRIP_PTR.
215 Also cache them in the item itself.
216 Return the real definition to execute. */
218 static Lisp_Object
219 menu_item_equiv_key (item_string, item1, descrip_ptr)
220 Lisp_Object item_string;
221 Lisp_Object item1;
222 Lisp_Object *descrip_ptr;
224 /* This is the real definition--the function to run. */
225 Lisp_Object def;
226 /* This is the sublist that records cached equiv key data
227 so we can save time. */
228 Lisp_Object cachelist;
229 /* These are the saved equivalent keyboard key sequence
230 and its key-description. */
231 Lisp_Object savedkey, descrip;
232 Lisp_Object def1;
233 int changed = 0;
234 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
236 /* If a help string follows the item string, skip it. */
237 if (CONSP (XCONS (item1)->cdr)
238 && STRINGP (XCONS (XCONS (item1)->cdr)->car))
239 item1 = XCONS (item1)->cdr;
241 def = Fcdr (item1);
243 /* Get out the saved equivalent-keyboard-key info. */
244 cachelist = savedkey = descrip = Qnil;
245 if (CONSP (def) && CONSP (XCONS (def)->car)
246 && (NILP (XCONS (XCONS (def)->car)->car)
247 || VECTORP (XCONS (XCONS (def)->car)->car)))
249 cachelist = XCONS (def)->car;
250 def = XCONS (def)->cdr;
251 savedkey = XCONS (cachelist)->car;
252 descrip = XCONS (cachelist)->cdr;
255 GCPRO4 (def, def1, savedkey, descrip);
257 /* Is it still valid? */
258 def1 = Qnil;
259 if (!NILP (savedkey))
260 def1 = Fkey_binding (savedkey, Qnil);
261 /* If not, update it. */
262 if (! EQ (def1, def)
263 /* If the command is an alias for another
264 (such as easymenu.el and lmenu.el set it up),
265 check if the original command matches the cached command. */
266 && !(SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)
267 && EQ (def1, XSYMBOL (def)->function))
268 /* If something had no key binding before, don't recheck it--
269 doing that takes too much time and makes menus too slow. */
270 && !(!NILP (cachelist) && NILP (savedkey)))
272 changed = 1;
273 descrip = Qnil;
274 savedkey = Fwhere_is_internal (def, Qnil, Qt, Qnil);
275 /* If the command is an alias for another
276 (such as easymenu.el and lmenu.el set it up),
277 see if the original command name has equivalent keys. */
278 if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function))
279 savedkey = Fwhere_is_internal (XSYMBOL (def)->function,
280 Qnil, Qt, Qnil);
282 if (VECTORP (savedkey)
283 && EQ (XVECTOR (savedkey)->contents[0], Qmenu_bar))
284 savedkey = Qnil;
285 if (!NILP (savedkey))
287 descrip = Fkey_description (savedkey);
288 descrip = concat2 (make_string (" (", 3), descrip);
289 descrip = concat2 (descrip, make_string (")", 1));
293 /* Cache the data we just got in a sublist of the menu binding. */
294 if (NILP (cachelist))
295 XCONS (item1)->cdr = Fcons (Fcons (savedkey, descrip), def);
296 else if (changed)
298 XCONS (cachelist)->car = savedkey;
299 XCONS (cachelist)->cdr = descrip;
302 UNGCPRO;
303 *descrip_ptr = descrip;
304 return def;
307 /* This is used as the handler when calling internal_condition_case_1. */
309 static Lisp_Object
310 menu_item_enabled_p_1 (arg)
311 Lisp_Object arg;
313 return Qnil;
316 /* Return non-nil if the command DEF is enabled when used as a menu item.
317 This is based on looking for a menu-enable property.
318 If NOTREAL is set, don't bother really computing this. */
320 static Lisp_Object
321 menu_item_enabled_p (def, notreal)
322 Lisp_Object def;
324 Lisp_Object enabled, tem;
326 enabled = Qt;
327 if (notreal)
328 return enabled;
329 if (XTYPE (def) == Lisp_Symbol)
331 /* No property, or nil, means enable.
332 Otherwise, enable if value is not nil. */
333 tem = Fget (def, Qmenu_enable);
334 if (!NILP (tem))
335 /* (condition-case nil (eval tem)
336 (error nil)) */
337 enabled = internal_condition_case_1 (Feval, tem, Qerror,
338 menu_item_enabled_p_1);
340 return enabled;
343 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
344 and generate menu panes for them in menu_items.
345 If NOTREAL is nonzero,
346 don't bother really computing whether an item is enabled. */
348 static HMENU
349 keymap_panes (lpmm, keymaps, nmaps, notreal)
350 menu_map * lpmm;
351 Lisp_Object *keymaps;
352 int nmaps;
353 int notreal;
355 int mapno;
357 #if 0
358 init_menu_items (lpmm);
359 #endif
361 if (nmaps > 1)
363 HMENU hmenu;
365 if (!notreal)
367 hmenu = CreatePopupMenu ();
369 if (!hmenu) return (NULL);
371 else
373 hmenu = NULL;
376 /* Loop over the given keymaps, making a pane for each map.
377 But don't make a pane that is empty--ignore that map instead.
378 P is the number of panes we have made so far. */
379 for (mapno = 0; mapno < nmaps; mapno++)
381 HMENU new_hmenu;
383 new_hmenu = single_keymap_panes (lpmm, keymaps[mapno],
384 Qnil, Qnil, notreal);
386 if (!notreal && new_hmenu)
388 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, "");
392 return (hmenu);
394 else
396 return (single_keymap_panes (lpmm, keymaps[0], Qnil, Qnil, notreal));
400 /* This is a recursive subroutine of keymap_panes.
401 It handles one keymap, KEYMAP.
402 The other arguments are passed along
403 or point to local variables of the previous function.
404 If NOTREAL is nonzero,
405 don't bother really computing whether an item is enabled. */
407 HMENU
408 single_keymap_panes (lpmm, keymap, pane_name, prefix, notreal)
409 menu_map * lpmm;
410 Lisp_Object keymap;
411 Lisp_Object pane_name;
412 Lisp_Object prefix;
413 int notreal;
415 Lisp_Object pending_maps;
416 Lisp_Object tail, item, item1, item_string, table;
417 HMENU hmenu;
418 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
420 if (!notreal)
422 hmenu = CreatePopupMenu ();
423 if (hmenu == NULL) return NULL;
425 else
427 hmenu = NULL;
430 pending_maps = Qnil;
432 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
434 /* Look at each key binding, and if it has a menu string,
435 make a menu item from it. */
437 item = XCONS (tail)->car;
439 if (CONSP (item))
441 item1 = XCONS (item)->cdr;
443 if (XTYPE (item1) == Lisp_Cons)
445 item_string = XCONS (item1)->car;
446 if (XTYPE (item_string) == Lisp_String)
448 /* This is the real definition--the function to run. */
450 Lisp_Object def;
452 /* These are the saved equivalent keyboard key sequence
453 and its key-description. */
455 Lisp_Object descrip;
456 Lisp_Object tem, enabled;
458 /* GCPRO because ...enabled_p will call eval
459 and ..._equiv_key may autoload something.
460 Protecting KEYMAP preserves everything we use;
461 aside from that, must protect whatever might be
462 a string. Since there's no GCPRO5, we refetch
463 item_string instead of protecting it. */
465 descrip = def = Qnil;
466 GCPRO4 (keymap, pending_maps, def, prefix);
468 def = menu_item_equiv_key (item_string, item1, &descrip);
470 struct gcpro gcpro1;
471 GCPRO1 (descrip);
472 enabled = menu_item_enabled_p (def, notreal);
473 UNGCPRO;
476 UNGCPRO;
478 item_string = XCONS (item1)->car;
480 tem = Fkeymapp (def);
481 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
483 pending_maps = Fcons (Fcons (def,
484 Fcons (item_string,
485 XCONS (item)->car)),
486 pending_maps);
488 else
490 Lisp_Object submap;
492 GCPRO5 (keymap, pending_maps, item, item_string, descrip);
494 submap = get_keymap_1 (def, 0, 1);
496 UNGCPRO;
498 if (NILP (submap))
500 if (!notreal)
502 add_menu_item (lpmm,
503 hmenu,
504 item_string,
505 !NILP (enabled),
506 Fcons (XCONS (item)->car, prefix),
507 descrip);
510 else
511 /* Display a submenu. */
513 HMENU new_hmenu = single_keymap_panes (lpmm,
514 submap,
515 item_string,
516 XCONS (item)->car,
517 notreal);
519 if (!notreal)
521 AppendMenu (hmenu, MF_POPUP,
522 (UINT)new_hmenu,
523 (char *) XSTRING (item_string)->data);
530 else if (VECTORP (item))
532 /* Loop over the char values represented in the vector. */
533 int len = XVECTOR (item)->size;
534 int c;
535 for (c = 0; c < len; c++)
537 Lisp_Object character;
538 XSETFASTINT (character, c);
539 item1 = XVECTOR (item)->contents[c];
540 if (CONSP (item1))
542 item_string = XCONS (item1)->car;
543 if (STRINGP (item_string))
545 Lisp_Object def;
547 /* These are the saved equivalent keyboard key sequence
548 and its key-description. */
549 Lisp_Object descrip;
550 Lisp_Object tem, enabled;
552 /* GCPRO because ...enabled_p will call eval
553 and ..._equiv_key may autoload something.
554 Protecting KEYMAP preserves everything we use;
555 aside from that, must protect whatever might be
556 a string. Since there's no GCPRO5, we refetch
557 item_string instead of protecting it. */
558 GCPRO3 (keymap, pending_maps, def);
559 descrip = def = Qnil;
561 def = menu_item_equiv_key (item_string, item1, &descrip);
563 struct gcpro gcpro1;
564 GCPRO1 (descrip);
565 enabled = menu_item_enabled_p (def, notreal);
566 UNGCPRO;
569 UNGCPRO;
571 item_string = XCONS (item1)->car;
573 tem = Fkeymapp (def);
574 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
575 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
576 pending_maps);
577 else
579 Lisp_Object submap;
581 GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
583 submap = get_keymap_1 (def, 0, 1);
585 UNGCPRO;
587 if (NILP (submap))
589 if (!notreal)
591 add_menu_item (lpmm,
592 hmenu,
593 item_string,
594 !NILP (enabled),
595 character,
596 descrip);
599 else
600 /* Display a submenu. */
602 HMENU new_hmenu = single_keymap_panes (lpmm,
603 submap,
604 Qnil,
605 character,
606 notreal);
608 if (!notreal)
610 AppendMenu (hmenu,MF_POPUP,
611 (UINT)new_hmenu,
612 (char *)XSTRING (item_string)->data);
622 /* Process now any submenus which want to be panes at this level. */
623 while (!NILP (pending_maps))
625 Lisp_Object elt, eltcdr, string;
626 elt = Fcar (pending_maps);
627 eltcdr = XCONS (elt)->cdr;
628 string = XCONS (eltcdr)->car;
629 /* We no longer discard the @ from the beginning of the string here.
630 Instead, we do this in w32menu_show. */
632 HMENU new_hmenu = single_keymap_panes (lpmm,
633 Fcar (elt),
634 string,
635 XCONS (eltcdr)->cdr, notreal);
637 if (!notreal)
639 AppendMenu (hmenu, MF_POPUP,
640 (UINT)new_hmenu,
641 (char *) XSTRING (string)->data);
645 pending_maps = Fcdr (pending_maps);
648 return (hmenu);
651 /* Push all the panes and items of a menu described by the
652 alist-of-alists MENU.
653 This handles old-fashioned calls to x-popup-menu. */
655 static HMENU
656 list_of_panes (lpmm, menu)
657 menu_map * lpmm;
658 Lisp_Object menu;
660 Lisp_Object tail;
661 HMENU hmenu;
663 if (XFASTINT (Flength (menu)) > 1)
665 hmenu = CreatePopupMenu ();
666 if (hmenu == NULL) return NULL;
668 /* init_menu_items (lpmm); */
670 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
672 Lisp_Object elt, pane_name, pane_data;
673 HMENU new_hmenu;
675 elt = Fcar (tail);
676 pane_name = Fcar (elt);
677 CHECK_STRING (pane_name, 0);
678 pane_data = Fcdr (elt);
679 CHECK_CONS (pane_data, 0);
681 if (XSTRING (pane_name)->data[0] == 0)
683 list_of_items (hmenu, lpmm, pane_data);
685 else
687 new_hmenu = list_of_items (NULL, lpmm, pane_data);
688 if (new_hmenu == NULL) goto error;
690 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
691 (char *) XSTRING (pane_name)->data);
695 else
697 Lisp_Object elt, pane_name, pane_data;
699 elt = Fcar (menu);
700 pane_name = Fcar (elt);
701 CHECK_STRING (pane_name, 0);
702 pane_data = Fcdr (elt);
703 CHECK_CONS (pane_data, 0);
704 hmenu = list_of_items (NULL, lpmm, pane_data);
706 return (hmenu);
708 error:
709 DestroyMenu (hmenu);
711 return (NULL);
714 /* Push the items in a single pane defined by the alist PANE. */
716 static HMENU
717 list_of_items (hmenu, lpmm, pane)
718 HMENU hmenu;
719 menu_map * lpmm;
720 Lisp_Object pane;
722 Lisp_Object tail, item, item1;
724 if (hmenu == NULL)
726 hmenu = CreatePopupMenu ();
727 if (hmenu == NULL) return NULL;
730 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
732 item = Fcar (tail);
733 if (STRINGP (item))
734 add_menu_item (lpmm, hmenu, item, 0, Qnil, Qnil);
735 else if (NILP (item))
736 add_left_right_boundary ();
737 else
739 CHECK_CONS (item, 0);
740 item1 = Fcar (item);
741 CHECK_STRING (item1, 1);
742 add_menu_item (lpmm, hmenu, item1, 1, Fcdr (item), Qnil);
746 return (hmenu);
750 HMENU
751 create_menu_items (lpmm, menu, notreal)
752 menu_map * lpmm;
753 Lisp_Object menu;
754 int notreal;
756 Lisp_Object title;
757 Lisp_Object keymap, tem;
758 HMENU hmenu;
760 title = Qnil;
762 /* Decode the menu items from what was specified. */
764 keymap = Fkeymapp (menu);
765 tem = Qnil;
766 if (XTYPE (menu) == Lisp_Cons)
767 tem = Fkeymapp (Fcar (menu));
769 if (!NILP (keymap))
771 /* We were given a keymap. Extract menu info from the keymap. */
772 Lisp_Object prompt;
773 keymap = get_keymap (menu);
775 /* Extract the detailed info to make one pane. */
776 hmenu = keymap_panes (lpmm, &keymap, 1, notreal);
778 #if 0
779 /* Search for a string appearing directly as an element of the keymap.
780 That string is the title of the menu. */
781 prompt = map_prompt (keymap);
783 /* Make that be the pane title of the first pane. */
784 if (!NILP (prompt) && menu_items_n_panes >= 0)
785 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
786 #endif
788 else if (!NILP (tem))
790 /* We were given a list of keymaps. */
791 int nmaps = XFASTINT (Flength (menu));
792 Lisp_Object *maps
793 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
794 int i;
796 title = Qnil;
798 /* The first keymap that has a prompt string
799 supplies the menu title. */
800 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
802 Lisp_Object prompt;
804 maps[i++] = keymap = get_keymap (Fcar (tem));
805 #if 0
806 prompt = map_prompt (keymap);
807 if (NILP (title) && !NILP (prompt))
808 title = prompt;
809 #endif
812 /* Extract the detailed info to make one pane. */
813 hmenu = keymap_panes (lpmm, maps, nmaps, notreal);
815 #if 0
816 /* Make the title be the pane title of the first pane. */
817 if (!NILP (title) && menu_items_n_panes >= 0)
818 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
819 #endif
821 else
823 /* We were given an old-fashioned menu. */
824 title = Fcar (menu);
825 CHECK_STRING (title, 1);
827 hmenu = list_of_panes (lpmm, Fcdr (menu));
830 return (hmenu);
833 /* This is a recursive subroutine of keymap_panes.
834 It handles one keymap, KEYMAP.
835 The other arguments are passed along
836 or point to local variables of the previous function.
837 If NOTREAL is nonzero,
838 don't bother really computing whether an item is enabled. */
840 Lisp_Object
841 get_single_keymap_event (keymap, lpnum)
842 Lisp_Object keymap;
843 int * lpnum;
845 Lisp_Object pending_maps;
846 Lisp_Object tail, item, item1, item_string, table;
847 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
849 pending_maps = Qnil;
851 for (tail = keymap; XTYPE (tail) == Lisp_Cons; tail = XCONS (tail)->cdr)
853 /* Look at each key binding, and if it has a menu string,
854 make a menu item from it. */
856 item = XCONS (tail)->car;
858 if (XTYPE (item) == Lisp_Cons)
860 item1 = XCONS (item)->cdr;
862 if (CONSP (item1))
864 item_string = XCONS (item1)->car;
865 if (XTYPE (item_string) == Lisp_String)
867 /* This is the real definition--the function to run. */
869 Lisp_Object def;
871 /* These are the saved equivalent keyboard key sequence
872 and its key-description. */
874 Lisp_Object descrip;
875 Lisp_Object tem, enabled;
877 /* GCPRO because ...enabled_p will call eval
878 and ..._equiv_key may autoload something.
879 Protecting KEYMAP preserves everything we use;
880 aside from that, must protect whatever might be
881 a string. Since there's no GCPRO5, we refetch
882 item_string instead of protecting it. */
884 descrip = def = Qnil;
885 GCPRO3 (keymap, pending_maps, def);
887 def = menu_item_equiv_key (item_string, item1, &descrip);
889 UNGCPRO;
891 item_string = XCONS (item1)->car;
893 tem = Fkeymapp (def);
894 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
896 pending_maps = Fcons (Fcons (def,
897 Fcons (item_string,
898 XCONS (item)->car)),
899 pending_maps);
901 else
903 Lisp_Object submap;
905 GCPRO5 (keymap, pending_maps, item, item_string, descrip);
907 submap = get_keymap_1 (def, 0, 1);
909 UNGCPRO;
911 if (NILP (submap))
913 if (--(*lpnum) == 0)
915 return (Fcons (XCONS (item)->car, Qnil));
918 else
919 /* Display a submenu. */
921 Lisp_Object event = get_single_keymap_event (submap,
922 lpnum);
924 if (*lpnum <= 0)
926 if (!NILP (XCONS (item)->car))
927 event = Fcons (XCONS (item)->car, event);
929 return (event);
936 else if (VECTORP (item))
938 /* Loop over the char values represented in the vector. */
939 int len = XVECTOR (item)->size;
940 int c;
941 for (c = 0; c < len; c++)
943 Lisp_Object character;
944 XSETFASTINT (character, c);
945 item1 = XVECTOR (item)->contents[c];
946 if (XTYPE (item1) == Lisp_Cons)
948 item_string = XCONS (item1)->car;
949 if (XTYPE (item_string) == Lisp_String)
951 Lisp_Object def;
953 /* These are the saved equivalent keyboard key sequence
954 and its key-description. */
955 Lisp_Object descrip;
956 Lisp_Object tem, enabled;
958 /* GCPRO because ...enabled_p will call eval
959 and ..._equiv_key may autoload something.
960 Protecting KEYMAP preserves everything we use;
961 aside from that, must protect whatever might be
962 a string. Since there's no GCPRO5, we refetch
963 item_string instead of protecting it. */
964 GCPRO3 (keymap, pending_maps, def);
965 descrip = def = Qnil;
967 def = menu_item_equiv_key (item_string, item1, &descrip);
969 UNGCPRO;
971 item_string = XCONS (item1)->car;
973 tem = Fkeymapp (def);
974 if (XSTRING (item_string)->data[0] == '@' && !NILP (tem))
975 pending_maps = Fcons (Fcons (def, Fcons (item_string, character)),
976 pending_maps);
977 else
979 Lisp_Object submap;
981 GCPRO5 (keymap, pending_maps, descrip, item_string, descrip);
983 submap = get_keymap_1 (def, 0, 1);
985 UNGCPRO;
987 if (NILP (submap))
989 if (--(*lpnum) == 0)
991 return (Fcons (character, Qnil));
994 else
995 /* Display a submenu. */
997 Lisp_Object event = get_single_keymap_event (submap,
998 lpnum);
1000 if (*lpnum <= 0)
1002 if (!NILP (character))
1003 event = Fcons (character, event);
1005 return (event);
1015 /* Process now any submenus which want to be panes at this level. */
1016 while (!NILP (pending_maps))
1018 Lisp_Object elt, eltcdr, string;
1019 elt = Fcar (pending_maps);
1020 eltcdr = XCONS (elt)->cdr;
1021 string = XCONS (eltcdr)->car;
1022 /* We no longer discard the @ from the beginning of the string here.
1023 Instead, we do this in w32menu_show. */
1025 Lisp_Object event = get_single_keymap_event (Fcar (elt), lpnum);
1027 if (*lpnum <= 0)
1029 if (!NILP (XCONS (eltcdr)->cdr))
1030 event = Fcons (XCONS (eltcdr)->cdr, event);
1032 return (event);
1036 pending_maps = Fcdr (pending_maps);
1039 return (Qnil);
1042 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
1043 and generate menu panes for them in menu_items.
1044 If NOTREAL is nonzero,
1045 don't bother really computing whether an item is enabled. */
1047 static Lisp_Object
1048 get_keymap_event (keymaps, nmaps, lpnum)
1049 Lisp_Object *keymaps;
1050 int nmaps;
1051 int * lpnum;
1053 int mapno;
1054 Lisp_Object event = Qnil;
1056 /* Loop over the given keymaps, making a pane for each map.
1057 But don't make a pane that is empty--ignore that map instead.
1058 P is the number of panes we have made so far. */
1059 for (mapno = 0; mapno < nmaps; mapno++)
1061 event = get_single_keymap_event (keymaps[mapno], lpnum);
1063 if (*lpnum <= 0) break;
1066 return (event);
1069 static Lisp_Object
1070 get_list_of_items_event (pane, lpnum)
1071 Lisp_Object pane;
1072 int * lpnum;
1074 Lisp_Object tail, item, item1;
1076 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
1078 item = Fcar (tail);
1079 if (STRINGP (item))
1081 if (-- (*lpnum) == 0)
1083 return (Qnil);
1086 else if (!NILP (item))
1088 if (--(*lpnum) == 0)
1090 CHECK_CONS (item, 0);
1091 return (Fcdr (item));
1096 return (Qnil);
1099 /* Push all the panes and items of a menu described by the
1100 alist-of-alists MENU.
1101 This handles old-fashioned calls to x-popup-menu. */
1103 static Lisp_Object
1104 get_list_of_panes_event (menu, lpnum)
1105 Lisp_Object menu;
1106 int * lpnum;
1108 Lisp_Object tail;
1110 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
1112 Lisp_Object elt, pane_name, pane_data;
1113 Lisp_Object event;
1115 elt = Fcar (tail);
1116 pane_data = Fcdr (elt);
1117 CHECK_CONS (pane_data, 0);
1119 event = get_list_of_items_event (pane_data, lpnum);
1121 if (*lpnum <= 0)
1123 return (event);
1127 return (Qnil);
1130 Lisp_Object
1131 get_menu_event (menu, lpnum)
1132 Lisp_Object menu;
1133 int * lpnum;
1135 Lisp_Object keymap, tem;
1136 Lisp_Object event;
1138 /* Decode the menu items from what was specified. */
1140 keymap = Fkeymapp (menu);
1141 tem = Qnil;
1142 if (XTYPE (menu) == Lisp_Cons)
1143 tem = Fkeymapp (Fcar (menu));
1145 if (!NILP (keymap))
1147 keymap = get_keymap (menu);
1149 event = get_keymap_event (&keymap, 1, lpnum);
1151 else if (!NILP (tem))
1153 /* We were given a list of keymaps. */
1154 int nmaps = XFASTINT (Flength (menu));
1155 Lisp_Object *maps
1156 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
1157 int i;
1159 /* The first keymap that has a prompt string
1160 supplies the menu title. */
1161 for (tem = menu, i = 0; XTYPE (tem) == Lisp_Cons; tem = Fcdr (tem))
1163 Lisp_Object prompt;
1165 maps[i++] = keymap = get_keymap (Fcar (tem));
1168 event = get_keymap_event (maps, nmaps, lpnum);
1170 else
1172 /* We were given an old-fashioned menu. */
1173 event = get_list_of_panes_event (Fcdr (menu), lpnum);
1176 return (event);
1179 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
1180 "Pop up a deck-of-cards menu and return user's selection.\n\
1181 POSITION is a position specification. This is either a mouse button event\n\
1182 or a list ((XOFFSET YOFFSET) WINDOW)\n\
1183 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
1184 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
1185 This controls the position of the center of the first line\n\
1186 in the first pane of the menu, not the top left of the menu as a whole.\n\
1187 If POSITION is t, it means to use the current mouse position.\n\
1189 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
1190 The menu items come from key bindings that have a menu string as well as\n\
1191 a definition; actually, the \"definition\" in such a key binding looks like\n\
1192 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
1193 the keymap as a top-level element.\n\n\
1194 You can also use a list of keymaps as MENU.\n\
1195 Then each keymap makes a separate pane.\n\
1196 When MENU is a keymap or a list of keymaps, the return value\n\
1197 is a list of events.\n\n\
1198 Alternatively, you can specify a menu of multiple panes\n\
1199 with a list of the form (TITLE PANE1 PANE2...),\n\
1200 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
1201 Each ITEM is normally a cons cell (STRING . VALUE);\n\
1202 but a string can appear as an item--that makes a nonselectable line\n\
1203 in the menu.\n\
1204 With this form of menu, the return value is VALUE from the chosen item.\n\
1206 If POSITION is nil, don't display the menu at all, just precalculate the\n\
1207 cached information about equivalent key sequences.")
1208 (position, menu)
1209 Lisp_Object position, menu;
1211 int number_of_panes, panes;
1212 Lisp_Object keymap, tem;
1213 int xpos, ypos;
1214 Lisp_Object title;
1215 char *error_name;
1216 Lisp_Object selection;
1217 int i, j;
1218 FRAME_PTR f;
1219 Lisp_Object x, y, window;
1220 int keymaps = 0;
1221 int menubarp = 0;
1222 struct gcpro gcpro1;
1223 HMENU hmenu;
1224 menu_map mm;
1226 if (! NILP (position))
1228 /* Decode the first argument: find the window and the coordinates. */
1229 if (EQ (position, Qt)
1230 || (CONSP (position) && EQ (XCONS (position)->car, Qmenu_bar)))
1232 /* Use the mouse's current position. */
1233 FRAME_PTR new_f = selected_frame;
1234 Lisp_Object bar_window;
1235 int part;
1236 unsigned long time;
1238 if (mouse_position_hook)
1239 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y,
1240 &time);
1241 if (new_f != 0)
1242 XSETFRAME (window, new_f);
1243 else
1245 window = selected_window;
1246 XSETFASTINT (x, 0);
1247 XSETFASTINT (y, 0);
1250 else
1252 tem = Fcar (position);
1253 if (CONSP (tem))
1255 window = Fcar (Fcdr (position));
1256 x = Fcar (tem);
1257 y = Fcar (Fcdr (tem));
1259 else
1261 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1262 window = Fcar (tem); /* POSN_WINDOW (tem) */
1263 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
1264 x = Fcar (tem);
1265 y = Fcdr (tem);
1267 /* Determine whether this menu is handling a menu bar click. */
1268 tem = Fcar (Fcdr (Fcar (Fcdr (position))));
1269 if (CONSP (tem) && EQ (Fcar (tem), Qmenu_bar))
1270 menubarp = 1;
1274 CHECK_NUMBER (x, 0);
1275 CHECK_NUMBER (y, 0);
1277 /* Decode where to put the menu. */
1279 if (FRAMEP (window))
1281 f = XFRAME (window);
1283 xpos = 0;
1284 ypos = 0;
1286 else if (WINDOWP (window))
1288 CHECK_LIVE_WINDOW (window, 0);
1289 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1291 xpos = (FONT_WIDTH (f->output_data.w32->font) * XWINDOW (window)->left);
1292 ypos = (f->output_data.w32->line_height * XWINDOW (window)->top);
1294 else
1295 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1296 but I don't want to make one now. */
1297 CHECK_WINDOW (window, 0);
1299 xpos += XINT (x);
1300 ypos += XINT (y);
1303 title = Qnil;
1304 GCPRO1 (title);
1306 discard_menu_items (&mm);
1307 hmenu = create_menu_items (&mm, menu, NILP (position));
1309 if (NILP (position))
1311 discard_menu_items (&mm);
1312 UNGCPRO;
1313 return Qnil;
1316 /* Display them in a menu. */
1317 BLOCK_INPUT;
1319 selection = w32menu_show (f, xpos, ypos, menu, hmenu, &error_name);
1321 UNBLOCK_INPUT;
1323 discard_menu_items (&mm);
1324 DestroyMenu (hmenu);
1326 UNGCPRO;
1328 if (error_name) error (error_name);
1329 return selection;
1332 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
1333 "Pop up a dialog box and return user's selection.\n\
1334 POSITION specifies which frame to use.\n\
1335 This is normally a mouse button event or a window or frame.\n\
1336 If POSITION is t, it means to use the frame the mouse is on.\n\
1337 The dialog box appears in the middle of the specified frame.\n\
1339 CONTENTS specifies the alternatives to display in the dialog box.\n\
1340 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
1341 Each ITEM is a cons cell (STRING . VALUE).\n\
1342 The return value is VALUE from the chosen item.\n\n\
1343 An ITEM may also be just a string--that makes a nonselectable item.\n\
1344 An ITEM may also be nil--that means to put all preceding items\n\
1345 on the left of the dialog box and all following items on the right.\n\
1346 \(By default, approximately half appear on each side.)")
1347 (position, contents)
1348 Lisp_Object position, contents;
1350 FRAME_PTR f;
1351 Lisp_Object window;
1353 /* Decode the first argument: find the window or frame to use. */
1354 if (EQ (position, Qt))
1356 /* Decode the first argument: find the window and the coordinates. */
1357 if (EQ (position, Qt))
1358 window = selected_window;
1360 else if (CONSP (position))
1362 Lisp_Object tem;
1363 tem = Fcar (position);
1364 if (XTYPE (tem) == Lisp_Cons)
1365 window = Fcar (Fcdr (position));
1366 else
1368 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
1369 window = Fcar (tem); /* POSN_WINDOW (tem) */
1372 else if (WINDOWP (position) || FRAMEP (position))
1373 window = position;
1375 /* Decode where to put the menu. */
1377 if (FRAMEP (window))
1378 f = XFRAME (window);
1379 else if (WINDOWP (window))
1381 CHECK_LIVE_WINDOW (window, 0);
1382 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
1384 else
1385 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
1386 but I don't want to make one now. */
1387 CHECK_WINDOW (window, 0);
1389 #if 1
1390 /* Display a menu with these alternatives
1391 in the middle of frame F. */
1393 Lisp_Object x, y, frame, newpos;
1394 XSETFRAME (frame, f);
1395 XSETINT (x, x_pixel_width (f) / 2);
1396 XSETINT (y, x_pixel_height (f) / 2);
1397 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
1399 return Fx_popup_menu (newpos,
1400 Fcons (Fcar (contents), Fcons (contents, Qnil)));
1402 #else
1404 Lisp_Object title;
1405 char *error_name;
1406 Lisp_Object selection;
1408 /* Decode the dialog items from what was specified. */
1409 title = Fcar (contents);
1410 CHECK_STRING (title, 1);
1412 list_of_panes (Fcons (contents, Qnil));
1414 /* Display them in a dialog box. */
1415 BLOCK_INPUT;
1416 selection = w32_dialog_show (f, 0, 0, title, &error_name);
1417 UNBLOCK_INPUT;
1419 discard_menu_items ();
1421 if (error_name) error (error_name);
1422 return selection;
1424 #endif
1427 Lisp_Object
1428 get_frame_menubar_event (f, num)
1429 FRAME_PTR f;
1430 int num;
1432 Lisp_Object tail, items;
1433 int i;
1434 struct gcpro gcpro1;
1436 BLOCK_INPUT;
1438 GCPRO1 (items);
1440 if (NILP (items = FRAME_MENU_BAR_ITEMS (f)))
1441 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1443 for (i = 0; i < XVECTOR (items)->size; i += 4)
1445 Lisp_Object event, binding;
1446 binding = XVECTOR (items)->contents[i + 2];
1448 /* Check to see if this might be a menubar button. It might be
1449 if it is not a keymap, it is a cons cell, its car is not a
1450 keymap, and its cdr is nil. */
1451 if (NILP (Fkeymapp (binding))
1452 && CONSP (binding)
1453 && NILP (Fkeymapp (XCONS (binding)->car))
1454 && NILP (XCONS (binding)->cdr))
1456 /* The fact that we have to check that this is a string here
1457 is the reason we don't do all this rigamarole in
1458 get_menu_event. */
1459 if (XTYPE (XVECTOR (items)->contents[i + 1]) == Lisp_String)
1461 /* This was a menubar button. */
1462 if (--num <= 0)
1464 UNGCPRO;
1465 UNBLOCK_INPUT;
1466 return (Fcons (XVECTOR (items)->contents[i], Qnil));
1470 else
1472 event = get_menu_event (binding, &num);
1474 if (num <= 0)
1476 UNGCPRO;
1477 UNBLOCK_INPUT;
1478 return (Fcons (XVECTOR (items)->contents[i], event));
1483 UNGCPRO;
1484 UNBLOCK_INPUT;
1486 return (Qnil);
1489 /* Activate the menu bar of frame F.
1490 This is called from keyboard.c when it gets the
1491 menu_bar_activate_event out of the Emacs event queue.
1493 To activate the menu bar, we signal to the input thread that it can
1494 return from the WM_INITMENU message, allowing the normal Windows
1495 processing of the menus.
1497 But first we recompute the menu bar contents (the whole tree).
1499 This way we can safely execute Lisp code. */
1501 x_activate_menubar (f)
1502 FRAME_PTR f;
1504 set_frame_menubar (f, 0, 1);
1506 /* Lock out further menubar changes while active. */
1507 f->output_data.w32->menubar_active = 1;
1509 /* Signal input thread to return from WM_INITMENU. */
1510 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
1513 void
1514 set_frame_menubar (f, first_time, deep_p)
1515 FRAME_PTR f;
1516 int first_time;
1517 int deep_p;
1519 Lisp_Object tail, items;
1520 HMENU hmenu;
1521 int i;
1522 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1523 menu_map mm;
1524 int count = specpdl_ptr - specpdl;
1526 struct buffer *prev = current_buffer;
1527 Lisp_Object buffer;
1529 /* We must not change the menubar when actually in use. */
1530 if (f->output_data.w32->menubar_active)
1531 return;
1533 #if 0 /* I don't see why this should be needed */
1534 /* Ensure menubar is up to date when about to be used. */
1535 if (f->output_data.w32->pending_menu_activation && !deep_p)
1536 deep_p = 1;
1537 #endif
1539 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1540 specbind (Qinhibit_quit, Qt);
1541 /* Don't let the debugger step into this code
1542 because it is not reentrant. */
1543 specbind (Qdebug_on_next_call, Qnil);
1545 record_unwind_protect (Fstore_match_data, Fmatch_data (Qnil, Qnil));
1546 if (NILP (Voverriding_local_map_menu_flag))
1548 specbind (Qoverriding_terminal_local_map, Qnil);
1549 specbind (Qoverriding_local_map, Qnil);
1552 set_buffer_internal_1 (XBUFFER (buffer));
1554 /* Run the Lucid hook. */
1555 call1 (Vrun_hooks, Qactivate_menubar_hook);
1556 /* If it has changed current-menubar from previous value,
1557 really recompute the menubar from the value. */
1558 if (! NILP (Vlucid_menu_bar_dirty_flag))
1559 call0 (Qrecompute_lucid_menubar);
1560 safe_run_hooks (Qmenu_bar_update_hook);
1562 BLOCK_INPUT;
1564 GCPRO1 (items);
1566 items = FRAME_MENU_BAR_ITEMS (f);
1567 if (NILP (items))
1568 items = FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1570 hmenu = f->output_data.w32->menubar_widget;
1571 if (!hmenu)
1573 hmenu = CreateMenu ();
1574 if (!hmenu) goto error;
1576 else
1578 /* Delete current contents. */
1579 while (DeleteMenu (hmenu, 0, MF_BYPOSITION))
1583 discard_menu_items (&mm);
1584 UNBLOCK_INPUT;
1586 for (i = 0; i < XVECTOR (items)->size; i += 4)
1588 Lisp_Object string, binding;
1589 int keymaps;
1590 CHAR *error;
1591 HMENU new_hmenu;
1593 string = XVECTOR (items)->contents[i + 1];
1594 if (NILP (string))
1595 break;
1597 binding = XVECTOR (items)->contents[i + 2];
1599 if (NILP (Fkeymapp (binding))
1600 && CONSP (binding)
1601 && NILP (Fkeymapp (XCONS (binding)->car))
1602 && NILP (XCONS (binding)->cdr))
1604 /* This is a menubar button. */
1605 Lisp_Object descrip, def;
1606 Lisp_Object enabled, item;
1607 item = Fcons (string, Fcar (binding));
1608 descrip = def = Qnil;
1609 UNGCPRO;
1610 GCPRO4 (items, item, def, string);
1612 def = menu_item_equiv_key (string, item, &descrip);
1613 enabled = menu_item_enabled_p (def, 0);
1615 UNGCPRO;
1616 GCPRO1 (items);
1618 add_menu_item (&mm, hmenu, string, enabled, def, Qnil);
1620 else
1622 /* Input must not be blocked here because we call general
1623 Lisp code and internal_condition_case_1. */
1624 new_hmenu = create_menu_items (&mm, binding, 0);
1626 if (!new_hmenu)
1627 continue;
1629 BLOCK_INPUT;
1630 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu,
1631 (char *) XSTRING (string)->data);
1632 UNBLOCK_INPUT;
1636 BLOCK_INPUT;
1638 HMENU old = f->output_data.w32->menubar_widget;
1639 SetMenu (FRAME_W32_WINDOW (f), hmenu);
1640 f->output_data.w32->menubar_widget = hmenu;
1641 /* Causes flicker when menu bar is updated
1642 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1644 /* Force the window size to be recomputed so that the frame's text
1645 area remains the same, if menubar has just been created. */
1646 if (old == NULL)
1647 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1650 error:
1651 set_buffer_internal_1 (prev);
1652 UNGCPRO;
1653 UNBLOCK_INPUT;
1654 unbind_to (count, Qnil);
1657 void
1658 free_frame_menubar (f)
1659 FRAME_PTR f;
1661 BLOCK_INPUT;
1664 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1665 SetMenu (FRAME_W32_WINDOW (f), NULL);
1666 f->output_data.w32->menubar_widget = NULL;
1667 DestroyMenu (old);
1670 UNBLOCK_INPUT;
1672 /* Called from Fw32_create_frame to create the initial menubar of a frame
1673 before it is mapped, so that the window is mapped with the menubar already
1674 there instead of us tacking it on later and thrashing the window after it
1675 is visible. */
1676 void
1677 initialize_frame_menubar (f)
1678 FRAME_PTR f;
1680 set_frame_menubar (f, 1, 1);
1683 #if 0
1684 /* If the mouse has moved to another menu bar item,
1685 return 1 and unread a button press event for that item.
1686 Otherwise return 0. */
1688 static int
1689 check_mouse_other_menu_bar (f)
1690 FRAME_PTR f;
1692 FRAME_PTR new_f;
1693 Lisp_Object bar_window;
1694 int part;
1695 Lisp_Object x, y;
1696 unsigned long time;
1698 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
1700 if (f == new_f && other_menu_bar_item_p (f, x, y))
1702 unread_menu_bar_button (f, x);
1703 return 1;
1706 return 0;
1708 #endif
1711 #if 0
1712 static HMENU
1713 create_menu (keymaps, error)
1714 int keymaps;
1715 char **error;
1717 HMENU hmenu = NULL; /* the menu we are currently working on */
1718 HMENU first_hmenu = NULL;
1720 HMENU *submenu_stack = (HMENU *) alloca (menu_items_used * sizeof (HMENU));
1721 Lisp_Object *subprefix_stack = (Lisp_Object *) alloca (menu_items_used *
1722 sizeof (Lisp_Object));
1723 int submenu_depth = 0;
1724 int i;
1726 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1728 *error = "Empty menu";
1729 return NULL;
1732 i = 0;
1734 /* Loop over all panes and items, filling in the tree. */
1736 while (i < menu_items_used)
1738 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1740 submenu_stack[submenu_depth++] = hmenu;
1741 i++;
1743 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1745 hmenu = submenu_stack[--submenu_depth];
1746 i++;
1748 #if 0
1749 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1750 && submenu_depth != 0)
1751 i += MENU_ITEMS_PANE_LENGTH;
1752 #endif
1753 /* Ignore a nil in the item list.
1754 It's meaningful only for dialog boxes. */
1755 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1756 i += 1;
1757 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1759 /* Create a new pane. */
1761 Lisp_Object pane_name;
1762 char *pane_string;
1764 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1765 pane_string = (NILP (pane_name) ? "" : (char *) XSTRING (pane_name)->data);
1767 if (!hmenu || strcmp (pane_string, ""))
1769 HMENU new_hmenu = CreatePopupMenu ();
1771 if (!new_hmenu)
1773 *error = "Could not create menu pane";
1774 goto error;
1777 if (hmenu)
1779 AppendMenu (hmenu, MF_POPUP, (UINT)new_hmenu, pane_string);
1782 hmenu = new_hmenu;
1784 if (!first_hmenu) first_hmenu = hmenu;
1786 i += MENU_ITEMS_PANE_LENGTH;
1788 else
1790 /* Create a new item within current pane. */
1792 Lisp_Object item_name, enable, descrip;
1793 UINT fuFlags;
1795 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1796 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1797 // descrip = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1799 if (name_is_separator (item_name))
1800 fuFlags = MF_SEPARATOR;
1801 else if (NILP (enable) || !XUINT (enable))
1802 fuFlags = MF_STRING | MF_GRAYED;
1803 else
1804 fuFlags = MF_STRING;
1806 AppendMenu (hmenu,
1807 fuFlags,
1809 (char *) XSTRING (item_name)->data);
1811 // if (!NILP (descrip))
1812 // hmenu->key = (char *) XSTRING (descrip)->data;
1814 i += MENU_ITEMS_ITEM_LENGTH;
1818 return (first_hmenu);
1820 error:
1821 if (first_hmenu) DestroyMenu (first_hmenu);
1822 return (NULL);
1825 #endif
1827 /* w32menu_show actually displays a menu using the panes and items in
1828 menu_items and returns the value selected from it.
1829 There are two versions of w32menu_show, one for Xt and one for Xlib.
1830 Both assume input is blocked by the caller. */
1832 /* F is the frame the menu is for.
1833 X and Y are the frame-relative specified position,
1834 relative to the inside upper left corner of the frame F.
1835 MENUBARP is 1 if the click that asked for this menu came from the menu bar.
1836 KEYMAPS is 1 if this menu was specified with keymaps;
1837 in that case, we return a list containing the chosen item's value
1838 and perhaps also the pane's prefix.
1839 TITLE is the specified menu title.
1840 ERROR is a place to store an error message string in case of failure.
1841 (We return nil on failure, but the value doesn't actually matter.) */
1844 static Lisp_Object
1845 w32menu_show (f, x, y, menu, hmenu, error)
1846 FRAME_PTR f;
1847 int x;
1848 int y;
1849 Lisp_Object menu;
1850 HMENU hmenu;
1851 char **error;
1853 int i , menu_selection;
1854 POINT pos;
1856 *error = NULL;
1858 if (!hmenu)
1860 *error = "Empty menu";
1861 return Qnil;
1864 pos.x = x;
1865 pos.y = y;
1867 /* Offset the coordinates to root-relative. */
1868 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1870 #if 0
1871 /* If the mouse moves out of the menu before we show the menu,
1872 don't show it at all. */
1873 if (check_mouse_other_menu_bar (f))
1875 DestroyMenu (hmenu);
1876 return Qnil;
1878 #endif
1880 /* Display the menu. */
1881 menu_selection = SendMessage (FRAME_W32_WINDOW (f),
1882 WM_EMACS_TRACKPOPUPMENU,
1883 (WPARAM)hmenu, (LPARAM)&pos);
1885 /* Clean up extraneous mouse events which might have been generated
1886 during the call. */
1887 discard_mouse_events ();
1889 if (menu_selection == -1)
1891 *error = "Invalid menu specification";
1892 return Qnil;
1895 /* Find the selected item, and its pane, to return
1896 the proper value. */
1898 #if 1
1899 if (menu_selection > 0)
1901 return get_menu_event (menu, &menu_selection);
1903 #else
1904 if (menu_selection > 0 && menu_selection <= lpmm->menu_items_used)
1906 return (XVECTOR (lpmm->menu_items)->contents[menu_selection - 1]);
1908 #endif
1910 return Qnil;
1913 #if 0
1914 static char * button_names [] =
1916 "button1", "button2", "button3", "button4", "button5",
1917 "button6", "button7", "button8", "button9", "button10"
1920 static Lisp_Object
1921 w32_dialog_show (f, menubarp, keymaps, title, error)
1922 FRAME_PTR f;
1923 int menubarp;
1924 int keymaps;
1925 Lisp_Object title;
1926 char **error;
1928 int i, nb_buttons=0;
1929 HMENU hmenu;
1930 char dialog_name[6];
1932 /* Number of elements seen so far, before boundary. */
1933 int left_count = 0;
1934 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1935 int boundary_seen = 0;
1937 *error = NULL;
1939 if (menu_items_n_panes > 1)
1941 *error = "Multiple panes in dialog box";
1942 return Qnil;
1945 /* Create a tree of widget_value objects
1946 representing the text label and buttons. */
1948 Lisp_Object pane_name, prefix;
1949 char *pane_string;
1950 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1951 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1952 pane_string = (NILP (pane_name)
1953 ? "" : (char *) XSTRING (pane_name)->data);
1954 prev_wv = malloc_widget_value ();
1955 prev_wv->value = pane_string;
1956 if (keymaps && !NILP (prefix))
1957 prev_wv->name++;
1958 prev_wv->enabled = 1;
1959 prev_wv->name = "message";
1960 first_wv = prev_wv;
1962 /* Loop over all panes and items, filling in the tree. */
1963 i = MENU_ITEMS_PANE_LENGTH;
1964 while (i < menu_items_used)
1967 /* Create a new item within current pane. */
1968 Lisp_Object item_name, enable, descrip;
1969 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1970 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1971 descrip
1972 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1974 if (NILP (item_name))
1976 free_menubar_widget_value_tree (first_wv);
1977 *error = "Submenu in dialog items";
1978 return Qnil;
1980 if (EQ (item_name, Qquote))
1982 /* This is the boundary between left-side elts
1983 and right-side elts. Stop incrementing right_count. */
1984 boundary_seen = 1;
1985 i++;
1986 continue;
1988 if (nb_buttons >= 10)
1990 free_menubar_widget_value_tree (first_wv);
1991 *error = "Too many dialog items";
1992 return Qnil;
1995 wv = malloc_widget_value ();
1996 prev_wv->next = wv;
1997 wv->name = (char *) button_names[nb_buttons];
1998 if (!NILP (descrip))
1999 wv->key = (char *) XSTRING (descrip)->data;
2000 wv->value = (char *) XSTRING (item_name)->data;
2001 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
2002 wv->enabled = !NILP (enable);
2003 prev_wv = wv;
2005 if (! boundary_seen)
2006 left_count++;
2008 nb_buttons++;
2009 i += MENU_ITEMS_ITEM_LENGTH;
2012 /* If the boundary was not specified,
2013 by default put half on the left and half on the right. */
2014 if (! boundary_seen)
2015 left_count = nb_buttons - nb_buttons / 2;
2017 wv = malloc_widget_value ();
2018 wv->name = dialog_name;
2020 /* Dialog boxes use a really stupid name encoding
2021 which specifies how many buttons to use
2022 and how many buttons are on the right.
2023 The Q means something also. */
2024 dialog_name[0] = 'Q';
2025 dialog_name[1] = '0' + nb_buttons;
2026 dialog_name[2] = 'B';
2027 dialog_name[3] = 'R';
2028 /* Number of buttons to put on the right. */
2029 dialog_name[4] = '0' + nb_buttons - left_count;
2030 dialog_name[5] = 0;
2031 wv->contents = first_wv;
2032 first_wv = wv;
2035 /* Actually create the dialog. */
2036 dialog_id = ++popup_id_tick;
2037 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2038 f->output_data.w32->widget, 1, 0,
2039 dialog_selection_callback, 0);
2040 #if 0 /* This causes crashes, and seems to be redundant -- rms. */
2041 lw_modify_all_widgets (dialog_id, first_wv, True);
2042 #endif
2043 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
2044 /* Free the widget_value objects we used to specify the contents. */
2045 free_menubar_widget_value_tree (first_wv);
2047 /* No selection has been chosen yet. */
2048 menu_item_selection = 0;
2050 /* Display the menu. */
2051 lw_pop_up_all_widgets (dialog_id);
2053 /* Process events that apply to the menu. */
2054 while (1)
2056 XEvent event;
2058 XtAppNextEvent (Xt_app_con, &event);
2059 if (event.type == ButtonRelease)
2061 XtDispatchEvent (&event);
2062 break;
2064 else if (event.type == Expose)
2065 process_expose_from_menu (event);
2066 XtDispatchEvent (&event);
2067 if (XtWindowToWidget(XDISPLAY event.xany.window) != menu)
2069 queue_tmp = (struct event_queue *) malloc (sizeof (struct event_queue));
2071 if (queue_tmp != NULL)
2073 queue_tmp->event = event;
2074 queue_tmp->next = queue;
2075 queue = queue_tmp;
2079 pop_down:
2081 /* State that no mouse buttons are now held.
2082 That is not necessarily true, but the fiction leads to reasonable
2083 results, and it is a pain to ask which are actually held now
2084 or track this in the loop above. */
2085 w32_mouse_grabbed = 0;
2087 /* Unread any events that we got but did not handle. */
2088 while (queue != NULL)
2090 queue_tmp = queue;
2091 XPutBackEvent (XDISPLAY &queue_tmp->event);
2092 queue = queue_tmp->next;
2093 free ((char *)queue_tmp);
2094 /* Cause these events to get read as soon as we UNBLOCK_INPUT. */
2095 interrupt_input_pending = 1;
2098 /* Find the selected item, and its pane, to return
2099 the proper value. */
2100 if (menu_item_selection != 0)
2102 Lisp_Object prefix;
2104 prefix = Qnil;
2105 i = 0;
2106 while (i < menu_items_used)
2108 Lisp_Object entry;
2110 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2112 prefix
2113 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2114 i += MENU_ITEMS_PANE_LENGTH;
2116 else
2118 entry
2119 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2120 if (menu_item_selection == &XVECTOR (menu_items)->contents[i])
2122 if (keymaps != 0)
2124 entry = Fcons (entry, Qnil);
2125 if (!NILP (prefix))
2126 entry = Fcons (prefix, entry);
2128 return entry;
2130 i += MENU_ITEMS_ITEM_LENGTH;
2135 return Qnil;
2137 #endif
2139 syms_of_w32menu ()
2141 Qdebug_on_next_call = intern ("debug-on-next-call");
2142 staticpro (&Qdebug_on_next_call);
2144 defsubr (&Sx_popup_menu);
2145 defsubr (&Sx_popup_dialog);