(List Motion): Note optional args.
[emacs.git] / src / w32menu.c
blob52baa248a469c55f88058ed0244b81618c88ac7b
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 88, 93, 94, 96, 98, 1999 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 #include <config.h>
22 #include <signal.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "termhooks.h"
27 #include "frame.h"
28 #include "window.h"
29 #include "keyboard.h"
30 #include "blockinput.h"
31 #include "buffer.h"
32 #include "charset.h"
33 #include "coding.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 #undef HAVE_MULTILINGUAL_MENU
48 #undef HAVE_DIALOGS /* NTEMACS_TODO: Implement native dialogs. */
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
53 typedef void * XtPointer;
54 typedef char Boolean;
56 #define True 1
57 #define False 0
59 enum button_type
61 BUTTON_TYPE_NONE,
62 BUTTON_TYPE_TOGGLE,
63 BUTTON_TYPE_RADIO
66 typedef struct _widget_value
68 /* name of widget */
69 char* name;
70 /* value (meaning depend on widget type) */
71 char* value;
72 /* keyboard equivalent. no implications for XtTranslations */
73 char* key;
74 /* Help string or null if none. */
75 char *help;
76 /* true if enabled */
77 Boolean enabled;
78 /* true if selected */
79 Boolean selected;
80 /* The type of a button. */
81 enum button_type button_type;
82 /* true if menu title */
83 Boolean title;
84 #if 0
85 /* true if was edited (maintained by get_value) */
86 Boolean edited;
87 /* true if has changed (maintained by lw library) */
88 change_type change;
89 /* true if this widget itself has changed,
90 but not counting the other widgets found in the `next' field. */
91 change_type this_one_change;
92 #endif
93 /* Contents of the sub-widgets, also selected slot for checkbox */
94 struct _widget_value* contents;
95 /* data passed to callback */
96 XtPointer call_data;
97 /* next one in the list */
98 struct _widget_value* next;
99 #if 0
100 /* slot for the toolkit dependent part. Always initialize to NULL. */
101 void* toolkit_data;
102 /* tell us if we should free the toolkit data slot when freeing the
103 widget_value itself. */
104 Boolean free_toolkit_data;
106 /* we resource the widget_value structures; this points to the next
107 one on the free list if this one has been deallocated.
109 struct _widget_value *free_list;
110 #endif
111 } widget_value;
113 /* LocalAlloc/Free is a reasonably good allocator. */
114 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
115 #define free_widget_value(wv) LocalFree (wv)
117 /******************************************************************/
119 #define min(x,y) (((x) < (y)) ? (x) : (y))
120 #define max(x,y) (((x) > (y)) ? (x) : (y))
122 #ifndef TRUE
123 #define TRUE 1
124 #define FALSE 0
125 #endif /* no TRUE */
127 Lisp_Object Vmenu_updating_frame;
129 Lisp_Object Qdebug_on_next_call;
131 extern Lisp_Object Qmenu_bar;
132 extern Lisp_Object Qmouse_click, Qevent_kind;
134 extern Lisp_Object QCtoggle, QCradio;
136 extern Lisp_Object Voverriding_local_map;
137 extern Lisp_Object Voverriding_local_map_menu_flag;
139 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
141 extern Lisp_Object Qmenu_bar_update_hook;
143 void set_frame_menubar ();
145 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
146 Lisp_Object, Lisp_Object, Lisp_Object,
147 Lisp_Object, Lisp_Object));
148 static Lisp_Object w32_dialog_show ();
149 static Lisp_Object w32_menu_show ();
151 static void keymap_panes ();
152 static void single_keymap_panes ();
153 static void single_menu_item ();
154 static void list_of_panes ();
155 static void list_of_items ();
157 /* This holds a Lisp vector that holds the results of decoding
158 the keymaps or alist-of-alists that specify a menu.
160 It describes the panes and items within the panes.
162 Each pane is described by 3 elements in the vector:
163 t, the pane name, the pane's prefix key.
164 Then follow the pane's items, with 5 elements per item:
165 the item string, the enable flag, the item's value,
166 the definition, and the equivalent keyboard key's description string.
168 In some cases, multiple levels of menus may be described.
169 A single vector slot containing nil indicates the start of a submenu.
170 A single vector slot containing lambda indicates the end of a submenu.
171 The submenu follows a menu item which is the way to reach the submenu.
173 A single vector slot containing quote indicates that the
174 following items should appear on the right of a dialog box.
176 Using a Lisp vector to hold this information while we decode it
177 takes care of protecting all the data from GC. */
179 #define MENU_ITEMS_PANE_NAME 1
180 #define MENU_ITEMS_PANE_PREFIX 2
181 #define MENU_ITEMS_PANE_LENGTH 3
183 enum menu_item_idx
185 MENU_ITEMS_ITEM_NAME = 0,
186 MENU_ITEMS_ITEM_ENABLE,
187 MENU_ITEMS_ITEM_VALUE,
188 MENU_ITEMS_ITEM_EQUIV_KEY,
189 MENU_ITEMS_ITEM_DEFINITION,
190 MENU_ITEMS_ITEM_TYPE,
191 MENU_ITEMS_ITEM_SELECTED,
192 MENU_ITEMS_ITEM_HELP,
193 MENU_ITEMS_ITEM_LENGTH
196 static Lisp_Object menu_items;
198 /* Number of slots currently allocated in menu_items. */
199 static int menu_items_allocated;
201 /* This is the index in menu_items of the first empty slot. */
202 static int menu_items_used;
204 /* The number of panes currently recorded in menu_items,
205 excluding those within submenus. */
206 static int menu_items_n_panes;
208 /* Current depth within submenus. */
209 static int menu_items_submenu_depth;
211 /* Flag which when set indicates a dialog or menu has been posted by
212 Xt on behalf of one of the widget sets. */
213 static int popup_activated_flag;
215 static int next_menubar_widget_id;
217 /* This is set nonzero after the user activates the menu bar, and set
218 to zero again after the menu bars are redisplayed by prepare_menu_bar.
219 While it is nonzero, all calls to set_frame_menubar go deep.
221 I don't understand why this is needed, but it does seem to be
222 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
224 int pending_menu_activation;
227 /* Return the frame whose ->output_data.w32->menubar_widget equals
228 ID, or 0 if none. */
230 static struct frame *
231 menubar_id_to_frame (id)
232 HMENU id;
234 Lisp_Object tail, frame;
235 FRAME_PTR f;
237 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
239 frame = XCAR (tail);
240 if (!GC_FRAMEP (frame))
241 continue;
242 f = XFRAME (frame);
243 if (!FRAME_WINDOW_P (f))
244 continue;
245 if (f->output_data.w32->menubar_widget == id)
246 return f;
248 return 0;
251 /* Initialize the menu_items structure if we haven't already done so.
252 Also mark it as currently empty. */
254 static void
255 init_menu_items ()
257 if (NILP (menu_items))
259 menu_items_allocated = 60;
260 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
263 menu_items_used = 0;
264 menu_items_n_panes = 0;
265 menu_items_submenu_depth = 0;
268 /* Call at the end of generating the data in menu_items.
269 This fills in the number of items in the last pane. */
271 static void
272 finish_menu_items ()
276 /* Call when finished using the data for the current menu
277 in menu_items. */
279 static void
280 discard_menu_items ()
282 /* Free the structure if it is especially large.
283 Otherwise, hold on to it, to save time. */
284 if (menu_items_allocated > 200)
286 menu_items = Qnil;
287 menu_items_allocated = 0;
291 /* Make the menu_items vector twice as large. */
293 static void
294 grow_menu_items ()
296 Lisp_Object old;
297 int old_size = menu_items_allocated;
298 old = menu_items;
300 menu_items_allocated *= 2;
301 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
302 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
303 old_size * sizeof (Lisp_Object));
306 /* Begin a submenu. */
308 static void
309 push_submenu_start ()
311 if (menu_items_used + 1 > menu_items_allocated)
312 grow_menu_items ();
314 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
315 menu_items_submenu_depth++;
318 /* End a submenu. */
320 static void
321 push_submenu_end ()
323 if (menu_items_used + 1 > menu_items_allocated)
324 grow_menu_items ();
326 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
327 menu_items_submenu_depth--;
330 /* Indicate boundary between left and right. */
332 static void
333 push_left_right_boundary ()
335 if (menu_items_used + 1 > menu_items_allocated)
336 grow_menu_items ();
338 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
341 /* Start a new menu pane in menu_items..
342 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
344 static void
345 push_menu_pane (name, prefix_vec)
346 Lisp_Object name, prefix_vec;
348 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
349 grow_menu_items ();
351 if (menu_items_submenu_depth == 0)
352 menu_items_n_panes++;
353 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
354 XVECTOR (menu_items)->contents[menu_items_used++] = name;
355 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
358 /* Push one menu item into the current pane. NAME is the string to
359 display. ENABLE if non-nil means this item can be selected. KEY
360 is the key generated by choosing this item, or nil if this item
361 doesn't really have a definition. DEF is the definition of this
362 item. EQUIV is the textual description of the keyboard equivalent
363 for this item (or nil if none). TYPE is the type of this menu
364 item, one of nil, `toggle' or `radio'. */
366 static void
367 push_menu_item (name, enable, key, def, equiv, type, selected, help)
368 Lisp_Object name, enable, key, def, equiv, type, selected, help;
370 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
371 grow_menu_items ();
373 XVECTOR (menu_items)->contents[menu_items_used++] = name;
374 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
375 XVECTOR (menu_items)->contents[menu_items_used++] = key;
376 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
377 XVECTOR (menu_items)->contents[menu_items_used++] = def;
378 XVECTOR (menu_items)->contents[menu_items_used++] = type;
379 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
380 XVECTOR (menu_items)->contents[menu_items_used++] = help;
383 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
384 and generate menu panes for them in menu_items.
385 If NOTREAL is nonzero,
386 don't bother really computing whether an item is enabled. */
388 static void
389 keymap_panes (keymaps, nmaps, notreal)
390 Lisp_Object *keymaps;
391 int nmaps;
392 int notreal;
394 int mapno;
396 init_menu_items ();
398 /* Loop over the given keymaps, making a pane for each map.
399 But don't make a pane that is empty--ignore that map instead.
400 P is the number of panes we have made so far. */
401 for (mapno = 0; mapno < nmaps; mapno++)
402 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
404 finish_menu_items ();
407 /* This is a recursive subroutine of keymap_panes.
408 It handles one keymap, KEYMAP.
409 The other arguments are passed along
410 or point to local variables of the previous function.
411 If NOTREAL is nonzero, only check for equivalent key bindings, don't
412 evaluate expressions in menu items and don't make any menu.
414 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
416 static void
417 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
418 Lisp_Object keymap;
419 Lisp_Object pane_name;
420 Lisp_Object prefix;
421 int notreal;
422 int maxdepth;
424 Lisp_Object pending_maps = Qnil;
425 Lisp_Object tail, item;
426 struct gcpro gcpro1, gcpro2;
428 if (maxdepth <= 0)
429 return;
431 push_menu_pane (pane_name, prefix);
433 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
435 GCPRO2 (keymap, pending_maps);
436 /* Look at each key binding, and if it is a menu item add it
437 to this menu. */
438 item = XCAR (tail);
439 if (CONSP (item))
440 single_menu_item (XCAR (item), XCDR (item),
441 &pending_maps, notreal, maxdepth);
442 else if (VECTORP (item))
444 /* Loop over the char values represented in the vector. */
445 int len = XVECTOR (item)->size;
446 int c;
447 for (c = 0; c < len; c++)
449 Lisp_Object character;
450 XSETFASTINT (character, c);
451 single_menu_item (character, XVECTOR (item)->contents[c],
452 &pending_maps, notreal, maxdepth);
455 UNGCPRO;
458 /* Process now any submenus which want to be panes at this level. */
459 while (!NILP (pending_maps))
461 Lisp_Object elt, eltcdr, string;
462 elt = Fcar (pending_maps);
463 eltcdr = XCDR (elt);
464 string = XCAR (eltcdr);
465 /* We no longer discard the @ from the beginning of the string here.
466 Instead, we do this in w32_menu_show. */
467 single_keymap_panes (Fcar (elt), string,
468 XCDR (eltcdr), notreal, maxdepth - 1);
469 pending_maps = Fcdr (pending_maps);
473 /* This is a subroutine of single_keymap_panes that handles one
474 keymap entry.
475 KEY is a key in a keymap and ITEM is its binding.
476 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
477 separate panes.
478 If NOTREAL is nonzero, only check for equivalent key bindings, don't
479 evaluate expressions in menu items and don't make any menu.
480 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
482 static void
483 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
484 Lisp_Object key, item;
485 Lisp_Object *pending_maps_ptr;
486 int maxdepth, notreal;
488 Lisp_Object map, item_string, enabled;
489 struct gcpro gcpro1, gcpro2;
490 int res;
492 /* Parse the menu item and leave the result in item_properties. */
493 GCPRO2 (key, item);
494 res = parse_menu_item (item, notreal, 0);
495 UNGCPRO;
496 if (!res)
497 return; /* Not a menu item. */
499 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
501 if (notreal)
503 /* We don't want to make a menu, just traverse the keymaps to
504 precompute equivalent key bindings. */
505 if (!NILP (map))
506 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
507 return;
510 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
511 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
513 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
515 if (!NILP (enabled))
516 /* An enabled separate pane. Remember this to handle it later. */
517 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
518 *pending_maps_ptr);
519 return;
522 push_menu_item (item_string, enabled, key,
523 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
524 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
525 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
526 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
527 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
529 /* Display a submenu using the toolkit. */
530 if (! (NILP (map) || NILP (enabled)))
532 push_submenu_start ();
533 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
534 push_submenu_end ();
538 /* Push all the panes and items of a menu described by the
539 alist-of-alists MENU.
540 This handles old-fashioned calls to x-popup-menu. */
542 static void
543 list_of_panes (menu)
544 Lisp_Object menu;
546 Lisp_Object tail;
548 init_menu_items ();
550 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
552 Lisp_Object elt, pane_name, pane_data;
553 elt = Fcar (tail);
554 pane_name = Fcar (elt);
555 CHECK_STRING (pane_name, 0);
556 push_menu_pane (pane_name, Qnil);
557 pane_data = Fcdr (elt);
558 CHECK_CONS (pane_data, 0);
559 list_of_items (pane_data);
562 finish_menu_items ();
565 /* Push the items in a single pane defined by the alist PANE. */
567 static void
568 list_of_items (pane)
569 Lisp_Object pane;
571 Lisp_Object tail, item, item1;
573 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
575 item = Fcar (tail);
576 if (STRINGP (item))
577 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
578 else if (NILP (item))
579 push_left_right_boundary ();
580 else
582 CHECK_CONS (item, 0);
583 item1 = Fcar (item);
584 CHECK_STRING (item1, 1);
585 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
590 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
591 "Pop up a deck-of-cards menu and return user's selection.\n\
592 POSITION is a position specification. This is either a mouse button event\n\
593 or a list ((XOFFSET YOFFSET) WINDOW)\n\
594 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
595 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
596 This controls the position of the center of the first line\n\
597 in the first pane of the menu, not the top left of the menu as a whole.\n\
598 If POSITION is t, it means to use the current mouse position.\n\
600 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
601 The menu items come from key bindings that have a menu string as well as\n\
602 a definition; actually, the \"definition\" in such a key binding looks like\n\
603 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
604 the keymap as a top-level element.\n\n\
605 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
606 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
608 You can also use a list of keymaps as MENU.\n\
609 Then each keymap makes a separate pane.\n\
610 When MENU is a keymap or a list of keymaps, the return value\n\
611 is a list of events.\n\n\
613 Alternatively, you can specify a menu of multiple panes\n\
614 with a list of the form (TITLE PANE1 PANE2...),\n\
615 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
616 Each ITEM is normally a cons cell (STRING . VALUE);\n\
617 but a string can appear as an item--that makes a nonselectable line\n\
618 in the menu.\n\
619 With this form of menu, the return value is VALUE from the chosen item.\n\
621 If POSITION is nil, don't display the menu at all, just precalculate the\n\
622 cached information about equivalent key sequences.")
623 (position, menu)
624 Lisp_Object position, menu;
626 Lisp_Object keymap, tem;
627 int xpos, ypos;
628 Lisp_Object title;
629 char *error_name;
630 Lisp_Object selection;
631 FRAME_PTR f;
632 Lisp_Object x, y, window;
633 int keymaps = 0;
634 int for_click = 0;
635 struct gcpro gcpro1;
637 #ifdef HAVE_MENUS
638 if (! NILP (position))
640 check_w32 ();
642 /* Decode the first argument: find the window and the coordinates. */
643 if (EQ (position, Qt)
644 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
646 /* Use the mouse's current position. */
647 FRAME_PTR new_f = SELECTED_FRAME ();
648 Lisp_Object bar_window;
649 enum scroll_bar_part part;
650 unsigned long time;
652 if (mouse_position_hook)
653 (*mouse_position_hook) (&new_f, 1, &bar_window,
654 &part, &x, &y, &time);
655 if (new_f != 0)
656 XSETFRAME (window, new_f);
657 else
659 window = selected_window;
660 XSETFASTINT (x, 0);
661 XSETFASTINT (y, 0);
664 else
666 tem = Fcar (position);
667 if (CONSP (tem))
669 window = Fcar (Fcdr (position));
670 x = Fcar (tem);
671 y = Fcar (Fcdr (tem));
673 else
675 for_click = 1;
676 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
677 window = Fcar (tem); /* POSN_WINDOW (tem) */
678 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
679 x = Fcar (tem);
680 y = Fcdr (tem);
684 CHECK_NUMBER (x, 0);
685 CHECK_NUMBER (y, 0);
687 /* Decode where to put the menu. */
689 if (FRAMEP (window))
691 f = XFRAME (window);
692 xpos = 0;
693 ypos = 0;
695 else if (WINDOWP (window))
697 CHECK_LIVE_WINDOW (window, 0);
698 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
700 xpos = (FONT_WIDTH (FRAME_FONT (f))
701 * XFASTINT (XWINDOW (window)->left));
702 ypos = (FRAME_LINE_HEIGHT (f)
703 * XFASTINT (XWINDOW (window)->top));
705 else
706 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
707 but I don't want to make one now. */
708 CHECK_WINDOW (window, 0);
710 xpos += XINT (x);
711 ypos += XINT (y);
713 XSETFRAME (Vmenu_updating_frame, f);
715 Vmenu_updating_frame = Qnil;
716 #endif /* HAVE_MENUS */
718 title = Qnil;
719 GCPRO1 (title);
721 /* Decode the menu items from what was specified. */
723 keymap = Fkeymapp (menu);
724 tem = Qnil;
725 if (CONSP (menu))
726 tem = Fkeymapp (Fcar (menu));
727 if (!NILP (keymap))
729 /* We were given a keymap. Extract menu info from the keymap. */
730 Lisp_Object prompt;
731 keymap = get_keymap (menu);
733 /* Extract the detailed info to make one pane. */
734 keymap_panes (&menu, 1, NILP (position));
736 /* Search for a string appearing directly as an element of the keymap.
737 That string is the title of the menu. */
738 prompt = map_prompt (keymap);
739 if (NILP (title) && !NILP (prompt))
740 title = prompt;
742 /* Make that be the pane title of the first pane. */
743 if (!NILP (prompt) && menu_items_n_panes >= 0)
744 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
746 keymaps = 1;
748 else if (!NILP (tem))
750 /* We were given a list of keymaps. */
751 int nmaps = XFASTINT (Flength (menu));
752 Lisp_Object *maps
753 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
754 int i;
756 title = Qnil;
758 /* The first keymap that has a prompt string
759 supplies the menu title. */
760 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
762 Lisp_Object prompt;
764 maps[i++] = keymap = get_keymap (Fcar (tem));
766 prompt = map_prompt (keymap);
767 if (NILP (title) && !NILP (prompt))
768 title = prompt;
771 /* Extract the detailed info to make one pane. */
772 keymap_panes (maps, nmaps, NILP (position));
774 /* Make the title be the pane title of the first pane. */
775 if (!NILP (title) && menu_items_n_panes >= 0)
776 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
778 keymaps = 1;
780 else
782 /* We were given an old-fashioned menu. */
783 title = Fcar (menu);
784 CHECK_STRING (title, 1);
786 list_of_panes (Fcdr (menu));
788 keymaps = 0;
791 if (NILP (position))
793 discard_menu_items ();
794 UNGCPRO;
795 return Qnil;
798 #ifdef HAVE_MENUS
799 /* Display them in a menu. */
800 BLOCK_INPUT;
802 selection = w32_menu_show (f, xpos, ypos, for_click,
803 keymaps, title, &error_name);
804 UNBLOCK_INPUT;
806 discard_menu_items ();
808 UNGCPRO;
809 #endif /* HAVE_MENUS */
811 if (error_name) error (error_name);
812 return selection;
815 #ifdef HAVE_MENUS
817 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
818 "Pop up a dialog box and return user's selection.\n\
819 POSITION specifies which frame to use.\n\
820 This is normally a mouse button event or a window or frame.\n\
821 If POSITION is t, it means to use the frame the mouse is on.\n\
822 The dialog box appears in the middle of the specified frame.\n\
824 CONTENTS specifies the alternatives to display in the dialog box.\n\
825 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
826 Each ITEM is a cons cell (STRING . VALUE).\n\
827 The return value is VALUE from the chosen item.\n\n\
828 An ITEM may also be just a string--that makes a nonselectable item.\n\
829 An ITEM may also be nil--that means to put all preceding items\n\
830 on the left of the dialog box and all following items on the right.\n\
831 \(By default, approximately half appear on each side.)")
832 (position, contents)
833 Lisp_Object position, contents;
835 FRAME_PTR f;
836 Lisp_Object window;
838 check_w32 ();
840 /* Decode the first argument: find the window or frame to use. */
841 if (EQ (position, Qt)
842 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
844 #if 0 /* Using the frame the mouse is on may not be right. */
845 /* Use the mouse's current position. */
846 FRAME_PTR new_f = SELECTED_FRAME ();
847 Lisp_Object bar_window;
848 int part;
849 unsigned long time;
850 Lisp_Object x, y;
852 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
854 if (new_f != 0)
855 XSETFRAME (window, new_f);
856 else
857 window = selected_window;
858 #endif
859 window = selected_window;
861 else if (CONSP (position))
863 Lisp_Object tem;
864 tem = Fcar (position);
865 if (CONSP (tem))
866 window = Fcar (Fcdr (position));
867 else
869 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
870 window = Fcar (tem); /* POSN_WINDOW (tem) */
873 else if (WINDOWP (position) || FRAMEP (position))
874 window = position;
875 else
876 window = Qnil;
878 /* Decode where to put the menu. */
880 if (FRAMEP (window))
881 f = XFRAME (window);
882 else if (WINDOWP (window))
884 CHECK_LIVE_WINDOW (window, 0);
885 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
887 else
888 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
889 but I don't want to make one now. */
890 CHECK_WINDOW (window, 0);
892 #ifndef HAVE_DIALOGS
893 /* Display a menu with these alternatives
894 in the middle of frame F. */
896 Lisp_Object x, y, frame, newpos;
897 XSETFRAME (frame, f);
898 XSETINT (x, x_pixel_width (f) / 2);
899 XSETINT (y, x_pixel_height (f) / 2);
900 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
902 return Fx_popup_menu (newpos,
903 Fcons (Fcar (contents), Fcons (contents, Qnil)));
905 #else /* HAVE_DIALOGS */
907 Lisp_Object title;
908 char *error_name;
909 Lisp_Object selection;
911 /* Decode the dialog items from what was specified. */
912 title = Fcar (contents);
913 CHECK_STRING (title, 1);
915 list_of_panes (Fcons (contents, Qnil));
917 /* Display them in a dialog box. */
918 BLOCK_INPUT;
919 selection = w32_dialog_show (f, 0, title, &error_name);
920 UNBLOCK_INPUT;
922 discard_menu_items ();
924 if (error_name) error (error_name);
925 return selection;
927 #endif /* HAVE_DIALOGS */
930 /* Activate the menu bar of frame F.
931 This is called from keyboard.c when it gets the
932 menu_bar_activate_event out of the Emacs event queue.
934 To activate the menu bar, we signal to the input thread that it can
935 return from the WM_INITMENU message, allowing the normal Windows
936 processing of the menus.
938 But first we recompute the menu bar contents (the whole tree).
940 This way we can safely execute Lisp code. */
942 void
943 x_activate_menubar (f)
944 FRAME_PTR f;
946 set_frame_menubar (f, 0, 1);
948 /* Lock out further menubar changes while active. */
949 f->output_data.w32->menubar_active = 1;
951 /* Signal input thread to return from WM_INITMENU. */
952 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
955 /* This callback is called from the menu bar pulldown menu
956 when the user makes a selection.
957 Figure out what the user chose
958 and put the appropriate events into the keyboard buffer. */
960 void
961 menubar_selection_callback (FRAME_PTR f, void * client_data)
963 Lisp_Object prefix, entry;
964 Lisp_Object vector;
965 Lisp_Object *subprefix_stack;
966 int submenu_depth = 0;
967 int i;
969 if (!f)
970 return;
971 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
972 vector = f->menu_bar_vector;
973 prefix = Qnil;
974 i = 0;
975 while (i < f->menu_bar_items_used)
977 if (EQ (XVECTOR (vector)->contents[i], Qnil))
979 subprefix_stack[submenu_depth++] = prefix;
980 prefix = entry;
981 i++;
983 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
985 prefix = subprefix_stack[--submenu_depth];
986 i++;
988 else if (EQ (XVECTOR (vector)->contents[i], Qt))
990 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
991 i += MENU_ITEMS_PANE_LENGTH;
993 else
995 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
996 /* The EMACS_INT cast avoids a warning. There's no problem
997 as long as pointers have enough bits to hold small integers. */
998 if ((int) (EMACS_INT) client_data == i)
1000 int j;
1001 struct input_event buf;
1002 Lisp_Object frame;
1004 XSETFRAME (frame, f);
1005 buf.kind = MENU_BAR_EVENT;
1006 buf.frame_or_window = frame;
1007 buf.arg = frame;
1008 kbd_buffer_store_event (&buf);
1010 for (j = 0; j < submenu_depth; j++)
1011 if (!NILP (subprefix_stack[j]))
1013 buf.kind = MENU_BAR_EVENT;
1014 buf.frame_or_window = frame;
1015 buf.arg = subprefix_stack[j];
1016 kbd_buffer_store_event (&buf);
1019 if (!NILP (prefix))
1021 buf.kind = MENU_BAR_EVENT;
1022 buf.frame_or_window = frame;
1023 buf.arg = prefix;
1024 kbd_buffer_store_event (&buf);
1027 buf.kind = MENU_BAR_EVENT;
1028 buf.frame_or_window = frame;
1029 buf.arg = entry;
1030 kbd_buffer_store_event (&buf);
1032 return;
1034 i += MENU_ITEMS_ITEM_LENGTH;
1039 /* Allocate a widget_value, blocking input. */
1041 widget_value *
1042 xmalloc_widget_value ()
1044 widget_value *value;
1046 BLOCK_INPUT;
1047 value = malloc_widget_value ();
1048 UNBLOCK_INPUT;
1050 return value;
1053 /* This recursively calls free_widget_value on the tree of widgets.
1054 It must free all data that was malloc'ed for these widget_values.
1055 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1056 must be left alone. */
1058 void
1059 free_menubar_widget_value_tree (wv)
1060 widget_value *wv;
1062 if (! wv) return;
1064 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1066 if (wv->contents && (wv->contents != (widget_value*)1))
1068 free_menubar_widget_value_tree (wv->contents);
1069 wv->contents = (widget_value *) 0xDEADBEEF;
1071 if (wv->next)
1073 free_menubar_widget_value_tree (wv->next);
1074 wv->next = (widget_value *) 0xDEADBEEF;
1076 BLOCK_INPUT;
1077 free_widget_value (wv);
1078 UNBLOCK_INPUT;
1081 /* Return a tree of widget_value structures for a menu bar item
1082 whose event type is ITEM_KEY (with string ITEM_NAME)
1083 and whose contents come from the list of keymaps MAPS. */
1085 static widget_value *
1086 single_submenu (item_key, item_name, maps)
1087 Lisp_Object item_key, item_name, maps;
1089 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1090 int i;
1091 int submenu_depth = 0;
1092 Lisp_Object length;
1093 int len;
1094 Lisp_Object *mapvec;
1095 widget_value **submenu_stack;
1096 int previous_items = menu_items_used;
1097 int top_level_items = 0;
1099 length = Flength (maps);
1100 len = XINT (length);
1102 /* Convert the list MAPS into a vector MAPVEC. */
1103 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1104 for (i = 0; i < len; i++)
1106 mapvec[i] = Fcar (maps);
1107 maps = Fcdr (maps);
1110 menu_items_n_panes = 0;
1112 /* Loop over the given keymaps, making a pane for each map.
1113 But don't make a pane that is empty--ignore that map instead. */
1114 for (i = 0; i < len; i++)
1116 if (SYMBOLP (mapvec[i])
1117 || (CONSP (mapvec[i])
1118 && NILP (Fkeymapp (mapvec[i]))))
1120 /* Here we have a command at top level in the menu bar
1121 as opposed to a submenu. */
1122 top_level_items = 1;
1123 push_menu_pane (Qnil, Qnil);
1124 push_menu_item (item_name, Qt, item_key, mapvec[i],
1125 Qnil, Qnil, Qnil, Qnil);
1127 else
1128 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1131 /* Create a tree of widget_value objects
1132 representing the panes and their items. */
1134 submenu_stack
1135 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1136 wv = xmalloc_widget_value ();
1137 wv->name = "menu";
1138 wv->value = 0;
1139 wv->enabled = 1;
1140 wv->button_type = BUTTON_TYPE_NONE;
1141 first_wv = wv;
1142 save_wv = 0;
1143 prev_wv = 0;
1145 /* Loop over all panes and items made during this call
1146 and construct a tree of widget_value objects.
1147 Ignore the panes and items made by previous calls to
1148 single_submenu, even though those are also in menu_items. */
1149 i = previous_items;
1150 while (i < menu_items_used)
1152 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1154 submenu_stack[submenu_depth++] = save_wv;
1155 save_wv = prev_wv;
1156 prev_wv = 0;
1157 i++;
1159 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1161 prev_wv = save_wv;
1162 save_wv = submenu_stack[--submenu_depth];
1163 i++;
1165 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1166 && submenu_depth != 0)
1167 i += MENU_ITEMS_PANE_LENGTH;
1168 /* Ignore a nil in the item list.
1169 It's meaningful only for dialog boxes. */
1170 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1171 i += 1;
1172 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1174 /* Create a new pane. */
1175 Lisp_Object pane_name, prefix;
1176 char *pane_string;
1177 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1178 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1179 #ifndef HAVE_MULTILINGUAL_MENU
1180 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1181 pane_name = ENCODE_SYSTEM (pane_name);
1182 #endif
1183 pane_string = (NILP (pane_name)
1184 ? "" : (char *) XSTRING (pane_name)->data);
1185 /* If there is just one top-level pane, put all its items directly
1186 under the top-level menu. */
1187 if (menu_items_n_panes == 1)
1188 pane_string = "";
1190 /* If the pane has a meaningful name,
1191 make the pane a top-level menu item
1192 with its items as a submenu beneath it. */
1193 if (strcmp (pane_string, ""))
1195 wv = xmalloc_widget_value ();
1196 if (save_wv)
1197 save_wv->next = wv;
1198 else
1199 first_wv->contents = wv;
1200 wv->name = pane_string;
1201 /* Ignore the @ that means "separate pane".
1202 This is a kludge, but this isn't worth more time. */
1203 if (!NILP (prefix) && wv->name[0] == '@')
1204 wv->name++;
1205 wv->value = 0;
1206 wv->enabled = 1;
1207 wv->button_type = BUTTON_TYPE_NONE;
1209 save_wv = wv;
1210 prev_wv = 0;
1211 i += MENU_ITEMS_PANE_LENGTH;
1213 else
1215 /* Create a new item within current pane. */
1216 Lisp_Object item_name, enable, descrip, def, type, selected;
1217 Lisp_Object help;
1219 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1220 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1221 descrip
1222 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1223 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1224 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1225 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1226 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1228 #ifndef HAVE_MULTILINGUAL_MENU
1229 if (STRING_MULTIBYTE (item_name))
1230 item_name = ENCODE_SYSTEM (item_name);
1231 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1232 descrip = ENCODE_SYSTEM (descrip);
1233 #endif
1235 wv = xmalloc_widget_value ();
1236 if (prev_wv)
1237 prev_wv->next = wv;
1238 else
1239 save_wv->contents = wv;
1241 wv->name = (char *) XSTRING (item_name)->data;
1242 if (!NILP (descrip))
1243 wv->key = (char *) XSTRING (descrip)->data;
1244 wv->value = 0;
1245 /* The EMACS_INT cast avoids a warning. There's no problem
1246 as long as pointers have enough bits to hold small integers. */
1247 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1248 wv->enabled = !NILP (enable);
1250 if (NILP (type))
1251 wv->button_type = BUTTON_TYPE_NONE;
1252 else if (EQ (type, QCradio))
1253 wv->button_type = BUTTON_TYPE_RADIO;
1254 else if (EQ (type, QCtoggle))
1255 wv->button_type = BUTTON_TYPE_TOGGLE;
1256 else
1257 abort ();
1259 wv->selected = !NILP (selected);
1260 if (STRINGP (help))
1261 wv->help = (char *) XSTRING (help)->data;
1262 else
1263 wv->help = NULL;
1265 prev_wv = wv;
1267 i += MENU_ITEMS_ITEM_LENGTH;
1271 /* If we have just one "menu item"
1272 that was originally a button, return it by itself. */
1273 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1275 wv = first_wv->contents;
1276 free_widget_value (first_wv);
1277 return wv;
1280 return first_wv;
1283 /* Set the contents of the menubar widgets of frame F.
1284 The argument FIRST_TIME is currently ignored;
1285 it is set the first time this is called, from initialize_frame_menubar. */
1287 void
1288 set_frame_menubar (f, first_time, deep_p)
1289 FRAME_PTR f;
1290 int first_time;
1291 int deep_p;
1293 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1294 Lisp_Object items;
1295 widget_value *wv, *first_wv, *prev_wv = 0;
1296 int i;
1298 /* We must not change the menubar when actually in use. */
1299 if (f->output_data.w32->menubar_active)
1300 return;
1302 XSETFRAME (Vmenu_updating_frame, f);
1304 if (! menubar_widget)
1305 deep_p = 1;
1306 else if (pending_menu_activation && !deep_p)
1307 deep_p = 1;
1309 wv = xmalloc_widget_value ();
1310 wv->name = "menubar";
1311 wv->value = 0;
1312 wv->enabled = 1;
1313 wv->button_type = BUTTON_TYPE_NONE;
1314 first_wv = wv;
1316 if (deep_p)
1318 /* Make a widget-value tree representing the entire menu trees. */
1320 struct buffer *prev = current_buffer;
1321 Lisp_Object buffer;
1322 int specpdl_count = specpdl_ptr - specpdl;
1323 int previous_menu_items_used = f->menu_bar_items_used;
1324 Lisp_Object *previous_items
1325 = (Lisp_Object *) alloca (previous_menu_items_used
1326 * sizeof (Lisp_Object));
1328 /* If we are making a new widget, its contents are empty,
1329 do always reinitialize them. */
1330 if (! menubar_widget)
1331 previous_menu_items_used = 0;
1333 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1334 specbind (Qinhibit_quit, Qt);
1335 /* Don't let the debugger step into this code
1336 because it is not reentrant. */
1337 specbind (Qdebug_on_next_call, Qnil);
1339 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1340 if (NILP (Voverriding_local_map_menu_flag))
1342 specbind (Qoverriding_terminal_local_map, Qnil);
1343 specbind (Qoverriding_local_map, Qnil);
1346 set_buffer_internal_1 (XBUFFER (buffer));
1348 /* Run the Lucid hook. */
1349 call1 (Vrun_hooks, Qactivate_menubar_hook);
1350 /* If it has changed current-menubar from previous value,
1351 really recompute the menubar from the value. */
1352 if (! NILP (Vlucid_menu_bar_dirty_flag))
1353 call0 (Qrecompute_lucid_menubar);
1354 safe_run_hooks (Qmenu_bar_update_hook);
1355 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1357 items = FRAME_MENU_BAR_ITEMS (f);
1359 inhibit_garbage_collection ();
1361 /* Save the frame's previous menu bar contents data. */
1362 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1363 previous_menu_items_used * sizeof (Lisp_Object));
1365 /* Fill in the current menu bar contents. */
1366 menu_items = f->menu_bar_vector;
1367 menu_items_allocated = XVECTOR (menu_items)->size;
1368 init_menu_items ();
1369 for (i = 0; i < XVECTOR (items)->size; i += 4)
1371 Lisp_Object key, string, maps;
1373 key = XVECTOR (items)->contents[i];
1374 string = XVECTOR (items)->contents[i + 1];
1375 maps = XVECTOR (items)->contents[i + 2];
1376 if (NILP (string))
1377 break;
1379 wv = single_submenu (key, string, maps);
1380 if (prev_wv)
1381 prev_wv->next = wv;
1382 else
1383 first_wv->contents = wv;
1384 /* Don't set wv->name here; GC during the loop might relocate it. */
1385 wv->enabled = 1;
1386 wv->button_type = BUTTON_TYPE_NONE;
1387 prev_wv = wv;
1390 finish_menu_items ();
1392 set_buffer_internal_1 (prev);
1393 unbind_to (specpdl_count, Qnil);
1395 /* If there has been no change in the Lisp-level contents
1396 of the menu bar, skip redisplaying it. Just exit. */
1398 for (i = 0; i < previous_menu_items_used; i++)
1399 if (menu_items_used == i
1400 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1401 break;
1402 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1404 free_menubar_widget_value_tree (first_wv);
1405 menu_items = Qnil;
1407 return;
1410 /* Now GC cannot happen during the lifetime of the widget_value,
1411 so it's safe to store data from a Lisp_String. */
1412 wv = first_wv->contents;
1413 for (i = 0; i < XVECTOR (items)->size; i += 4)
1415 Lisp_Object string;
1416 string = XVECTOR (items)->contents[i + 1];
1417 if (NILP (string))
1418 break;
1419 wv->name = (char *) XSTRING (string)->data;
1420 wv = wv->next;
1423 f->menu_bar_vector = menu_items;
1424 f->menu_bar_items_used = menu_items_used;
1425 menu_items = Qnil;
1427 else
1429 /* Make a widget-value tree containing
1430 just the top level menu bar strings. */
1432 items = FRAME_MENU_BAR_ITEMS (f);
1433 for (i = 0; i < XVECTOR (items)->size; i += 4)
1435 Lisp_Object string;
1437 string = XVECTOR (items)->contents[i + 1];
1438 if (NILP (string))
1439 break;
1441 wv = xmalloc_widget_value ();
1442 wv->name = (char *) XSTRING (string)->data;
1443 wv->value = 0;
1444 wv->enabled = 1;
1445 wv->button_type = BUTTON_TYPE_NONE;
1446 /* This prevents lwlib from assuming this
1447 menu item is really supposed to be empty. */
1448 /* The EMACS_INT cast avoids a warning.
1449 This value just has to be different from small integers. */
1450 wv->call_data = (void *) (EMACS_INT) (-1);
1452 if (prev_wv)
1453 prev_wv->next = wv;
1454 else
1455 first_wv->contents = wv;
1456 prev_wv = wv;
1459 /* Forget what we thought we knew about what is in the
1460 detailed contents of the menu bar menus.
1461 Changing the top level always destroys the contents. */
1462 f->menu_bar_items_used = 0;
1465 /* Create or update the menu bar widget. */
1467 BLOCK_INPUT;
1469 if (menubar_widget)
1471 /* Empty current menubar, rather than creating a fresh one. */
1472 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1475 else
1477 menubar_widget = CreateMenu ();
1479 fill_in_menu (menubar_widget, first_wv->contents);
1481 free_menubar_widget_value_tree (first_wv);
1484 HMENU old_widget = f->output_data.w32->menubar_widget;
1486 f->output_data.w32->menubar_widget = menubar_widget;
1487 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1488 /* Causes flicker when menu bar is updated
1489 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1491 /* Force the window size to be recomputed so that the frame's text
1492 area remains the same, if menubar has just been created. */
1493 if (old_widget == NULL)
1494 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1497 UNBLOCK_INPUT;
1500 /* Called from Fx_create_frame to create the initial menubar of a frame
1501 before it is mapped, so that the window is mapped with the menubar already
1502 there instead of us tacking it on later and thrashing the window after it
1503 is visible. */
1505 void
1506 initialize_frame_menubar (f)
1507 FRAME_PTR f;
1509 /* This function is called before the first chance to redisplay
1510 the frame. It has to be, so the frame will have the right size. */
1511 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1512 set_frame_menubar (f, 1, 1);
1515 /* Get rid of the menu bar of frame F, and free its storage.
1516 This is used when deleting a frame, and when turning off the menu bar. */
1518 void
1519 free_frame_menubar (f)
1520 FRAME_PTR f;
1522 BLOCK_INPUT;
1525 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1526 SetMenu (FRAME_W32_WINDOW (f), NULL);
1527 f->output_data.w32->menubar_widget = NULL;
1528 DestroyMenu (old);
1531 UNBLOCK_INPUT;
1535 /* w32_menu_show actually displays a menu using the panes and items in
1536 menu_items and returns the value selected from it; we assume input
1537 is blocked by the caller. */
1539 /* F is the frame the menu is for.
1540 X and Y are the frame-relative specified position,
1541 relative to the inside upper left corner of the frame F.
1542 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1543 KEYMAPS is 1 if this menu was specified with keymaps;
1544 in that case, we return a list containing the chosen item's value
1545 and perhaps also the pane's prefix.
1546 TITLE is the specified menu title.
1547 ERROR is a place to store an error message string in case of failure.
1548 (We return nil on failure, but the value doesn't actually matter.) */
1550 static Lisp_Object
1551 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1552 FRAME_PTR f;
1553 int x;
1554 int y;
1555 int for_click;
1556 int keymaps;
1557 Lisp_Object title;
1558 char **error;
1560 int i;
1561 int menu_item_selection;
1562 HMENU menu;
1563 POINT pos;
1564 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1565 widget_value **submenu_stack
1566 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1567 Lisp_Object *subprefix_stack
1568 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1569 int submenu_depth = 0;
1570 int first_pane;
1571 int next_release_must_exit = 0;
1573 *error = NULL;
1575 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1577 *error = "Empty menu";
1578 return Qnil;
1581 /* Create a tree of widget_value objects
1582 representing the panes and their items. */
1583 wv = xmalloc_widget_value ();
1584 wv->name = "menu";
1585 wv->value = 0;
1586 wv->enabled = 1;
1587 wv->button_type = BUTTON_TYPE_NONE;
1588 first_wv = wv;
1589 first_pane = 1;
1591 /* Loop over all panes and items, filling in the tree. */
1592 i = 0;
1593 while (i < menu_items_used)
1595 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1597 submenu_stack[submenu_depth++] = save_wv;
1598 save_wv = prev_wv;
1599 prev_wv = 0;
1600 first_pane = 1;
1601 i++;
1603 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1605 prev_wv = save_wv;
1606 save_wv = submenu_stack[--submenu_depth];
1607 first_pane = 0;
1608 i++;
1610 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1611 && submenu_depth != 0)
1612 i += MENU_ITEMS_PANE_LENGTH;
1613 /* Ignore a nil in the item list.
1614 It's meaningful only for dialog boxes. */
1615 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1616 i += 1;
1617 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1619 /* Create a new pane. */
1620 Lisp_Object pane_name, prefix;
1621 char *pane_string;
1622 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1623 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1624 #ifndef HAVE_MULTILINGUAL_MENU
1625 if (!NILP (pane_name) && STRING_MULTIBYTE (pane_name))
1626 pane_name = ENCODE_SYSTEM (pane_name);
1627 #endif
1628 pane_string = (NILP (pane_name)
1629 ? "" : (char *) XSTRING (pane_name)->data);
1630 /* If there is just one top-level pane, put all its items directly
1631 under the top-level menu. */
1632 if (menu_items_n_panes == 1)
1633 pane_string = "";
1635 /* If the pane has a meaningful name,
1636 make the pane a top-level menu item
1637 with its items as a submenu beneath it. */
1638 if (!keymaps && strcmp (pane_string, ""))
1640 wv = xmalloc_widget_value ();
1641 if (save_wv)
1642 save_wv->next = wv;
1643 else
1644 first_wv->contents = wv;
1645 wv->name = pane_string;
1646 if (keymaps && !NILP (prefix))
1647 wv->name++;
1648 wv->value = 0;
1649 wv->enabled = 1;
1650 wv->button_type = BUTTON_TYPE_NONE;
1651 save_wv = wv;
1652 prev_wv = 0;
1654 else if (first_pane)
1656 save_wv = wv;
1657 prev_wv = 0;
1659 first_pane = 0;
1660 i += MENU_ITEMS_PANE_LENGTH;
1662 else
1664 /* Create a new item within current pane. */
1665 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1667 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1668 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1669 descrip
1670 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1671 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1672 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1673 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1674 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1676 #ifndef HAVE_MULTILINGUAL_MENU
1677 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1678 item_name = ENCODE_SYSTEM (item_name);
1679 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1680 descrip = ENCODE_SYSTEM (descrip);
1681 #endif
1683 wv = xmalloc_widget_value ();
1684 if (prev_wv)
1685 prev_wv->next = wv;
1686 else
1687 save_wv->contents = wv;
1688 wv->name = (char *) XSTRING (item_name)->data;
1689 if (!NILP (descrip))
1690 wv->key = (char *) XSTRING (descrip)->data;
1691 wv->value = 0;
1692 /* Use the contents index as call_data, since we are
1693 restricted to 16-bits.. */
1694 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1695 wv->enabled = !NILP (enable);
1697 if (NILP (type))
1698 wv->button_type = BUTTON_TYPE_NONE;
1699 else if (EQ (type, QCtoggle))
1700 wv->button_type = BUTTON_TYPE_TOGGLE;
1701 else if (EQ (type, QCradio))
1702 wv->button_type = BUTTON_TYPE_RADIO;
1703 else
1704 abort ();
1706 wv->selected = !NILP (selected);
1708 if (STRINGP (help))
1709 wv->help = (char *) XSTRING (help)->data;
1710 else
1711 wv->help = NULL;
1713 prev_wv = wv;
1715 i += MENU_ITEMS_ITEM_LENGTH;
1719 /* Deal with the title, if it is non-nil. */
1720 if (!NILP (title))
1722 widget_value *wv_title = xmalloc_widget_value ();
1723 widget_value *wv_sep = xmalloc_widget_value ();
1725 /* Maybe replace this separator with a bitmap or owner-draw item
1726 so that it looks better. Having two separators looks odd. */
1727 wv_sep->name = "--";
1728 wv_sep->next = first_wv->contents;
1730 #ifndef HAVE_MULTILINGUAL_MENU
1731 if (STRING_MULTIBYTE (title))
1732 title = ENCODE_SYSTEM (title);
1733 #endif
1734 wv_title->name = (char *) XSTRING (title)->data;
1735 wv_title->enabled = True;
1736 wv_title->button_type = BUTTON_TYPE_NONE;
1737 wv_title->next = wv_sep;
1738 first_wv->contents = wv_title;
1741 /* Actually create the menu. */
1742 menu = CreatePopupMenu ();
1743 fill_in_menu (menu, first_wv->contents);
1745 /* Adjust coordinates to be root-window-relative. */
1746 pos.x = x;
1747 pos.y = y;
1748 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1750 /* No selection has been chosen yet. */
1751 menu_item_selection = 0;
1753 /* Display the menu. */
1754 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1755 WM_EMACS_TRACKPOPUPMENU,
1756 (WPARAM)menu, (LPARAM)&pos);
1758 /* Clean up extraneous mouse events which might have been generated
1759 during the call. */
1760 discard_mouse_events ();
1762 /* Free the widget_value objects we used to specify the contents. */
1763 free_menubar_widget_value_tree (first_wv);
1765 DestroyMenu (menu);
1767 /* Find the selected item, and its pane, to return
1768 the proper value. */
1769 if (menu_item_selection != 0)
1771 Lisp_Object prefix, entry;
1773 prefix = Qnil;
1774 i = 0;
1775 while (i < menu_items_used)
1777 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1779 subprefix_stack[submenu_depth++] = prefix;
1780 prefix = entry;
1781 i++;
1783 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1785 prefix = subprefix_stack[--submenu_depth];
1786 i++;
1788 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1790 prefix
1791 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1792 i += MENU_ITEMS_PANE_LENGTH;
1794 /* Ignore a nil in the item list.
1795 It's meaningful only for dialog boxes. */
1796 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1797 i += 1;
1798 else
1800 entry
1801 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1802 if (menu_item_selection == i)
1804 if (keymaps != 0)
1806 int j;
1808 entry = Fcons (entry, Qnil);
1809 if (!NILP (prefix))
1810 entry = Fcons (prefix, entry);
1811 for (j = submenu_depth - 1; j >= 0; j--)
1812 if (!NILP (subprefix_stack[j]))
1813 entry = Fcons (subprefix_stack[j], entry);
1815 return entry;
1817 i += MENU_ITEMS_ITEM_LENGTH;
1822 return Qnil;
1826 static char * button_names [] = {
1827 "button1", "button2", "button3", "button4", "button5",
1828 "button6", "button7", "button8", "button9", "button10" };
1830 static Lisp_Object
1831 w32_dialog_show (f, keymaps, title, error)
1832 FRAME_PTR f;
1833 int keymaps;
1834 Lisp_Object title;
1835 char **error;
1837 int i, nb_buttons=0;
1838 char dialog_name[6];
1839 int menu_item_selection;
1841 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1843 /* Number of elements seen so far, before boundary. */
1844 int left_count = 0;
1845 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1846 int boundary_seen = 0;
1848 *error = NULL;
1850 if (menu_items_n_panes > 1)
1852 *error = "Multiple panes in dialog box";
1853 return Qnil;
1856 /* Create a tree of widget_value objects
1857 representing the text label and buttons. */
1859 Lisp_Object pane_name, prefix;
1860 char *pane_string;
1861 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1862 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1863 pane_string = (NILP (pane_name)
1864 ? "" : (char *) XSTRING (pane_name)->data);
1865 prev_wv = xmalloc_widget_value ();
1866 prev_wv->value = pane_string;
1867 if (keymaps && !NILP (prefix))
1868 prev_wv->name++;
1869 prev_wv->enabled = 1;
1870 prev_wv->name = "message";
1871 first_wv = prev_wv;
1873 /* Loop over all panes and items, filling in the tree. */
1874 i = MENU_ITEMS_PANE_LENGTH;
1875 while (i < menu_items_used)
1878 /* Create a new item within current pane. */
1879 Lisp_Object item_name, enable, descrip, help;
1881 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1882 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1883 descrip
1884 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1885 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1887 if (NILP (item_name))
1889 free_menubar_widget_value_tree (first_wv);
1890 *error = "Submenu in dialog items";
1891 return Qnil;
1893 if (EQ (item_name, Qquote))
1895 /* This is the boundary between left-side elts
1896 and right-side elts. Stop incrementing right_count. */
1897 boundary_seen = 1;
1898 i++;
1899 continue;
1901 if (nb_buttons >= 9)
1903 free_menubar_widget_value_tree (first_wv);
1904 *error = "Too many dialog items";
1905 return Qnil;
1908 wv = xmalloc_widget_value ();
1909 prev_wv->next = wv;
1910 wv->name = (char *) button_names[nb_buttons];
1911 if (!NILP (descrip))
1912 wv->key = (char *) XSTRING (descrip)->data;
1913 wv->value = (char *) XSTRING (item_name)->data;
1914 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1915 wv->enabled = !NILP (enable);
1916 prev_wv = wv;
1918 if (! boundary_seen)
1919 left_count++;
1921 nb_buttons++;
1922 i += MENU_ITEMS_ITEM_LENGTH;
1925 /* If the boundary was not specified,
1926 by default put half on the left and half on the right. */
1927 if (! boundary_seen)
1928 left_count = nb_buttons - nb_buttons / 2;
1930 wv = xmalloc_widget_value ();
1931 wv->name = dialog_name;
1933 /* Dialog boxes use a really stupid name encoding
1934 which specifies how many buttons to use
1935 and how many buttons are on the right.
1936 The Q means something also. */
1937 dialog_name[0] = 'Q';
1938 dialog_name[1] = '0' + nb_buttons;
1939 dialog_name[2] = 'B';
1940 dialog_name[3] = 'R';
1941 /* Number of buttons to put on the right. */
1942 dialog_name[4] = '0' + nb_buttons - left_count;
1943 dialog_name[5] = 0;
1944 wv->contents = first_wv;
1945 first_wv = wv;
1948 /* Actually create the dialog. */
1949 #ifdef HAVE_DIALOGS
1950 dialog_id = widget_id_tick++;
1951 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1952 f->output_data.w32->widget, 1, 0,
1953 dialog_selection_callback, 0);
1954 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1955 #endif
1957 /* Free the widget_value objects we used to specify the contents. */
1958 free_menubar_widget_value_tree (first_wv);
1960 /* No selection has been chosen yet. */
1961 menu_item_selection = 0;
1963 /* Display the menu. */
1964 #ifdef HAVE_DIALOGS
1965 lw_pop_up_all_widgets (dialog_id);
1966 popup_activated_flag = 1;
1968 /* Process events that apply to the menu. */
1969 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1971 lw_destroy_all_widgets (dialog_id);
1972 #endif
1974 /* Find the selected item, and its pane, to return
1975 the proper value. */
1976 if (menu_item_selection != 0)
1978 Lisp_Object prefix;
1980 prefix = Qnil;
1981 i = 0;
1982 while (i < menu_items_used)
1984 Lisp_Object entry;
1986 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1988 prefix
1989 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1990 i += MENU_ITEMS_PANE_LENGTH;
1992 else
1994 entry
1995 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1996 if (menu_item_selection == i)
1998 if (keymaps != 0)
2000 entry = Fcons (entry, Qnil);
2001 if (!NILP (prefix))
2002 entry = Fcons (prefix, entry);
2004 return entry;
2006 i += MENU_ITEMS_ITEM_LENGTH;
2011 return Qnil;
2015 /* Is this item a separator? */
2016 static int
2017 name_is_separator (name)
2018 char *name;
2020 /* Check if name string consists of only dashes ('-') */
2021 while (*name == '-') name++;
2022 return (*name == '\0');
2026 /* Indicate boundary between left and right. */
2027 static int
2028 add_left_right_boundary (HMENU menu)
2030 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2033 static int
2034 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2036 UINT fuFlags;
2037 char *out_string;
2038 int return_value;
2040 if (name_is_separator (wv->name))
2041 fuFlags = MF_SEPARATOR;
2042 else
2044 if (wv->enabled)
2045 fuFlags = MF_STRING;
2046 else
2047 fuFlags = MF_STRING | MF_GRAYED;
2049 if (wv->key != NULL)
2051 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2052 strcpy (out_string, wv->name);
2053 strcat (out_string, "\t");
2054 strcat (out_string, wv->key);
2056 else
2057 out_string = wv->name;
2059 if (wv->title)
2061 #if 0 /* no GC while popup menu is active */
2062 out_string = LocalAlloc (0, strlen (wv->name) + 1);
2063 strcpy (out_string, wv->name);
2064 #endif
2065 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2068 /* Draw radio buttons and tickboxes. */
2070 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2071 wv->button_type == BUTTON_TYPE_RADIO))
2072 fuFlags |= MF_CHECKED;
2073 else
2074 fuFlags |= MF_UNCHECKED;
2077 if (item != NULL)
2078 fuFlags = MF_POPUP;
2080 return_value =
2081 AppendMenu (menu,
2082 fuFlags,
2083 item != NULL ? (UINT) item : (UINT) wv->call_data,
2084 (fuFlags == MF_SEPARATOR) ? NULL: out_string );
2086 /* This must be done after the menu item is created. */
2088 HMODULE user32 = GetModuleHandle ("user32.dll");
2089 FARPROC set_menu_item_info = GetProcAddress (user32, "SetMenuItemInfoA");
2091 if (set_menu_item_info)
2093 MENUITEMINFO info;
2094 bzero (&info, sizeof (info));
2095 info.cbSize = sizeof (info);
2096 info.fMask = MIIM_DATA;
2097 /* Set help string for menu item. */
2098 info.dwItemData = (DWORD)wv->help;
2100 if (wv->button_type == BUTTON_TYPE_RADIO)
2102 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2103 RADIO items, but is not available on NT 3.51 and earlier. */
2104 info.fMask |= MIIM_TYPE | MIIM_STATE;
2105 info.fType = MFT_RADIOCHECK;
2106 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2108 set_menu_item_info (menu,
2109 item != NULL ? (UINT) item : (UINT) wv->call_data,
2110 FALSE, &info);
2113 return return_value;
2116 /* Construct native Windows menu(bar) based on widget_value tree. */
2117 static int
2118 fill_in_menu (HMENU menu, widget_value *wv)
2120 int items_added = 0;
2122 for ( ; wv != NULL; wv = wv->next)
2124 if (wv->contents)
2126 HMENU sub_menu = CreatePopupMenu ();
2128 if (sub_menu == NULL)
2129 return 0;
2131 if (!fill_in_menu (sub_menu, wv->contents) ||
2132 !add_menu_item (menu, wv, sub_menu))
2134 DestroyMenu (sub_menu);
2135 return 0;
2138 else
2140 if (!add_menu_item (menu, wv, NULL))
2141 return 0;
2144 return 1;
2148 popup_activated ()
2150 /* popup_activated_flag not actually used on W32 */
2151 return 0;
2154 /* Display help string for currently pointed to menu item. Not
2155 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2156 available. */
2157 void
2158 w32_menu_display_help (HMENU menu, UINT item, UINT flags)
2160 HMODULE user32 = GetModuleHandle ("user32.dll");
2161 FARPROC get_menu_item_info = GetProcAddress (user32, "GetMenuItemInfoA");
2163 if (get_menu_item_info)
2165 MENUITEMINFO info;
2167 bzero (&info, sizeof (info));
2168 info.cbSize = sizeof (info);
2169 info.fMask = MIIM_DATA;
2170 get_menu_item_info (menu, item, FALSE, &info);
2172 show_help_echo (info.dwItemData ?
2173 build_string ((char *) info.dwItemData) : Qnil,
2174 Qnil, -1, 1);
2180 #endif /* HAVE_MENUS */
2182 syms_of_w32menu ()
2184 staticpro (&menu_items);
2185 menu_items = Qnil;
2187 Qdebug_on_next_call = intern ("debug-on-next-call");
2188 staticpro (&Qdebug_on_next_call);
2190 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2191 "Frame for which we are updating a menu.\n\
2192 The enable predicate for a menu command should check this variable.");
2193 Vmenu_updating_frame = Qnil;
2195 defsubr (&Sx_popup_menu);
2196 #ifdef HAVE_MENUS
2197 defsubr (&Sx_popup_dialog);
2198 #endif