Mention `delete-frame-functions' replacing `delete-frame-hook',
[emacs.git] / src / w32menu.c
blob44791448d9480e6227b1277d3fae57809755cc95
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 "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "blockinput.h"
32 #include "buffer.h"
33 #include "charset.h"
34 #include "coding.h"
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
38 #include "w32term.h"
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
42 #ifndef makedev
43 #include <sys/types.h>
44 #endif
46 #include "dispextern.h"
48 #undef HAVE_MULTILINGUAL_MENU
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
54 typedef void * XtPointer;
55 typedef char Boolean;
57 enum button_type
59 BUTTON_TYPE_NONE,
60 BUTTON_TYPE_TOGGLE,
61 BUTTON_TYPE_RADIO
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
65 for Windows. */
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 nil if none.
75 GC finds this string through the frame's menu_bar_vector
76 or through menu_items. */
77 Lisp_Object help;
78 /* true if enabled */
79 Boolean enabled;
80 /* true if selected */
81 Boolean selected;
82 /* The type of a button. */
83 enum button_type button_type;
84 /* true if menu title */
85 Boolean title;
86 #if 0
87 /* true if was edited (maintained by get_value) */
88 Boolean edited;
89 /* true if has changed (maintained by lw library) */
90 change_type change;
91 /* true if this widget itself has changed,
92 but not counting the other widgets found in the `next' field. */
93 change_type this_one_change;
94 #endif
95 /* Contents of the sub-widgets, also selected slot for checkbox */
96 struct _widget_value* contents;
97 /* data passed to callback */
98 XtPointer call_data;
99 /* next one in the list */
100 struct _widget_value* next;
101 #if 0
102 /* slot for the toolkit dependent part. Always initialize to NULL. */
103 void* toolkit_data;
104 /* tell us if we should free the toolkit data slot when freeing the
105 widget_value itself. */
106 Boolean free_toolkit_data;
108 /* we resource the widget_value structures; this points to the next
109 one on the free list if this one has been deallocated.
111 struct _widget_value *free_list;
112 #endif
113 } widget_value;
115 /* Local memory management */
116 #define local_heap (GetProcessHeap ())
117 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
118 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
120 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
121 #define free_widget_value(wv) (local_free ((wv)))
123 /******************************************************************/
125 #ifndef TRUE
126 #define TRUE 1
127 #define FALSE 0
128 #endif /* no TRUE */
130 static HMENU current_popup_menu;
132 FARPROC get_menu_item_info;
133 FARPROC set_menu_item_info;
135 Lisp_Object Vmenu_updating_frame;
137 Lisp_Object Qdebug_on_next_call;
139 extern Lisp_Object Qmenu_bar;
140 extern Lisp_Object Qmouse_click, Qevent_kind;
142 extern Lisp_Object QCtoggle, QCradio;
144 extern Lisp_Object Voverriding_local_map;
145 extern Lisp_Object Voverriding_local_map_menu_flag;
147 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
149 extern Lisp_Object Qmenu_bar_update_hook;
151 void set_frame_menubar ();
153 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
154 Lisp_Object, Lisp_Object, Lisp_Object,
155 Lisp_Object, Lisp_Object));
156 #ifdef HAVE_DIALOGS
157 static Lisp_Object w32_dialog_show ();
158 #endif
159 static Lisp_Object w32_menu_show ();
161 static void keymap_panes ();
162 static void single_keymap_panes ();
163 static void single_menu_item ();
164 static void list_of_panes ();
165 static void list_of_items ();
166 void w32_free_menu_strings (HWND);
168 /* This holds a Lisp vector that holds the results of decoding
169 the keymaps or alist-of-alists that specify a menu.
171 It describes the panes and items within the panes.
173 Each pane is described by 3 elements in the vector:
174 t, the pane name, the pane's prefix key.
175 Then follow the pane's items, with 5 elements per item:
176 the item string, the enable flag, the item's value,
177 the definition, and the equivalent keyboard key's description string.
179 In some cases, multiple levels of menus may be described.
180 A single vector slot containing nil indicates the start of a submenu.
181 A single vector slot containing lambda indicates the end of a submenu.
182 The submenu follows a menu item which is the way to reach the submenu.
184 A single vector slot containing quote indicates that the
185 following items should appear on the right of a dialog box.
187 Using a Lisp vector to hold this information while we decode it
188 takes care of protecting all the data from GC. */
190 #define MENU_ITEMS_PANE_NAME 1
191 #define MENU_ITEMS_PANE_PREFIX 2
192 #define MENU_ITEMS_PANE_LENGTH 3
194 enum menu_item_idx
196 MENU_ITEMS_ITEM_NAME = 0,
197 MENU_ITEMS_ITEM_ENABLE,
198 MENU_ITEMS_ITEM_VALUE,
199 MENU_ITEMS_ITEM_EQUIV_KEY,
200 MENU_ITEMS_ITEM_DEFINITION,
201 MENU_ITEMS_ITEM_TYPE,
202 MENU_ITEMS_ITEM_SELECTED,
203 MENU_ITEMS_ITEM_HELP,
204 MENU_ITEMS_ITEM_LENGTH
207 static Lisp_Object menu_items;
209 /* Number of slots currently allocated in menu_items. */
210 static int menu_items_allocated;
212 /* This is the index in menu_items of the first empty slot. */
213 static int menu_items_used;
215 /* The number of panes currently recorded in menu_items,
216 excluding those within submenus. */
217 static int menu_items_n_panes;
219 /* Current depth within submenus. */
220 static int menu_items_submenu_depth;
222 /* Flag which when set indicates a dialog or menu has been posted by
223 Xt on behalf of one of the widget sets. */
224 static int popup_activated_flag;
226 static int next_menubar_widget_id;
228 /* This is set nonzero after the user activates the menu bar, and set
229 to zero again after the menu bars are redisplayed by prepare_menu_bar.
230 While it is nonzero, all calls to set_frame_menubar go deep.
232 I don't understand why this is needed, but it does seem to be
233 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
235 int pending_menu_activation;
238 /* Return the frame whose ->output_data.w32->menubar_widget equals
239 ID, or 0 if none. */
241 static struct frame *
242 menubar_id_to_frame (id)
243 HMENU id;
245 Lisp_Object tail, frame;
246 FRAME_PTR f;
248 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
250 frame = XCAR (tail);
251 if (!GC_FRAMEP (frame))
252 continue;
253 f = XFRAME (frame);
254 if (!FRAME_WINDOW_P (f))
255 continue;
256 if (f->output_data.w32->menubar_widget == id)
257 return f;
259 return 0;
262 /* Initialize the menu_items structure if we haven't already done so.
263 Also mark it as currently empty. */
265 static void
266 init_menu_items ()
268 if (NILP (menu_items))
270 menu_items_allocated = 60;
271 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
274 menu_items_used = 0;
275 menu_items_n_panes = 0;
276 menu_items_submenu_depth = 0;
279 /* Call at the end of generating the data in menu_items.
280 This fills in the number of items in the last pane. */
282 static void
283 finish_menu_items ()
287 /* Call when finished using the data for the current menu
288 in menu_items. */
290 static void
291 discard_menu_items ()
293 /* Free the structure if it is especially large.
294 Otherwise, hold on to it, to save time. */
295 if (menu_items_allocated > 200)
297 menu_items = Qnil;
298 menu_items_allocated = 0;
302 /* Make the menu_items vector twice as large. */
304 static void
305 grow_menu_items ()
307 Lisp_Object old;
308 int old_size = menu_items_allocated;
309 old = menu_items;
311 menu_items_allocated *= 2;
312 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
313 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
314 old_size * sizeof (Lisp_Object));
317 /* Begin a submenu. */
319 static void
320 push_submenu_start ()
322 if (menu_items_used + 1 > menu_items_allocated)
323 grow_menu_items ();
325 ASET (menu_items, menu_items_used++, Qnil);
326 menu_items_submenu_depth++;
329 /* End a submenu. */
331 static void
332 push_submenu_end ()
334 if (menu_items_used + 1 > menu_items_allocated)
335 grow_menu_items ();
337 ASET (menu_items, menu_items_used++, Qlambda);
338 menu_items_submenu_depth--;
341 /* Indicate boundary between left and right. */
343 static void
344 push_left_right_boundary ()
346 if (menu_items_used + 1 > menu_items_allocated)
347 grow_menu_items ();
349 ASET (menu_items, menu_items_used++, Qquote);
352 /* Start a new menu pane in menu_items.
353 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
355 static void
356 push_menu_pane (name, prefix_vec)
357 Lisp_Object name, prefix_vec;
359 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
360 grow_menu_items ();
362 if (menu_items_submenu_depth == 0)
363 menu_items_n_panes++;
364 ASET (menu_items, menu_items_used++, Qt);
365 ASET (menu_items, menu_items_used++, name);
366 ASET (menu_items, menu_items_used++, prefix_vec);
369 /* Push one menu item into the current pane. NAME is the string to
370 display. ENABLE if non-nil means this item can be selected. KEY
371 is the key generated by choosing this item, or nil if this item
372 doesn't really have a definition. DEF is the definition of this
373 item. EQUIV is the textual description of the keyboard equivalent
374 for this item (or nil if none). TYPE is the type of this menu
375 item, one of nil, `toggle' or `radio'. */
377 static void
378 push_menu_item (name, enable, key, def, equiv, type, selected, help)
379 Lisp_Object name, enable, key, def, equiv, type, selected, help;
381 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
382 grow_menu_items ();
384 ASET (menu_items, menu_items_used++, name);
385 ASET (menu_items, menu_items_used++, enable);
386 ASET (menu_items, menu_items_used++, key);
387 ASET (menu_items, menu_items_used++, equiv);
388 ASET (menu_items, menu_items_used++, def);
389 ASET (menu_items, menu_items_used++, type);
390 ASET (menu_items, menu_items_used++, selected);
391 ASET (menu_items, menu_items_used++, help);
394 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
395 and generate menu panes for them in menu_items.
396 If NOTREAL is nonzero,
397 don't bother really computing whether an item is enabled. */
399 static void
400 keymap_panes (keymaps, nmaps, notreal)
401 Lisp_Object *keymaps;
402 int nmaps;
403 int notreal;
405 int mapno;
407 init_menu_items ();
409 /* Loop over the given keymaps, making a pane for each map.
410 But don't make a pane that is empty--ignore that map instead.
411 P is the number of panes we have made so far. */
412 for (mapno = 0; mapno < nmaps; mapno++)
413 single_keymap_panes (keymaps[mapno],
414 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
416 finish_menu_items ();
419 /* This is a recursive subroutine of keymap_panes.
420 It handles one keymap, KEYMAP.
421 The other arguments are passed along
422 or point to local variables of the previous function.
423 If NOTREAL is nonzero, only check for equivalent key bindings, don't
424 evaluate expressions in menu items and don't make any menu.
426 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
428 static void
429 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
430 Lisp_Object keymap;
431 Lisp_Object pane_name;
432 Lisp_Object prefix;
433 int notreal;
434 int maxdepth;
436 Lisp_Object pending_maps = Qnil;
437 Lisp_Object tail, item;
438 struct gcpro gcpro1, gcpro2;
440 if (maxdepth <= 0)
441 return;
443 push_menu_pane (pane_name, prefix);
445 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
447 GCPRO2 (keymap, pending_maps);
448 /* Look at each key binding, and if it is a menu item add it
449 to this menu. */
450 item = XCAR (tail);
451 if (CONSP (item))
452 single_menu_item (XCAR (item), XCDR (item),
453 &pending_maps, notreal, maxdepth);
454 else if (VECTORP (item))
456 /* Loop over the char values represented in the vector. */
457 int len = ASIZE (item);
458 int c;
459 for (c = 0; c < len; c++)
461 Lisp_Object character;
462 XSETFASTINT (character, c);
463 single_menu_item (character, AREF (item, c),
464 &pending_maps, notreal, maxdepth);
467 UNGCPRO;
470 /* Process now any submenus which want to be panes at this level. */
471 while (!NILP (pending_maps))
473 Lisp_Object elt, eltcdr, string;
474 elt = Fcar (pending_maps);
475 eltcdr = XCDR (elt);
476 string = XCAR (eltcdr);
477 /* We no longer discard the @ from the beginning of the string here.
478 Instead, we do this in w32_menu_show. */
479 single_keymap_panes (Fcar (elt), string,
480 XCDR (eltcdr), notreal, maxdepth - 1);
481 pending_maps = Fcdr (pending_maps);
485 /* This is a subroutine of single_keymap_panes that handles one
486 keymap entry.
487 KEY is a key in a keymap and ITEM is its binding.
488 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
489 separate panes.
490 If NOTREAL is nonzero, only check for equivalent key bindings, don't
491 evaluate expressions in menu items and don't make any menu.
492 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
494 static void
495 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
496 Lisp_Object key, item;
497 Lisp_Object *pending_maps_ptr;
498 int maxdepth, notreal;
500 Lisp_Object map, item_string, enabled;
501 struct gcpro gcpro1, gcpro2;
502 int res;
504 /* Parse the menu item and leave the result in item_properties. */
505 GCPRO2 (key, item);
506 res = parse_menu_item (item, notreal, 0);
507 UNGCPRO;
508 if (!res)
509 return; /* Not a menu item. */
511 map = AREF (item_properties, ITEM_PROPERTY_MAP);
513 if (notreal)
515 /* We don't want to make a menu, just traverse the keymaps to
516 precompute equivalent key bindings. */
517 if (!NILP (map))
518 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
519 return;
522 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
523 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
525 if (!NILP (map) && SREF (item_string, 0) == '@')
527 if (!NILP (enabled))
528 /* An enabled separate pane. Remember this to handle it later. */
529 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
530 *pending_maps_ptr);
531 return;
534 push_menu_item (item_string, enabled, key,
535 AREF (item_properties, ITEM_PROPERTY_DEF),
536 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
537 AREF (item_properties, ITEM_PROPERTY_TYPE),
538 AREF (item_properties, ITEM_PROPERTY_SELECTED),
539 AREF (item_properties, ITEM_PROPERTY_HELP));
541 /* Display a submenu using the toolkit. */
542 if (! (NILP (map) || NILP (enabled)))
544 push_submenu_start ();
545 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
546 push_submenu_end ();
550 /* Push all the panes and items of a menu described by the
551 alist-of-alists MENU.
552 This handles old-fashioned calls to x-popup-menu. */
554 static void
555 list_of_panes (menu)
556 Lisp_Object menu;
558 Lisp_Object tail;
560 init_menu_items ();
562 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
564 Lisp_Object elt, pane_name, pane_data;
565 elt = Fcar (tail);
566 pane_name = Fcar (elt);
567 CHECK_STRING (pane_name);
568 push_menu_pane (pane_name, Qnil);
569 pane_data = Fcdr (elt);
570 CHECK_CONS (pane_data);
571 list_of_items (pane_data);
574 finish_menu_items ();
577 /* Push the items in a single pane defined by the alist PANE. */
579 static void
580 list_of_items (pane)
581 Lisp_Object pane;
583 Lisp_Object tail, item, item1;
585 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
587 item = Fcar (tail);
588 if (STRINGP (item))
589 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
590 else if (NILP (item))
591 push_left_right_boundary ();
592 else
594 CHECK_CONS (item);
595 item1 = Fcar (item);
596 CHECK_STRING (item1);
597 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
602 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
603 doc: /* Pop up a deck-of-cards menu and return user's selection.
604 POSITION is a position specification. This is either a mouse button
605 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
606 are positions in pixels from the top left corner of WINDOW's frame
607 \(WINDOW may be a frame object instead of a window). This controls the
608 position of the center of the first line in the first pane of the
609 menu, not the top left of the menu as a whole. If POSITION is t, it
610 means to use the current mouse position.
612 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
613 The menu items come from key bindings that have a menu string as well as
614 a definition; actually, the \"definition\" in such a key binding looks like
615 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
616 the keymap as a top-level element.
618 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
619 Otherwise, REAL-DEFINITION should be a valid key binding definition.
621 You can also use a list of keymaps as MENU. Then each keymap makes a
622 separate pane. When MENU is a keymap or a list of keymaps, the return
623 value is a list of events.
625 Alternatively, you can specify a menu of multiple panes with a list of
626 the form (TITLE PANE1 PANE2...), where each pane is a list of
627 form (TITLE ITEM1 ITEM2...).
628 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
629 appear as an item--that makes a nonselectable line in the menu.
630 With this form of menu, the return value is VALUE from the chosen item.
632 If POSITION is nil, don't display the menu at all, just precalculate the
633 cached information about equivalent key sequences. */)
634 (position, menu)
635 Lisp_Object position, menu;
637 Lisp_Object keymap, tem;
638 int xpos = 0, ypos = 0;
639 Lisp_Object title;
640 char *error_name;
641 Lisp_Object selection;
642 FRAME_PTR f = NULL;
643 Lisp_Object x, y, window;
644 int keymaps = 0;
645 int for_click = 0;
646 struct gcpro gcpro1;
648 #ifdef HAVE_MENUS
649 if (! NILP (position))
651 check_w32 ();
653 /* Decode the first argument: find the window and the coordinates. */
654 if (EQ (position, Qt)
655 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
656 || EQ (XCAR (position), Qtool_bar))))
658 /* Use the mouse's current position. */
659 FRAME_PTR new_f = SELECTED_FRAME ();
660 Lisp_Object bar_window;
661 enum scroll_bar_part part;
662 unsigned long time;
664 if (mouse_position_hook)
665 (*mouse_position_hook) (&new_f, 1, &bar_window,
666 &part, &x, &y, &time);
667 if (new_f != 0)
668 XSETFRAME (window, new_f);
669 else
671 window = selected_window;
672 XSETFASTINT (x, 0);
673 XSETFASTINT (y, 0);
676 else
678 tem = Fcar (position);
679 if (CONSP (tem))
681 window = Fcar (Fcdr (position));
682 x = Fcar (tem);
683 y = Fcar (Fcdr (tem));
685 else
687 for_click = 1;
688 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
689 window = Fcar (tem); /* POSN_WINDOW (tem) */
690 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
691 x = Fcar (tem);
692 y = Fcdr (tem);
696 CHECK_NUMBER (x);
697 CHECK_NUMBER (y);
699 /* Decode where to put the menu. */
701 if (FRAMEP (window))
703 f = XFRAME (window);
704 xpos = 0;
705 ypos = 0;
707 else if (WINDOWP (window))
709 CHECK_LIVE_WINDOW (window);
710 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
712 xpos = (FONT_WIDTH (FRAME_FONT (f))
713 * XFASTINT (XWINDOW (window)->left));
714 ypos = (FRAME_LINE_HEIGHT (f)
715 * XFASTINT (XWINDOW (window)->top));
717 else
718 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
719 but I don't want to make one now. */
720 CHECK_WINDOW (window);
722 xpos += XINT (x);
723 ypos += XINT (y);
725 XSETFRAME (Vmenu_updating_frame, f);
727 Vmenu_updating_frame = Qnil;
728 #endif /* HAVE_MENUS */
730 title = Qnil;
731 GCPRO1 (title);
733 /* Decode the menu items from what was specified. */
735 keymap = get_keymap (menu, 0, 0);
736 if (CONSP (keymap))
738 /* We were given a keymap. Extract menu info from the keymap. */
739 Lisp_Object prompt;
741 /* Extract the detailed info to make one pane. */
742 keymap_panes (&menu, 1, NILP (position));
744 /* Search for a string appearing directly as an element of the keymap.
745 That string is the title of the menu. */
746 prompt = Fkeymap_prompt (keymap);
747 if (NILP (title) && !NILP (prompt))
748 title = prompt;
750 /* Make that be the pane title of the first pane. */
751 if (!NILP (prompt) && menu_items_n_panes >= 0)
752 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
754 keymaps = 1;
756 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
758 /* We were given a list of keymaps. */
759 int nmaps = XFASTINT (Flength (menu));
760 Lisp_Object *maps
761 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
762 int i;
764 title = Qnil;
766 /* The first keymap that has a prompt string
767 supplies the menu title. */
768 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
770 Lisp_Object prompt;
772 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
774 prompt = Fkeymap_prompt (keymap);
775 if (NILP (title) && !NILP (prompt))
776 title = prompt;
779 /* Extract the detailed info to make one pane. */
780 keymap_panes (maps, nmaps, NILP (position));
782 /* Make the title be the pane title of the first pane. */
783 if (!NILP (title) && menu_items_n_panes >= 0)
784 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
786 keymaps = 1;
788 else
790 /* We were given an old-fashioned menu. */
791 title = Fcar (menu);
792 CHECK_STRING (title);
794 list_of_panes (Fcdr (menu));
796 keymaps = 0;
799 if (NILP (position))
801 discard_menu_items ();
802 UNGCPRO;
803 return Qnil;
806 #ifdef HAVE_MENUS
807 /* If resources from a previous popup menu exist yet, does nothing
808 until the `menu_free_timer' has freed them (see w32fns.c).
810 if (current_popup_menu)
812 discard_menu_items ();
813 UNGCPRO;
814 return Qnil;
817 /* Display them in a menu. */
818 BLOCK_INPUT;
820 selection = w32_menu_show (f, xpos, ypos, for_click,
821 keymaps, title, &error_name);
822 UNBLOCK_INPUT;
824 discard_menu_items ();
825 #endif /* HAVE_MENUS */
827 UNGCPRO;
829 if (error_name) error (error_name);
830 return selection;
833 #ifdef HAVE_MENUS
835 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
836 doc: /* Pop up a dialog box and return user's selection.
837 POSITION specifies which frame to use.
838 This is normally a mouse button event or a window or frame.
839 If POSITION is t, it means to use the frame the mouse is on.
840 The dialog box appears in the middle of the specified frame.
842 CONTENTS specifies the alternatives to display in the dialog box.
843 It is a list of the form (TITLE ITEM1 ITEM2...).
844 Each ITEM is a cons cell (STRING . VALUE).
845 The return value is VALUE from the chosen item.
847 An ITEM may also be just a string--that makes a nonselectable item.
848 An ITEM may also be nil--that means to put all preceding items
849 on the left of the dialog box and all following items on the right.
850 \(By default, approximately half appear on each side.) */)
851 (position, contents)
852 Lisp_Object position, contents;
854 FRAME_PTR f = NULL;
855 Lisp_Object window;
857 check_w32 ();
859 /* Decode the first argument: find the window or frame to use. */
860 if (EQ (position, Qt)
861 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
862 || EQ (XCAR (position), Qtool_bar))))
864 #if 0 /* Using the frame the mouse is on may not be right. */
865 /* Use the mouse's current position. */
866 FRAME_PTR new_f = SELECTED_FRAME ();
867 Lisp_Object bar_window;
868 enum scroll_bar_part part;
869 unsigned long time;
870 Lisp_Object x, y;
872 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
874 if (new_f != 0)
875 XSETFRAME (window, new_f);
876 else
877 window = selected_window;
878 #endif
879 window = selected_window;
881 else if (CONSP (position))
883 Lisp_Object tem;
884 tem = Fcar (position);
885 if (CONSP (tem))
886 window = Fcar (Fcdr (position));
887 else
889 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
890 window = Fcar (tem); /* POSN_WINDOW (tem) */
893 else if (WINDOWP (position) || FRAMEP (position))
894 window = position;
895 else
896 window = Qnil;
898 /* Decode where to put the menu. */
900 if (FRAMEP (window))
901 f = XFRAME (window);
902 else if (WINDOWP (window))
904 CHECK_LIVE_WINDOW (window);
905 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
907 else
908 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
909 but I don't want to make one now. */
910 CHECK_WINDOW (window);
912 #ifndef HAVE_DIALOGS
913 /* Display a menu with these alternatives
914 in the middle of frame F. */
916 Lisp_Object x, y, frame, newpos;
917 XSETFRAME (frame, f);
918 XSETINT (x, x_pixel_width (f) / 2);
919 XSETINT (y, x_pixel_height (f) / 2);
920 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
922 return Fx_popup_menu (newpos,
923 Fcons (Fcar (contents), Fcons (contents, Qnil)));
925 #else /* HAVE_DIALOGS */
927 Lisp_Object title;
928 char *error_name;
929 Lisp_Object selection;
931 /* Decode the dialog items from what was specified. */
932 title = Fcar (contents);
933 CHECK_STRING (title);
935 list_of_panes (Fcons (contents, Qnil));
937 /* Display them in a dialog box. */
938 BLOCK_INPUT;
939 selection = w32_dialog_show (f, 0, title, &error_name);
940 UNBLOCK_INPUT;
942 discard_menu_items ();
944 if (error_name) error (error_name);
945 return selection;
947 #endif /* HAVE_DIALOGS */
950 /* Activate the menu bar of frame F.
951 This is called from keyboard.c when it gets the
952 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
954 To activate the menu bar, we signal to the input thread that it can
955 return from the WM_INITMENU message, allowing the normal Windows
956 processing of the menus.
958 But first we recompute the menu bar contents (the whole tree).
960 This way we can safely execute Lisp code. */
962 void
963 x_activate_menubar (f)
964 FRAME_PTR f;
966 set_frame_menubar (f, 0, 1);
968 /* Lock out further menubar changes while active. */
969 f->output_data.w32->menubar_active = 1;
971 /* Signal input thread to return from WM_INITMENU. */
972 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
975 /* This callback is called from the menu bar pulldown menu
976 when the user makes a selection.
977 Figure out what the user chose
978 and put the appropriate events into the keyboard buffer. */
980 void
981 menubar_selection_callback (FRAME_PTR f, void * client_data)
983 Lisp_Object prefix, entry;
984 Lisp_Object vector;
985 Lisp_Object *subprefix_stack;
986 int submenu_depth = 0;
987 int i;
989 if (!f)
990 return;
991 entry = Qnil;
992 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
993 vector = f->menu_bar_vector;
994 prefix = Qnil;
995 i = 0;
996 while (i < f->menu_bar_items_used)
998 if (EQ (AREF (vector, i), Qnil))
1000 subprefix_stack[submenu_depth++] = prefix;
1001 prefix = entry;
1002 i++;
1004 else if (EQ (AREF (vector, i), Qlambda))
1006 prefix = subprefix_stack[--submenu_depth];
1007 i++;
1009 else if (EQ (AREF (vector, i), Qt))
1011 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1012 i += MENU_ITEMS_PANE_LENGTH;
1014 else
1016 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1017 /* The EMACS_INT cast avoids a warning. There's no problem
1018 as long as pointers have enough bits to hold small integers. */
1019 if ((int) (EMACS_INT) client_data == i)
1021 int j;
1022 struct input_event buf;
1023 Lisp_Object frame;
1025 XSETFRAME (frame, f);
1026 buf.kind = MENU_BAR_EVENT;
1027 buf.frame_or_window = frame;
1028 buf.arg = frame;
1029 kbd_buffer_store_event (&buf);
1031 for (j = 0; j < submenu_depth; j++)
1032 if (!NILP (subprefix_stack[j]))
1034 buf.kind = MENU_BAR_EVENT;
1035 buf.frame_or_window = frame;
1036 buf.arg = subprefix_stack[j];
1037 kbd_buffer_store_event (&buf);
1040 if (!NILP (prefix))
1042 buf.kind = MENU_BAR_EVENT;
1043 buf.frame_or_window = frame;
1044 buf.arg = prefix;
1045 kbd_buffer_store_event (&buf);
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = entry;
1051 kbd_buffer_store_event (&buf);
1053 /* Free memory used by owner-drawn and help-echo strings. */
1054 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1055 f->output_data.w32->menu_command_in_progress = 0;
1056 f->output_data.w32->menubar_active = 0;
1057 return;
1059 i += MENU_ITEMS_ITEM_LENGTH;
1062 /* Free memory used by owner-drawn and help-echo strings. */
1063 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1064 f->output_data.w32->menu_command_in_progress = 0;
1065 f->output_data.w32->menubar_active = 0;
1068 /* Allocate a widget_value, blocking input. */
1070 widget_value *
1071 xmalloc_widget_value ()
1073 widget_value *value;
1075 BLOCK_INPUT;
1076 value = malloc_widget_value ();
1077 UNBLOCK_INPUT;
1079 return value;
1082 /* This recursively calls free_widget_value on the tree of widgets.
1083 It must free all data that was malloc'ed for these widget_values.
1084 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1085 must be left alone. */
1087 void
1088 free_menubar_widget_value_tree (wv)
1089 widget_value *wv;
1091 if (! wv) return;
1093 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1095 if (wv->contents && (wv->contents != (widget_value*)1))
1097 free_menubar_widget_value_tree (wv->contents);
1098 wv->contents = (widget_value *) 0xDEADBEEF;
1100 if (wv->next)
1102 free_menubar_widget_value_tree (wv->next);
1103 wv->next = (widget_value *) 0xDEADBEEF;
1105 BLOCK_INPUT;
1106 free_widget_value (wv);
1107 UNBLOCK_INPUT;
1110 /* Set up data i menu_items for a menu bar item
1111 whose event type is ITEM_KEY (with string ITEM_NAME)
1112 and whose contents come from the list of keymaps MAPS. */
1114 static int
1115 parse_single_submenu (item_key, item_name, maps)
1116 Lisp_Object item_key, item_name, maps;
1118 Lisp_Object length;
1119 int len;
1120 Lisp_Object *mapvec;
1121 int i;
1122 int top_level_items = 0;
1124 length = Flength (maps);
1125 len = XINT (length);
1127 /* Convert the list MAPS into a vector MAPVEC. */
1128 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1129 for (i = 0; i < len; i++)
1131 mapvec[i] = Fcar (maps);
1132 maps = Fcdr (maps);
1135 /* Loop over the given keymaps, making a pane for each map.
1136 But don't make a pane that is empty--ignore that map instead. */
1137 for (i = 0; i < len; i++)
1139 if (SYMBOLP (mapvec[i])
1140 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1142 /* Here we have a command at top level in the menu bar
1143 as opposed to a submenu. */
1144 top_level_items = 1;
1145 push_menu_pane (Qnil, Qnil);
1146 push_menu_item (item_name, Qt, item_key, mapvec[i],
1147 Qnil, Qnil, Qnil, Qnil);
1149 else
1150 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1153 return top_level_items;
1157 /* Create a tree of widget_value objects
1158 representing the panes and items
1159 in menu_items starting at index START, up to index END. */
1161 static widget_value *
1162 digest_single_submenu (start, end, top_level_items)
1163 int start, end;
1165 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1166 int i;
1167 int submenu_depth = 0;
1168 widget_value **submenu_stack;
1170 submenu_stack
1171 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1172 wv = xmalloc_widget_value ();
1173 wv->name = "menu";
1174 wv->value = 0;
1175 wv->enabled = 1;
1176 wv->button_type = BUTTON_TYPE_NONE;
1177 wv->help = Qnil;
1178 first_wv = wv;
1179 save_wv = 0;
1180 prev_wv = 0;
1182 /* Loop over all panes and items made during this call
1183 and construct a tree of widget_value objects.
1184 Ignore the panes and items made by previous calls to
1185 single_submenu, even though those are also in menu_items. */
1186 i = start;
1187 while (i < end)
1189 if (EQ (AREF (menu_items, i), Qnil))
1191 submenu_stack[submenu_depth++] = save_wv;
1192 save_wv = prev_wv;
1193 prev_wv = 0;
1194 i++;
1196 else if (EQ (AREF (menu_items, i), Qlambda))
1198 prev_wv = save_wv;
1199 save_wv = submenu_stack[--submenu_depth];
1200 i++;
1202 else if (EQ (AREF (menu_items, i), Qt)
1203 && submenu_depth != 0)
1204 i += MENU_ITEMS_PANE_LENGTH;
1205 /* Ignore a nil in the item list.
1206 It's meaningful only for dialog boxes. */
1207 else if (EQ (AREF (menu_items, i), Qquote))
1208 i += 1;
1209 else if (EQ (AREF (menu_items, i), Qt))
1211 /* Create a new pane. */
1212 Lisp_Object pane_name, prefix;
1213 char *pane_string;
1215 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1216 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1218 #ifndef HAVE_MULTILINGUAL_MENU
1219 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1221 pane_name = ENCODE_SYSTEM (pane_name);
1222 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1224 #endif
1225 pane_string = (NILP (pane_name)
1226 ? "" : (char *) SDATA (pane_name));
1227 /* If there is just one top-level pane, put all its items directly
1228 under the top-level menu. */
1229 if (menu_items_n_panes == 1)
1230 pane_string = "";
1232 /* If the pane has a meaningful name,
1233 make the pane a top-level menu item
1234 with its items as a submenu beneath it. */
1235 if (strcmp (pane_string, ""))
1237 wv = xmalloc_widget_value ();
1238 if (save_wv)
1239 save_wv->next = wv;
1240 else
1241 first_wv->contents = wv;
1242 wv->name = pane_string;
1243 /* Ignore the @ that means "separate pane".
1244 This is a kludge, but this isn't worth more time. */
1245 if (!NILP (prefix) && wv->name[0] == '@')
1246 wv->name++;
1247 wv->value = 0;
1248 wv->enabled = 1;
1249 wv->button_type = BUTTON_TYPE_NONE;
1250 wv->help = Qnil;
1252 save_wv = wv;
1253 prev_wv = 0;
1254 i += MENU_ITEMS_PANE_LENGTH;
1256 else
1258 /* Create a new item within current pane. */
1259 Lisp_Object item_name, enable, descrip, def, type, selected;
1260 Lisp_Object help;
1262 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1263 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1264 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1265 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1266 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1267 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1268 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1270 #ifndef HAVE_MULTILINGUAL_MENU
1271 if (STRING_MULTIBYTE (item_name))
1273 item_name = ENCODE_SYSTEM (item_name);
1274 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1277 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1279 descrip = ENCODE_SYSTEM (descrip);
1280 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1282 #endif /* not HAVE_MULTILINGUAL_MENU */
1284 wv = xmalloc_widget_value ();
1285 if (prev_wv)
1286 prev_wv->next = wv;
1287 else
1288 save_wv->contents = wv;
1290 wv->name = (char *) SDATA (item_name);
1291 if (!NILP (descrip))
1292 wv->key = (char *) SDATA (descrip);
1293 wv->value = 0;
1294 /* The EMACS_INT cast avoids a warning. There's no problem
1295 as long as pointers have enough bits to hold small integers. */
1296 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1297 wv->enabled = !NILP (enable);
1299 if (NILP (type))
1300 wv->button_type = BUTTON_TYPE_NONE;
1301 else if (EQ (type, QCradio))
1302 wv->button_type = BUTTON_TYPE_RADIO;
1303 else if (EQ (type, QCtoggle))
1304 wv->button_type = BUTTON_TYPE_TOGGLE;
1305 else
1306 abort ();
1308 wv->selected = !NILP (selected);
1309 if (!STRINGP (help))
1310 help = Qnil;
1312 wv->help = help;
1314 prev_wv = wv;
1316 i += MENU_ITEMS_ITEM_LENGTH;
1320 /* If we have just one "menu item"
1321 that was originally a button, return it by itself. */
1322 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1324 wv = first_wv->contents;
1325 free_widget_value (first_wv);
1326 return wv;
1329 return first_wv;
1332 /* Set the contents of the menubar widgets of frame F.
1333 The argument FIRST_TIME is currently ignored;
1334 it is set the first time this is called, from initialize_frame_menubar. */
1336 void
1337 set_frame_menubar (f, first_time, deep_p)
1338 FRAME_PTR f;
1339 int first_time;
1340 int deep_p;
1342 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1343 Lisp_Object items;
1344 widget_value *wv, *first_wv, *prev_wv = 0;
1345 int i, last_i;
1346 int *submenu_start, *submenu_end;
1347 int *submenu_top_level_items;
1349 /* We must not change the menubar when actually in use. */
1350 if (f->output_data.w32->menubar_active)
1351 return;
1353 XSETFRAME (Vmenu_updating_frame, f);
1355 if (! menubar_widget)
1356 deep_p = 1;
1357 else if (pending_menu_activation && !deep_p)
1358 deep_p = 1;
1360 if (deep_p)
1362 /* Make a widget-value tree representing the entire menu trees. */
1364 struct buffer *prev = current_buffer;
1365 Lisp_Object buffer;
1366 int specpdl_count = SPECPDL_INDEX ();
1367 int previous_menu_items_used = f->menu_bar_items_used;
1368 Lisp_Object *previous_items
1369 = (Lisp_Object *) alloca (previous_menu_items_used
1370 * sizeof (Lisp_Object));
1372 /* If we are making a new widget, its contents are empty,
1373 do always reinitialize them. */
1374 if (! menubar_widget)
1375 previous_menu_items_used = 0;
1377 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1378 specbind (Qinhibit_quit, Qt);
1379 /* Don't let the debugger step into this code
1380 because it is not reentrant. */
1381 specbind (Qdebug_on_next_call, Qnil);
1383 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1384 if (NILP (Voverriding_local_map_menu_flag))
1386 specbind (Qoverriding_terminal_local_map, Qnil);
1387 specbind (Qoverriding_local_map, Qnil);
1390 set_buffer_internal_1 (XBUFFER (buffer));
1392 /* Run the Lucid hook. */
1393 safe_run_hooks (Qactivate_menubar_hook);
1394 /* If it has changed current-menubar from previous value,
1395 really recompute the menubar from the value. */
1396 if (! NILP (Vlucid_menu_bar_dirty_flag))
1397 call0 (Qrecompute_lucid_menubar);
1398 safe_run_hooks (Qmenu_bar_update_hook);
1399 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1401 items = FRAME_MENU_BAR_ITEMS (f);
1403 /* Save the frame's previous menu bar contents data. */
1404 if (previous_menu_items_used)
1405 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1406 previous_menu_items_used * sizeof (Lisp_Object));
1408 /* Fill in menu_items with the current menu bar contents.
1409 This can evaluate Lisp code. */
1410 menu_items = f->menu_bar_vector;
1411 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1412 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1413 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1414 submenu_top_level_items
1415 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1416 init_menu_items ();
1417 for (i = 0; i < ASIZE (items); i += 4)
1419 Lisp_Object key, string, maps;
1421 last_i = i;
1423 key = AREF (items, i);
1424 string = AREF (items, i + 1);
1425 maps = AREF (items, i + 2);
1426 if (NILP (string))
1427 break;
1429 submenu_start[i] = menu_items_used;
1431 menu_items_n_panes = 0;
1432 submenu_top_level_items[i]
1433 = parse_single_submenu (key, string, maps);
1435 submenu_end[i] = menu_items_used;
1438 finish_menu_items ();
1440 /* Convert menu_items into widget_value trees
1441 to display the menu. This cannot evaluate Lisp code. */
1443 wv = xmalloc_widget_value ();
1444 wv->name = "menubar";
1445 wv->value = 0;
1446 wv->enabled = 1;
1447 wv->button_type = BUTTON_TYPE_NONE;
1448 wv->help = Qnil;
1449 first_wv = wv;
1451 for (i = 0; i < last_i; i += 4)
1453 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1454 submenu_top_level_items[i]);
1455 if (prev_wv)
1456 prev_wv->next = wv;
1457 else
1458 first_wv->contents = wv;
1459 /* Don't set wv->name here; GC during the loop might relocate it. */
1460 wv->enabled = 1;
1461 wv->button_type = BUTTON_TYPE_NONE;
1462 prev_wv = wv;
1465 set_buffer_internal_1 (prev);
1466 unbind_to (specpdl_count, Qnil);
1468 /* If there has been no change in the Lisp-level contents
1469 of the menu bar, skip redisplaying it. Just exit. */
1471 for (i = 0; i < previous_menu_items_used; i++)
1472 if (menu_items_used == i
1473 || (!EQ (previous_items[i], AREF (menu_items, i))))
1474 break;
1475 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1477 free_menubar_widget_value_tree (first_wv);
1478 menu_items = Qnil;
1480 return;
1483 /* Now GC cannot happen during the lifetime of the widget_value,
1484 so it's safe to store data from a Lisp_String, as long as
1485 local copies are made when the actual menu is created.
1486 Windows takes care of this for normal string items, but
1487 not for owner-drawn items or additional item-info. */
1488 wv = first_wv->contents;
1489 for (i = 0; i < ASIZE (items); i += 4)
1491 Lisp_Object string;
1492 string = AREF (items, i + 1);
1493 if (NILP (string))
1494 break;
1495 wv->name = (char *) SDATA (string);
1496 wv = wv->next;
1499 f->menu_bar_vector = menu_items;
1500 f->menu_bar_items_used = menu_items_used;
1501 menu_items = Qnil;
1503 else
1505 /* Make a widget-value tree containing
1506 just the top level menu bar strings. */
1508 wv = xmalloc_widget_value ();
1509 wv->name = "menubar";
1510 wv->value = 0;
1511 wv->enabled = 1;
1512 wv->button_type = BUTTON_TYPE_NONE;
1513 wv->help = Qnil;
1514 first_wv = wv;
1516 items = FRAME_MENU_BAR_ITEMS (f);
1517 for (i = 0; i < ASIZE (items); i += 4)
1519 Lisp_Object string;
1521 string = AREF (items, i + 1);
1522 if (NILP (string))
1523 break;
1525 wv = xmalloc_widget_value ();
1526 wv->name = (char *) SDATA (string);
1527 wv->value = 0;
1528 wv->enabled = 1;
1529 wv->button_type = BUTTON_TYPE_NONE;
1530 wv->help = Qnil;
1531 /* This prevents lwlib from assuming this
1532 menu item is really supposed to be empty. */
1533 /* The EMACS_INT cast avoids a warning.
1534 This value just has to be different from small integers. */
1535 wv->call_data = (void *) (EMACS_INT) (-1);
1537 if (prev_wv)
1538 prev_wv->next = wv;
1539 else
1540 first_wv->contents = wv;
1541 prev_wv = wv;
1544 /* Forget what we thought we knew about what is in the
1545 detailed contents of the menu bar menus.
1546 Changing the top level always destroys the contents. */
1547 f->menu_bar_items_used = 0;
1550 /* Create or update the menu bar widget. */
1552 BLOCK_INPUT;
1554 if (menubar_widget)
1556 /* Empty current menubar, rather than creating a fresh one. */
1557 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1560 else
1562 menubar_widget = CreateMenu ();
1564 fill_in_menu (menubar_widget, first_wv->contents);
1566 free_menubar_widget_value_tree (first_wv);
1569 HMENU old_widget = f->output_data.w32->menubar_widget;
1571 f->output_data.w32->menubar_widget = menubar_widget;
1572 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1573 /* Causes flicker when menu bar is updated
1574 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1576 /* Force the window size to be recomputed so that the frame's text
1577 area remains the same, if menubar has just been created. */
1578 if (old_widget == NULL)
1579 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1582 UNBLOCK_INPUT;
1585 /* Called from Fx_create_frame to create the initial menubar of a frame
1586 before it is mapped, so that the window is mapped with the menubar already
1587 there instead of us tacking it on later and thrashing the window after it
1588 is visible. */
1590 void
1591 initialize_frame_menubar (f)
1592 FRAME_PTR f;
1594 /* This function is called before the first chance to redisplay
1595 the frame. It has to be, so the frame will have the right size. */
1596 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1597 set_frame_menubar (f, 1, 1);
1600 /* Get rid of the menu bar of frame F, and free its storage.
1601 This is used when deleting a frame, and when turning off the menu bar. */
1603 void
1604 free_frame_menubar (f)
1605 FRAME_PTR f;
1607 BLOCK_INPUT;
1610 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1611 SetMenu (FRAME_W32_WINDOW (f), NULL);
1612 f->output_data.w32->menubar_widget = NULL;
1613 DestroyMenu (old);
1616 UNBLOCK_INPUT;
1620 /* w32_menu_show actually displays a menu using the panes and items in
1621 menu_items and returns the value selected from it; we assume input
1622 is blocked by the caller. */
1624 /* F is the frame the menu is for.
1625 X and Y are the frame-relative specified position,
1626 relative to the inside upper left corner of the frame F.
1627 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1628 KEYMAPS is 1 if this menu was specified with keymaps;
1629 in that case, we return a list containing the chosen item's value
1630 and perhaps also the pane's prefix.
1631 TITLE is the specified menu title.
1632 ERROR is a place to store an error message string in case of failure.
1633 (We return nil on failure, but the value doesn't actually matter.) */
1635 static Lisp_Object
1636 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1637 FRAME_PTR f;
1638 int x;
1639 int y;
1640 int for_click;
1641 int keymaps;
1642 Lisp_Object title;
1643 char **error;
1645 int i;
1646 int menu_item_selection;
1647 HMENU menu;
1648 POINT pos;
1649 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1650 widget_value **submenu_stack
1651 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1652 Lisp_Object *subprefix_stack
1653 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1654 int submenu_depth = 0;
1655 int first_pane;
1657 *error = NULL;
1659 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1661 *error = "Empty menu";
1662 return Qnil;
1665 /* Create a tree of widget_value objects
1666 representing the panes and their items. */
1667 wv = xmalloc_widget_value ();
1668 wv->name = "menu";
1669 wv->value = 0;
1670 wv->enabled = 1;
1671 wv->button_type = BUTTON_TYPE_NONE;
1672 wv->help = Qnil;
1673 first_wv = wv;
1674 first_pane = 1;
1676 /* Loop over all panes and items, filling in the tree. */
1677 i = 0;
1678 while (i < menu_items_used)
1680 if (EQ (AREF (menu_items, i), Qnil))
1682 submenu_stack[submenu_depth++] = save_wv;
1683 save_wv = prev_wv;
1684 prev_wv = 0;
1685 first_pane = 1;
1686 i++;
1688 else if (EQ (AREF (menu_items, i), Qlambda))
1690 prev_wv = save_wv;
1691 save_wv = submenu_stack[--submenu_depth];
1692 first_pane = 0;
1693 i++;
1695 else if (EQ (AREF (menu_items, i), Qt)
1696 && submenu_depth != 0)
1697 i += MENU_ITEMS_PANE_LENGTH;
1698 /* Ignore a nil in the item list.
1699 It's meaningful only for dialog boxes. */
1700 else if (EQ (AREF (menu_items, i), Qquote))
1701 i += 1;
1702 else if (EQ (AREF (menu_items, i), Qt))
1704 /* Create a new pane. */
1705 Lisp_Object pane_name, prefix;
1706 char *pane_string;
1707 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1708 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1709 #ifndef HAVE_MULTILINGUAL_MENU
1710 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1712 pane_name = ENCODE_SYSTEM (pane_name);
1713 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1715 #endif
1716 pane_string = (NILP (pane_name)
1717 ? "" : (char *) SDATA (pane_name));
1718 /* If there is just one top-level pane, put all its items directly
1719 under the top-level menu. */
1720 if (menu_items_n_panes == 1)
1721 pane_string = "";
1723 /* If the pane has a meaningful name,
1724 make the pane a top-level menu item
1725 with its items as a submenu beneath it. */
1726 if (!keymaps && strcmp (pane_string, ""))
1728 wv = xmalloc_widget_value ();
1729 if (save_wv)
1730 save_wv->next = wv;
1731 else
1732 first_wv->contents = wv;
1733 wv->name = pane_string;
1734 if (keymaps && !NILP (prefix))
1735 wv->name++;
1736 wv->value = 0;
1737 wv->enabled = 1;
1738 wv->button_type = BUTTON_TYPE_NONE;
1739 wv->help = Qnil;
1740 save_wv = wv;
1741 prev_wv = 0;
1743 else if (first_pane)
1745 save_wv = wv;
1746 prev_wv = 0;
1748 first_pane = 0;
1749 i += MENU_ITEMS_PANE_LENGTH;
1751 else
1753 /* Create a new item within current pane. */
1754 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1756 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1757 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1758 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1759 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1760 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1761 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1762 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1764 #ifndef HAVE_MULTILINGUAL_MENU
1765 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1767 item_name = ENCODE_SYSTEM (item_name);
1768 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1770 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1772 descrip = ENCODE_SYSTEM (descrip);
1773 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1775 #endif /* not HAVE_MULTILINGUAL_MENU */
1777 wv = xmalloc_widget_value ();
1778 if (prev_wv)
1779 prev_wv->next = wv;
1780 else
1781 save_wv->contents = wv;
1782 wv->name = (char *) SDATA (item_name);
1783 if (!NILP (descrip))
1784 wv->key = (char *) SDATA (descrip);
1785 wv->value = 0;
1786 /* Use the contents index as call_data, since we are
1787 restricted to 16-bits. */
1788 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1789 wv->enabled = !NILP (enable);
1791 if (NILP (type))
1792 wv->button_type = BUTTON_TYPE_NONE;
1793 else if (EQ (type, QCtoggle))
1794 wv->button_type = BUTTON_TYPE_TOGGLE;
1795 else if (EQ (type, QCradio))
1796 wv->button_type = BUTTON_TYPE_RADIO;
1797 else
1798 abort ();
1800 wv->selected = !NILP (selected);
1801 if (!STRINGP (help))
1802 help = Qnil;
1804 wv->help = help;
1806 prev_wv = wv;
1808 i += MENU_ITEMS_ITEM_LENGTH;
1812 /* Deal with the title, if it is non-nil. */
1813 if (!NILP (title))
1815 widget_value *wv_title = xmalloc_widget_value ();
1816 widget_value *wv_sep = xmalloc_widget_value ();
1818 /* Maybe replace this separator with a bitmap or owner-draw item
1819 so that it looks better. Having two separators looks odd. */
1820 wv_sep->name = "--";
1821 wv_sep->next = first_wv->contents;
1822 wv_sep->help = Qnil;
1824 #ifndef HAVE_MULTILINGUAL_MENU
1825 if (STRING_MULTIBYTE (title))
1826 title = ENCODE_SYSTEM (title);
1827 #endif
1828 wv_title->name = (char *) SDATA (title);
1829 wv_title->enabled = TRUE;
1830 wv_title->title = TRUE;
1831 wv_title->button_type = BUTTON_TYPE_NONE;
1832 wv_title->help = Qnil;
1833 wv_title->next = wv_sep;
1834 first_wv->contents = wv_title;
1837 /* Actually create the menu. */
1838 current_popup_menu = menu = CreatePopupMenu ();
1839 fill_in_menu (menu, first_wv->contents);
1841 /* Adjust coordinates to be root-window-relative. */
1842 pos.x = x;
1843 pos.y = y;
1844 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1846 /* No selection has been chosen yet. */
1847 menu_item_selection = 0;
1849 /* Display the menu. */
1850 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1851 WM_EMACS_TRACKPOPUPMENU,
1852 (WPARAM)menu, (LPARAM)&pos);
1854 /* Clean up extraneous mouse events which might have been generated
1855 during the call. */
1856 discard_mouse_events ();
1858 /* Free the widget_value objects we used to specify the contents. */
1859 free_menubar_widget_value_tree (first_wv);
1861 DestroyMenu (menu);
1863 /* Find the selected item, and its pane, to return
1864 the proper value. */
1865 if (menu_item_selection != 0)
1867 Lisp_Object prefix, entry;
1869 prefix = entry = Qnil;
1870 i = 0;
1871 while (i < menu_items_used)
1873 if (EQ (AREF (menu_items, i), Qnil))
1875 subprefix_stack[submenu_depth++] = prefix;
1876 prefix = entry;
1877 i++;
1879 else if (EQ (AREF (menu_items, i), Qlambda))
1881 prefix = subprefix_stack[--submenu_depth];
1882 i++;
1884 else if (EQ (AREF (menu_items, i), Qt))
1886 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1887 i += MENU_ITEMS_PANE_LENGTH;
1889 /* Ignore a nil in the item list.
1890 It's meaningful only for dialog boxes. */
1891 else if (EQ (AREF (menu_items, i), Qquote))
1892 i += 1;
1893 else
1895 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1896 if (menu_item_selection == i)
1898 if (keymaps != 0)
1900 int j;
1902 entry = Fcons (entry, Qnil);
1903 if (!NILP (prefix))
1904 entry = Fcons (prefix, entry);
1905 for (j = submenu_depth - 1; j >= 0; j--)
1906 if (!NILP (subprefix_stack[j]))
1907 entry = Fcons (subprefix_stack[j], entry);
1909 return entry;
1911 i += MENU_ITEMS_ITEM_LENGTH;
1916 return Qnil;
1920 #ifdef HAVE_DIALOGS
1921 static char * button_names [] = {
1922 "button1", "button2", "button3", "button4", "button5",
1923 "button6", "button7", "button8", "button9", "button10" };
1925 static Lisp_Object
1926 w32_dialog_show (f, keymaps, title, error)
1927 FRAME_PTR f;
1928 int keymaps;
1929 Lisp_Object title;
1930 char **error;
1932 int i, nb_buttons=0;
1933 char dialog_name[6];
1934 int menu_item_selection;
1936 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1938 /* Number of elements seen so far, before boundary. */
1939 int left_count = 0;
1940 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1941 int boundary_seen = 0;
1943 *error = NULL;
1945 if (menu_items_n_panes > 1)
1947 *error = "Multiple panes in dialog box";
1948 return Qnil;
1951 /* Create a tree of widget_value objects
1952 representing the text label and buttons. */
1954 Lisp_Object pane_name, prefix;
1955 char *pane_string;
1956 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
1957 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
1958 pane_string = (NILP (pane_name)
1959 ? "" : (char *) SDATA (pane_name));
1960 prev_wv = xmalloc_widget_value ();
1961 prev_wv->value = pane_string;
1962 if (keymaps && !NILP (prefix))
1963 prev_wv->name++;
1964 prev_wv->enabled = 1;
1965 prev_wv->name = "message";
1966 prev_wv->help = Qnil;
1967 first_wv = prev_wv;
1969 /* Loop over all panes and items, filling in the tree. */
1970 i = MENU_ITEMS_PANE_LENGTH;
1971 while (i < menu_items_used)
1974 /* Create a new item within current pane. */
1975 Lisp_Object item_name, enable, descrip, help;
1977 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1978 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1979 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1980 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1982 if (NILP (item_name))
1984 free_menubar_widget_value_tree (first_wv);
1985 *error = "Submenu in dialog items";
1986 return Qnil;
1988 if (EQ (item_name, Qquote))
1990 /* This is the boundary between left-side elts
1991 and right-side elts. Stop incrementing right_count. */
1992 boundary_seen = 1;
1993 i++;
1994 continue;
1996 if (nb_buttons >= 9)
1998 free_menubar_widget_value_tree (first_wv);
1999 *error = "Too many dialog items";
2000 return Qnil;
2003 wv = xmalloc_widget_value ();
2004 prev_wv->next = wv;
2005 wv->name = (char *) button_names[nb_buttons];
2006 if (!NILP (descrip))
2007 wv->key = (char *) SDATA (descrip);
2008 wv->value = (char *) SDATA (item_name);
2009 wv->call_data = (void *) &AREF (menu_items, i);
2010 wv->enabled = !NILP (enable);
2011 wv->help = Qnil;
2012 prev_wv = wv;
2014 if (! boundary_seen)
2015 left_count++;
2017 nb_buttons++;
2018 i += MENU_ITEMS_ITEM_LENGTH;
2021 /* If the boundary was not specified,
2022 by default put half on the left and half on the right. */
2023 if (! boundary_seen)
2024 left_count = nb_buttons - nb_buttons / 2;
2026 wv = xmalloc_widget_value ();
2027 wv->name = dialog_name;
2028 wv->help = Qnil;
2030 /* Dialog boxes use a really stupid name encoding
2031 which specifies how many buttons to use
2032 and how many buttons are on the right.
2033 The Q means something also. */
2034 dialog_name[0] = 'Q';
2035 dialog_name[1] = '0' + nb_buttons;
2036 dialog_name[2] = 'B';
2037 dialog_name[3] = 'R';
2038 /* Number of buttons to put on the right. */
2039 dialog_name[4] = '0' + nb_buttons - left_count;
2040 dialog_name[5] = 0;
2041 wv->contents = first_wv;
2042 first_wv = wv;
2045 /* Actually create the dialog. */
2046 dialog_id = widget_id_tick++;
2047 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2048 f->output_data.w32->widget, 1, 0,
2049 dialog_selection_callback, 0);
2050 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2052 /* Free the widget_value objects we used to specify the contents. */
2053 free_menubar_widget_value_tree (first_wv);
2055 /* No selection has been chosen yet. */
2056 menu_item_selection = 0;
2058 /* Display the menu. */
2059 lw_pop_up_all_widgets (dialog_id);
2060 popup_activated_flag = 1;
2062 /* Process events that apply to the menu. */
2063 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2065 lw_destroy_all_widgets (dialog_id);
2067 /* Find the selected item, and its pane, to return
2068 the proper value. */
2069 if (menu_item_selection != 0)
2071 Lisp_Object prefix;
2073 prefix = Qnil;
2074 i = 0;
2075 while (i < menu_items_used)
2077 Lisp_Object entry;
2079 if (EQ (AREF (menu_items, i), Qt))
2081 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2082 i += MENU_ITEMS_PANE_LENGTH;
2084 else
2086 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2087 if (menu_item_selection == i)
2089 if (keymaps != 0)
2091 entry = Fcons (entry, Qnil);
2092 if (!NILP (prefix))
2093 entry = Fcons (prefix, entry);
2095 return entry;
2097 i += MENU_ITEMS_ITEM_LENGTH;
2102 return Qnil;
2104 #endif /* HAVE_DIALOGS */
2107 /* Is this item a separator? */
2108 static int
2109 name_is_separator (name)
2110 char *name;
2112 char *start = name;
2114 /* Check if name string consists of only dashes ('-'). */
2115 while (*name == '-') name++;
2116 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2117 or "--deep-shadow". We don't implement them yet, se we just treat
2118 them like normal separators. */
2119 return (*name == '\0' || start + 2 == name);
2123 /* Indicate boundary between left and right. */
2124 static int
2125 add_left_right_boundary (HMENU menu)
2127 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2130 static int
2131 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2133 UINT fuFlags;
2134 char *out_string;
2135 int return_value;
2137 if (name_is_separator (wv->name))
2139 fuFlags = MF_SEPARATOR;
2140 out_string = NULL;
2142 else
2144 if (wv->enabled)
2145 fuFlags = MF_STRING;
2146 else
2147 fuFlags = MF_STRING | MF_GRAYED;
2149 if (wv->key != NULL)
2151 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2152 strcpy (out_string, wv->name);
2153 strcat (out_string, "\t");
2154 strcat (out_string, wv->key);
2156 else
2157 out_string = wv->name;
2159 if (item != NULL)
2160 fuFlags = MF_POPUP;
2161 else if (wv->title || wv->call_data == 0)
2163 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2164 we can't deallocate the memory otherwise. */
2165 if (get_menu_item_info)
2167 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2168 strcpy (out_string, wv->name);
2169 #ifdef MENU_DEBUG
2170 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2171 #endif
2172 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2174 else
2175 fuFlags = MF_DISABLED;
2178 /* Draw radio buttons and tickboxes. */
2179 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2180 wv->button_type == BUTTON_TYPE_RADIO))
2181 fuFlags |= MF_CHECKED;
2182 else
2183 fuFlags |= MF_UNCHECKED;
2186 return_value =
2187 AppendMenu (menu,
2188 fuFlags,
2189 item != NULL ? (UINT) item : (UINT) wv->call_data,
2190 out_string );
2192 /* This must be done after the menu item is created. */
2193 if (!wv->title && wv->call_data != 0)
2195 if (set_menu_item_info)
2197 MENUITEMINFO info;
2198 bzero (&info, sizeof (info));
2199 info.cbSize = sizeof (info);
2200 info.fMask = MIIM_DATA;
2202 /* Set help string for menu item. Leave it as a Lisp_Object
2203 until it is ready to be displayed, since GC can happen while
2204 menus are active. */
2205 if (wv->help)
2206 info.dwItemData = (DWORD) wv->help;
2208 if (wv->button_type == BUTTON_TYPE_RADIO)
2210 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2211 RADIO items, but is not available on NT 3.51 and earlier. */
2212 info.fMask |= MIIM_TYPE | MIIM_STATE;
2213 info.fType = MFT_RADIOCHECK | MFT_STRING;
2214 info.dwTypeData = out_string;
2215 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2218 set_menu_item_info (menu,
2219 item != NULL ? (UINT) item : (UINT) wv->call_data,
2220 FALSE, &info);
2223 return return_value;
2226 /* Construct native Windows menu(bar) based on widget_value tree. */
2228 fill_in_menu (HMENU menu, widget_value *wv)
2230 int items_added = 0;
2232 for ( ; wv != NULL; wv = wv->next)
2234 if (wv->contents)
2236 HMENU sub_menu = CreatePopupMenu ();
2238 if (sub_menu == NULL)
2239 return 0;
2241 if (!fill_in_menu (sub_menu, wv->contents) ||
2242 !add_menu_item (menu, wv, sub_menu))
2244 DestroyMenu (sub_menu);
2245 return 0;
2248 else
2250 if (!add_menu_item (menu, wv, NULL))
2251 return 0;
2254 return 1;
2258 popup_activated ()
2260 /* popup_activated_flag not actually used on W32 */
2261 return 0;
2264 /* Display help string for currently pointed to menu item. Not
2265 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2266 available. */
2267 void
2268 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2270 if (get_menu_item_info)
2272 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2273 Lisp_Object frame, help;
2275 // No help echo on owner-draw menu items.
2276 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2277 help = Qnil;
2278 else
2280 MENUITEMINFO info;
2282 bzero (&info, sizeof (info));
2283 info.cbSize = sizeof (info);
2284 info.fMask = MIIM_DATA;
2285 get_menu_item_info (menu, item, FALSE, &info);
2287 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2290 /* Store the help echo in the keyboard buffer as the X toolkit
2291 version does, rather than directly showing it. This seems to
2292 solve the GC problems that were present when we based the
2293 Windows code on the non-toolkit version. */
2294 if (f)
2296 XSETFRAME (frame, f);
2297 kbd_buffer_store_help_event (frame, help);
2299 else
2300 /* X version has a loop through frames here, which doesn't
2301 appear to do anything, unless it has some side effect. */
2302 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2306 /* Free memory used by owner-drawn strings. */
2307 static void
2308 w32_free_submenu_strings (menu)
2309 HMENU menu;
2311 int i, num = GetMenuItemCount (menu);
2312 for (i = 0; i < num; i++)
2314 MENUITEMINFO info;
2315 bzero (&info, sizeof (info));
2316 info.cbSize = sizeof (info);
2317 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2319 get_menu_item_info (menu, i, TRUE, &info);
2321 /* Owner-drawn names are held in dwItemData. */
2322 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2324 #ifdef MENU_DEBUG
2325 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2326 #endif
2327 local_free (info.dwItemData);
2330 /* Recurse down submenus. */
2331 if (info.hSubMenu)
2332 w32_free_submenu_strings (info.hSubMenu);
2336 void
2337 w32_free_menu_strings (hwnd)
2338 HWND hwnd;
2340 HMENU menu = current_popup_menu;
2342 if (get_menu_item_info)
2344 /* If there is no popup menu active, free the strings from the frame's
2345 menubar. */
2346 if (!menu)
2347 menu = GetMenu (hwnd);
2349 if (menu)
2350 w32_free_submenu_strings (menu);
2353 current_popup_menu = NULL;
2356 #endif /* HAVE_MENUS */
2359 syms_of_w32menu ()
2361 /* See if Get/SetMenuItemInfo functions are available. */
2362 HMODULE user32 = GetModuleHandle ("user32.dll");
2363 get_menu_item_info = GetProcAddress (user32, "GetMenuItemInfoA");
2364 set_menu_item_info = GetProcAddress (user32, "SetMenuItemInfoA");
2366 staticpro (&menu_items);
2367 menu_items = Qnil;
2369 current_popup_menu = NULL;
2371 Qdebug_on_next_call = intern ("debug-on-next-call");
2372 staticpro (&Qdebug_on_next_call);
2374 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2375 doc: /* Frame for which we are updating a menu.
2376 The enable predicate for a menu command should check this variable. */);
2377 Vmenu_updating_frame = Qnil;
2379 defsubr (&Sx_popup_menu);
2380 #ifdef HAVE_MENUS
2381 defsubr (&Sx_popup_dialog);
2382 #endif