(forms-file): Update for moved forms-d2.dat.
[emacs.git] / src / w32menu.c
blob1f8561210c1c231e201e5099dd511ff13e066d60
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 #include <config.h>
25 #include <signal.h>
26 #include <stdio.h>
27 #include <mbstring.h>
29 #include "lisp.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "termhooks.h"
34 #include "window.h"
35 #include "blockinput.h"
36 #include "buffer.h"
37 #include "charset.h"
38 #include "character.h"
39 #include "coding.h"
41 /* This may include sys/types.h, and that somehow loses
42 if this is not done before the other system files. */
43 #include "w32term.h"
45 /* Load sys/types.h if not already loaded.
46 In some systems loading it twice is suicidal. */
47 #ifndef makedev
48 #include <sys/types.h>
49 #endif
51 #include "dispextern.h"
53 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
55 /******************************************************************/
56 /* Definitions copied from lwlib.h */
58 typedef void * XtPointer;
59 typedef char Boolean;
61 enum button_type
63 BUTTON_TYPE_NONE,
64 BUTTON_TYPE_TOGGLE,
65 BUTTON_TYPE_RADIO
68 /* This structure is based on the one in ../lwlib/lwlib.h, modified
69 for Windows. */
70 typedef struct _widget_value
72 /* name of widget */
73 Lisp_Object lname;
74 char* name;
75 /* value (meaning depend on widget type) */
76 char* value;
77 /* keyboard equivalent. no implications for XtTranslations */
78 Lisp_Object lkey;
79 char* key;
80 /* Help string or nil if none.
81 GC finds this string through the frame's menu_bar_vector
82 or through menu_items. */
83 Lisp_Object help;
84 /* true if enabled */
85 Boolean enabled;
86 /* true if selected */
87 Boolean selected;
88 /* The type of a button. */
89 enum button_type button_type;
90 /* true if menu title */
91 Boolean title;
92 #if 0
93 /* true if was edited (maintained by get_value) */
94 Boolean edited;
95 /* true if has changed (maintained by lw library) */
96 change_type change;
97 /* true if this widget itself has changed,
98 but not counting the other widgets found in the `next' field. */
99 change_type this_one_change;
100 #endif
101 /* Contents of the sub-widgets, also selected slot for checkbox */
102 struct _widget_value* contents;
103 /* data passed to callback */
104 XtPointer call_data;
105 /* next one in the list */
106 struct _widget_value* next;
107 #if 0
108 /* slot for the toolkit dependent part. Always initialize to NULL. */
109 void* toolkit_data;
110 /* tell us if we should free the toolkit data slot when freeing the
111 widget_value itself. */
112 Boolean free_toolkit_data;
114 /* we resource the widget_value structures; this points to the next
115 one on the free list if this one has been deallocated.
117 struct _widget_value *free_list;
118 #endif
119 } widget_value;
121 /* Local memory management */
122 #define local_heap (GetProcessHeap ())
123 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
124 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
126 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
127 #define free_widget_value(wv) (local_free ((wv)))
129 /******************************************************************/
131 #ifndef TRUE
132 #define TRUE 1
133 #define FALSE 0
134 #endif /* no TRUE */
136 HMENU current_popup_menu;
138 void syms_of_w32menu ();
139 void globals_of_w32menu ();
141 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
142 IN HMENU,
143 IN UINT,
144 IN BOOL,
145 IN OUT LPMENUITEMINFOA);
146 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
147 IN HMENU,
148 IN UINT,
149 IN BOOL,
150 IN LPCMENUITEMINFOA);
152 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
153 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
154 AppendMenuW_Proc unicode_append_menu = NULL;
156 Lisp_Object Qdebug_on_next_call;
158 extern Lisp_Object Vmenu_updating_frame;
160 extern Lisp_Object Qmenu_bar;
162 extern Lisp_Object QCtoggle, QCradio;
164 extern Lisp_Object Voverriding_local_map;
165 extern Lisp_Object Voverriding_local_map_menu_flag;
167 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
169 extern Lisp_Object Qmenu_bar_update_hook;
171 void set_frame_menubar P_ ((FRAME_PTR, int, int));
173 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
174 Lisp_Object, Lisp_Object, Lisp_Object,
175 Lisp_Object, Lisp_Object));
176 #ifdef HAVE_DIALOGS
177 static Lisp_Object w32_dialog_show P_ ((FRAME_PTR, int, Lisp_Object, char**));
178 #else
179 static int is_simple_dialog P_ ((Lisp_Object));
180 static Lisp_Object simple_dialog_show P_ ((FRAME_PTR, Lisp_Object, Lisp_Object));
181 #endif
182 static Lisp_Object w32_menu_show P_ ((FRAME_PTR, int, int, int, int,
183 Lisp_Object, char **));
185 static void keymap_panes P_ ((Lisp_Object *, int, int));
186 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
187 int, int));
188 static void single_menu_item P_ ((Lisp_Object, Lisp_Object,
189 Lisp_Object *, int, int));
190 static void list_of_panes P_ ((Lisp_Object));
191 static void list_of_items P_ ((Lisp_Object));
192 void w32_free_menu_strings P_((HWND));
194 /* This holds a Lisp vector that holds the results of decoding
195 the keymaps or alist-of-alists that specify a menu.
197 It describes the panes and items within the panes.
199 Each pane is described by 3 elements in the vector:
200 t, the pane name, the pane's prefix key.
201 Then follow the pane's items, with 5 elements per item:
202 the item string, the enable flag, the item's value,
203 the definition, and the equivalent keyboard key's description string.
205 In some cases, multiple levels of menus may be described.
206 A single vector slot containing nil indicates the start of a submenu.
207 A single vector slot containing lambda indicates the end of a submenu.
208 The submenu follows a menu item which is the way to reach the submenu.
210 A single vector slot containing quote indicates that the
211 following items should appear on the right of a dialog box.
213 Using a Lisp vector to hold this information while we decode it
214 takes care of protecting all the data from GC. */
216 #define MENU_ITEMS_PANE_NAME 1
217 #define MENU_ITEMS_PANE_PREFIX 2
218 #define MENU_ITEMS_PANE_LENGTH 3
220 enum menu_item_idx
222 MENU_ITEMS_ITEM_NAME = 0,
223 MENU_ITEMS_ITEM_ENABLE,
224 MENU_ITEMS_ITEM_VALUE,
225 MENU_ITEMS_ITEM_EQUIV_KEY,
226 MENU_ITEMS_ITEM_DEFINITION,
227 MENU_ITEMS_ITEM_TYPE,
228 MENU_ITEMS_ITEM_SELECTED,
229 MENU_ITEMS_ITEM_HELP,
230 MENU_ITEMS_ITEM_LENGTH
233 static Lisp_Object menu_items;
235 /* Number of slots currently allocated in menu_items. */
236 static int menu_items_allocated;
238 /* This is the index in menu_items of the first empty slot. */
239 static int menu_items_used;
241 /* The number of panes currently recorded in menu_items,
242 excluding those within submenus. */
243 static int menu_items_n_panes;
245 /* Current depth within submenus. */
246 static int menu_items_submenu_depth;
248 static int next_menubar_widget_id;
250 /* This is set nonzero after the user activates the menu bar, and set
251 to zero again after the menu bars are redisplayed by prepare_menu_bar.
252 While it is nonzero, all calls to set_frame_menubar go deep.
254 I don't understand why this is needed, but it does seem to be
255 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
257 int pending_menu_activation;
260 /* Return the frame whose ->output_data.w32->menubar_widget equals
261 ID, or 0 if none. */
263 static struct frame *
264 menubar_id_to_frame (id)
265 HMENU id;
267 Lisp_Object tail, frame;
268 FRAME_PTR f;
270 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
272 frame = XCAR (tail);
273 if (!FRAMEP (frame))
274 continue;
275 f = XFRAME (frame);
276 if (!FRAME_WINDOW_P (f))
277 continue;
278 if (f->output_data.w32->menubar_widget == id)
279 return f;
281 return 0;
284 /* Initialize the menu_items structure if we haven't already done so.
285 Also mark it as currently empty. */
287 static void
288 init_menu_items ()
290 if (NILP (menu_items))
292 menu_items_allocated = 60;
293 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
296 menu_items_used = 0;
297 menu_items_n_panes = 0;
298 menu_items_submenu_depth = 0;
301 /* Call at the end of generating the data in menu_items.
302 This fills in the number of items in the last pane. */
304 static void
305 finish_menu_items ()
309 /* Call when finished using the data for the current menu
310 in menu_items. */
312 static void
313 discard_menu_items ()
315 /* Free the structure if it is especially large.
316 Otherwise, hold on to it, to save time. */
317 if (menu_items_allocated > 200)
319 menu_items = Qnil;
320 menu_items_allocated = 0;
324 /* Make the menu_items vector twice as large. */
326 static void
327 grow_menu_items ()
329 menu_items_allocated *= 2;
330 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
333 /* Begin a submenu. */
335 static void
336 push_submenu_start ()
338 if (menu_items_used + 1 > menu_items_allocated)
339 grow_menu_items ();
341 ASET (menu_items, menu_items_used, Qnil);
342 menu_items_used++;
343 menu_items_submenu_depth++;
346 /* End a submenu. */
348 static void
349 push_submenu_end ()
351 if (menu_items_used + 1 > menu_items_allocated)
352 grow_menu_items ();
354 ASET (menu_items, menu_items_used, Qlambda);
355 menu_items_used++;
356 menu_items_submenu_depth--;
359 /* Indicate boundary between left and right. */
361 static void
362 push_left_right_boundary ()
364 if (menu_items_used + 1 > menu_items_allocated)
365 grow_menu_items ();
367 ASET (menu_items, menu_items_used, Qquote);
368 menu_items_used++;
371 /* Start a new menu pane in menu_items.
372 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
374 static void
375 push_menu_pane (name, prefix_vec)
376 Lisp_Object name, prefix_vec;
378 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
379 grow_menu_items ();
381 if (menu_items_submenu_depth == 0)
382 menu_items_n_panes++;
383 ASET (menu_items, menu_items_used, Qt); menu_items_used++;
384 ASET (menu_items, menu_items_used, name); menu_items_used++;
385 ASET (menu_items, menu_items_used, prefix_vec); menu_items_used++;
388 /* Push one menu item into the current pane. NAME is the string to
389 display. ENABLE if non-nil means this item can be selected. KEY
390 is the key generated by choosing this item, or nil if this item
391 doesn't really have a definition. DEF is the definition of this
392 item. EQUIV is the textual description of the keyboard equivalent
393 for this item (or nil if none). TYPE is the type of this menu
394 item, one of nil, `toggle' or `radio'. */
396 static void
397 push_menu_item (name, enable, key, def, equiv, type, selected, help)
398 Lisp_Object name, enable, key, def, equiv, type, selected, help;
400 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
401 grow_menu_items ();
403 ASET (menu_items, menu_items_used, name); menu_items_used++;
404 ASET (menu_items, menu_items_used, enable); menu_items_used++;
405 ASET (menu_items, menu_items_used, key); menu_items_used++;
406 ASET (menu_items, menu_items_used, equiv); menu_items_used++;
407 ASET (menu_items, menu_items_used, def); menu_items_used++;
408 ASET (menu_items, menu_items_used, type); menu_items_used++;
409 ASET (menu_items, menu_items_used, selected); menu_items_used++;
410 ASET (menu_items, menu_items_used, help); menu_items_used++;
413 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
414 and generate menu panes for them in menu_items.
415 If NOTREAL is nonzero,
416 don't bother really computing whether an item is enabled. */
418 static void
419 keymap_panes (keymaps, nmaps, notreal)
420 Lisp_Object *keymaps;
421 int nmaps;
422 int notreal;
424 int mapno;
426 init_menu_items ();
428 /* Loop over the given keymaps, making a pane for each map.
429 But don't make a pane that is empty--ignore that map instead.
430 P is the number of panes we have made so far. */
431 for (mapno = 0; mapno < nmaps; mapno++)
432 single_keymap_panes (keymaps[mapno],
433 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
435 finish_menu_items ();
438 /* This is a recursive subroutine of keymap_panes.
439 It handles one keymap, KEYMAP.
440 The other arguments are passed along
441 or point to local variables of the previous function.
442 If NOTREAL is nonzero, only check for equivalent key bindings, don't
443 evaluate expressions in menu items and don't make any menu.
445 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
447 static void
448 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
449 Lisp_Object keymap;
450 Lisp_Object pane_name;
451 Lisp_Object prefix;
452 int notreal;
453 int maxdepth;
455 Lisp_Object pending_maps = Qnil;
456 Lisp_Object tail, item;
457 struct gcpro gcpro1, gcpro2;
459 if (maxdepth <= 0)
460 return;
462 push_menu_pane (pane_name, prefix);
464 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
466 GCPRO2 (keymap, pending_maps);
467 /* Look at each key binding, and if it is a menu item add it
468 to this menu. */
469 item = XCAR (tail);
470 if (CONSP (item))
471 single_menu_item (XCAR (item), XCDR (item),
472 &pending_maps, notreal, maxdepth);
473 else if (VECTORP (item))
475 /* Loop over the char values represented in the vector. */
476 int len = ASIZE (item);
477 int c;
478 for (c = 0; c < len; c++)
480 Lisp_Object character;
481 XSETFASTINT (character, c);
482 single_menu_item (character, AREF (item, c),
483 &pending_maps, notreal, maxdepth);
486 UNGCPRO;
489 /* Process now any submenus which want to be panes at this level. */
490 while (!NILP (pending_maps))
492 Lisp_Object elt, eltcdr, string;
493 elt = Fcar (pending_maps);
494 eltcdr = XCDR (elt);
495 string = XCAR (eltcdr);
496 /* We no longer discard the @ from the beginning of the string here.
497 Instead, we do this in w32_menu_show. */
498 single_keymap_panes (Fcar (elt), string,
499 XCDR (eltcdr), notreal, maxdepth - 1);
500 pending_maps = Fcdr (pending_maps);
504 /* This is a subroutine of single_keymap_panes that handles one
505 keymap entry.
506 KEY is a key in a keymap and ITEM is its binding.
507 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
508 separate panes.
509 If NOTREAL is nonzero, only check for equivalent key bindings, don't
510 evaluate expressions in menu items and don't make any menu.
511 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
513 static void
514 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
515 Lisp_Object key, item;
516 Lisp_Object *pending_maps_ptr;
517 int maxdepth, notreal;
519 Lisp_Object map, item_string, enabled;
520 struct gcpro gcpro1, gcpro2;
521 int res;
523 /* Parse the menu item and leave the result in item_properties. */
524 GCPRO2 (key, item);
525 res = parse_menu_item (item, notreal, 0);
526 UNGCPRO;
527 if (!res)
528 return; /* Not a menu item. */
530 map = AREF (item_properties, ITEM_PROPERTY_MAP);
532 if (notreal)
534 /* We don't want to make a menu, just traverse the keymaps to
535 precompute equivalent key bindings. */
536 if (!NILP (map))
537 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
538 return;
541 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
542 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
544 if (!NILP (map) && SREF (item_string, 0) == '@')
546 if (!NILP (enabled))
547 /* An enabled separate pane. Remember this to handle it later. */
548 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
549 *pending_maps_ptr);
550 return;
553 push_menu_item (item_string, enabled, key,
554 AREF (item_properties, ITEM_PROPERTY_DEF),
555 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
556 AREF (item_properties, ITEM_PROPERTY_TYPE),
557 AREF (item_properties, ITEM_PROPERTY_SELECTED),
558 AREF (item_properties, ITEM_PROPERTY_HELP));
560 /* Display a submenu using the toolkit. */
561 if (! (NILP (map) || NILP (enabled)))
563 push_submenu_start ();
564 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
565 push_submenu_end ();
569 /* Push all the panes and items of a menu described by the
570 alist-of-alists MENU.
571 This handles old-fashioned calls to x-popup-menu. */
573 static void
574 list_of_panes (menu)
575 Lisp_Object menu;
577 Lisp_Object tail;
579 init_menu_items ();
581 for (tail = menu; CONSP (tail); tail = XCDR (tail))
583 Lisp_Object elt, pane_name, pane_data;
584 elt = XCAR (tail);
585 pane_name = Fcar (elt);
586 CHECK_STRING (pane_name);
587 push_menu_pane (pane_name, Qnil);
588 pane_data = Fcdr (elt);
589 CHECK_CONS (pane_data);
590 list_of_items (pane_data);
593 finish_menu_items ();
596 /* Push the items in a single pane defined by the alist PANE. */
598 static void
599 list_of_items (pane)
600 Lisp_Object pane;
602 Lisp_Object tail, item, item1;
604 for (tail = pane; CONSP (tail); tail = XCDR (tail))
606 item = XCAR (tail);
607 if (STRINGP (item))
608 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
609 else if (NILP (item))
610 push_left_right_boundary ();
611 else
613 CHECK_CONS (item);
614 item1 = Fcar (item);
615 CHECK_STRING (item1);
616 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
621 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
622 doc: /* Pop up a deck-of-cards menu and return user's selection.
623 POSITION is a position specification. This is either a mouse button
624 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
625 are positions in pixels from the top left corner of WINDOW's frame
626 \(WINDOW may be a frame object instead of a window). This controls the
627 position of the center of the first line in the first pane of the
628 menu, not the top left of the menu as a whole. If POSITION is t, it
629 means to use the current mouse position.
631 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
632 The menu items come from key bindings that have a menu string as well as
633 a definition; actually, the \"definition\" in such a key binding looks like
634 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
635 the keymap as a top-level element.
637 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
638 Otherwise, REAL-DEFINITION should be a valid key binding definition.
640 You can also use a list of keymaps as MENU. Then each keymap makes a
641 separate pane. When MENU is a keymap or a list of keymaps, the return
642 value is a list of events.
644 Alternatively, you can specify a menu of multiple panes with a list of
645 the form (TITLE PANE1 PANE2...), where each pane is a list of
646 form (TITLE ITEM1 ITEM2...).
647 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
648 appear as an item--that makes a nonselectable line in the menu.
649 With this form of menu, the return value is VALUE from the chosen item.
651 If POSITION is nil, don't display the menu at all, just precalculate the
652 cached information about equivalent key sequences. */)
653 (position, menu)
654 Lisp_Object position, menu;
656 Lisp_Object keymap, tem;
657 int xpos = 0, ypos = 0;
658 Lisp_Object title;
659 char *error_name;
660 Lisp_Object selection;
661 FRAME_PTR f = NULL;
662 Lisp_Object x, y, window;
663 int keymaps = 0;
664 int for_click = 0;
665 struct gcpro gcpro1;
667 #ifdef HAVE_MENUS
668 if (! NILP (position))
670 check_w32 ();
672 /* Decode the first argument: find the window and the coordinates. */
673 if (EQ (position, Qt)
674 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
675 || EQ (XCAR (position), Qtool_bar))))
677 /* Use the mouse's current position. */
678 FRAME_PTR new_f = SELECTED_FRAME ();
679 Lisp_Object bar_window;
680 enum scroll_bar_part part;
681 unsigned long time;
683 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
684 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
685 &part, &x, &y, &time);
686 if (new_f != 0)
687 XSETFRAME (window, new_f);
688 else
690 window = selected_window;
691 XSETFASTINT (x, 0);
692 XSETFASTINT (y, 0);
695 else
697 tem = Fcar (position);
698 if (CONSP (tem))
700 window = Fcar (Fcdr (position));
701 x = Fcar (tem);
702 y = Fcar (Fcdr (tem));
704 else
706 for_click = 1;
707 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
708 window = Fcar (tem); /* POSN_WINDOW (tem) */
709 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
710 x = Fcar (tem);
711 y = Fcdr (tem);
715 CHECK_NUMBER (x);
716 CHECK_NUMBER (y);
718 /* Decode where to put the menu. */
720 if (FRAMEP (window))
722 f = XFRAME (window);
723 xpos = 0;
724 ypos = 0;
726 else if (WINDOWP (window))
728 CHECK_LIVE_WINDOW (window);
729 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
731 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
732 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
734 else
735 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
736 but I don't want to make one now. */
737 CHECK_WINDOW (window);
739 xpos += XINT (x);
740 ypos += XINT (y);
742 XSETFRAME (Vmenu_updating_frame, f);
744 else
745 Vmenu_updating_frame = Qnil;
746 #endif /* HAVE_MENUS */
748 title = Qnil;
749 GCPRO1 (title);
751 /* Decode the menu items from what was specified. */
753 keymap = get_keymap (menu, 0, 0);
754 if (CONSP (keymap))
756 /* We were given a keymap. Extract menu info from the keymap. */
757 Lisp_Object prompt;
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu, 1, NILP (position));
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt = Fkeymap_prompt (keymap);
765 if (NILP (title) && !NILP (prompt))
766 title = prompt;
768 /* Make that be the pane title of the first pane. */
769 if (!NILP (prompt) && menu_items_n_panes >= 0)
770 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
772 keymaps = 1;
774 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
776 /* We were given a list of keymaps. */
777 int nmaps = XFASTINT (Flength (menu));
778 Lisp_Object *maps
779 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
780 int i;
782 title = Qnil;
784 /* The first keymap that has a prompt string
785 supplies the menu title. */
786 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
788 Lisp_Object prompt;
790 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
792 prompt = Fkeymap_prompt (keymap);
793 if (NILP (title) && !NILP (prompt))
794 title = prompt;
797 /* Extract the detailed info to make one pane. */
798 keymap_panes (maps, nmaps, NILP (position));
800 /* Make the title be the pane title of the first pane. */
801 if (!NILP (title) && menu_items_n_panes >= 0)
802 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
804 keymaps = 1;
806 else
808 /* We were given an old-fashioned menu. */
809 title = Fcar (menu);
810 CHECK_STRING (title);
812 list_of_panes (Fcdr (menu));
814 keymaps = 0;
817 if (NILP (position))
819 discard_menu_items ();
820 UNGCPRO;
821 return Qnil;
824 #ifdef HAVE_MENUS
825 /* If resources from a previous popup menu still exist, does nothing
826 until the `menu_free_timer' has freed them (see w32fns.c). This
827 can occur if you press ESC or click outside a menu without selecting
828 a menu item.
830 if (current_popup_menu)
832 discard_menu_items ();
833 UNGCPRO;
834 return Qnil;
837 /* Display them in a menu. */
838 BLOCK_INPUT;
840 selection = w32_menu_show (f, xpos, ypos, for_click,
841 keymaps, title, &error_name);
842 UNBLOCK_INPUT;
844 discard_menu_items ();
846 #endif /* HAVE_MENUS */
848 UNGCPRO;
850 if (error_name) error (error_name);
851 return selection;
854 #ifdef HAVE_MENUS
856 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
857 doc: /* Pop up a dialog box and return user's selection.
858 POSITION specifies which frame to use.
859 This is normally a mouse button event or a window or frame.
860 If POSITION is t, it means to use the frame the mouse is on.
861 The dialog box appears in the middle of the specified frame.
863 CONTENTS specifies the alternatives to display in the dialog box.
864 It is a list of the form (TITLE ITEM1 ITEM2...).
865 Each ITEM is a cons cell (STRING . VALUE).
866 The return value is VALUE from the chosen item.
868 An ITEM may also be just a string--that makes a nonselectable item.
869 An ITEM may also be nil--that means to put all preceding items
870 on the left of the dialog box and all following items on the right.
871 \(By default, approximately half appear on each side.)
873 If HEADER is non-nil, the frame title for the box is "Information",
874 otherwise it is "Question". */)
875 (position, contents, header)
876 Lisp_Object position, contents, header;
878 FRAME_PTR f = NULL;
879 Lisp_Object window;
881 check_w32 ();
883 /* Decode the first argument: find the window or frame to use. */
884 if (EQ (position, Qt)
885 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
886 || EQ (XCAR (position), Qtool_bar))))
888 #if 0 /* Using the frame the mouse is on may not be right. */
889 /* Use the mouse's current position. */
890 FRAME_PTR new_f = SELECTED_FRAME ();
891 Lisp_Object bar_window;
892 enum scroll_bar_part part;
893 unsigned long time;
894 Lisp_Object x, y;
896 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
898 if (new_f != 0)
899 XSETFRAME (window, new_f);
900 else
901 window = selected_window;
902 #endif
903 window = selected_window;
905 else if (CONSP (position))
907 Lisp_Object tem;
908 tem = Fcar (position);
909 if (CONSP (tem))
910 window = Fcar (Fcdr (position));
911 else
913 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
914 window = Fcar (tem); /* POSN_WINDOW (tem) */
917 else if (WINDOWP (position) || FRAMEP (position))
918 window = position;
919 else
920 window = Qnil;
922 /* Decode where to put the menu. */
924 if (FRAMEP (window))
925 f = XFRAME (window);
926 else if (WINDOWP (window))
928 CHECK_LIVE_WINDOW (window);
929 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
931 else
932 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
933 but I don't want to make one now. */
934 CHECK_WINDOW (window);
936 #ifndef HAVE_DIALOGS
939 /* Handle simple Yes/No choices as MessageBox popups. */
940 if (is_simple_dialog (contents))
941 return simple_dialog_show (f, contents, header);
942 else
944 /* Display a menu with these alternatives
945 in the middle of frame F. */
946 Lisp_Object x, y, frame, newpos;
947 XSETFRAME (frame, f);
948 XSETINT (x, x_pixel_width (f) / 2);
949 XSETINT (y, x_pixel_height (f) / 2);
950 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
951 return Fx_popup_menu (newpos,
952 Fcons (Fcar (contents), Fcons (contents, Qnil)));
955 #else /* HAVE_DIALOGS */
957 Lisp_Object title;
958 char *error_name;
959 Lisp_Object selection;
961 /* Decode the dialog items from what was specified. */
962 title = Fcar (contents);
963 CHECK_STRING (title);
965 list_of_panes (Fcons (contents, Qnil));
967 /* Display them in a dialog box. */
968 BLOCK_INPUT;
969 selection = w32_dialog_show (f, 0, title, header, &error_name);
970 UNBLOCK_INPUT;
972 discard_menu_items ();
974 if (error_name) error (error_name);
975 return selection;
977 #endif /* HAVE_DIALOGS */
980 /* Activate the menu bar of frame F.
981 This is called from keyboard.c when it gets the
982 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
984 To activate the menu bar, we signal to the input thread that it can
985 return from the WM_INITMENU message, allowing the normal Windows
986 processing of the menus.
988 But first we recompute the menu bar contents (the whole tree).
990 This way we can safely execute Lisp code. */
992 void
993 x_activate_menubar (f)
994 FRAME_PTR f;
996 set_frame_menubar (f, 0, 1);
998 /* Lock out further menubar changes while active. */
999 f->output_data.w32->menubar_active = 1;
1001 /* Signal input thread to return from WM_INITMENU. */
1002 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
1005 /* This callback is called from the menu bar pulldown menu
1006 when the user makes a selection.
1007 Figure out what the user chose
1008 and put the appropriate events into the keyboard buffer. */
1010 void
1011 menubar_selection_callback (FRAME_PTR f, void * client_data)
1013 Lisp_Object prefix, entry;
1014 Lisp_Object vector;
1015 Lisp_Object *subprefix_stack;
1016 int submenu_depth = 0;
1017 int i;
1019 if (!f)
1020 return;
1021 entry = Qnil;
1022 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1023 vector = f->menu_bar_vector;
1024 prefix = Qnil;
1025 i = 0;
1026 while (i < f->menu_bar_items_used)
1028 if (EQ (AREF (vector, i), Qnil))
1030 subprefix_stack[submenu_depth++] = prefix;
1031 prefix = entry;
1032 i++;
1034 else if (EQ (AREF (vector, i), Qlambda))
1036 prefix = subprefix_stack[--submenu_depth];
1037 i++;
1039 else if (EQ (AREF (vector, i), Qt))
1041 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1042 i += MENU_ITEMS_PANE_LENGTH;
1044 else
1046 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1047 /* The EMACS_INT cast avoids a warning. There's no problem
1048 as long as pointers have enough bits to hold small integers. */
1049 if ((int) (EMACS_INT) client_data == i)
1051 int j;
1052 struct input_event buf;
1053 Lisp_Object frame;
1054 EVENT_INIT (buf);
1056 XSETFRAME (frame, f);
1057 buf.kind = MENU_BAR_EVENT;
1058 buf.frame_or_window = frame;
1059 buf.arg = frame;
1060 kbd_buffer_store_event (&buf);
1062 for (j = 0; j < submenu_depth; j++)
1063 if (!NILP (subprefix_stack[j]))
1065 buf.kind = MENU_BAR_EVENT;
1066 buf.frame_or_window = frame;
1067 buf.arg = subprefix_stack[j];
1068 kbd_buffer_store_event (&buf);
1071 if (!NILP (prefix))
1073 buf.kind = MENU_BAR_EVENT;
1074 buf.frame_or_window = frame;
1075 buf.arg = prefix;
1076 kbd_buffer_store_event (&buf);
1079 buf.kind = MENU_BAR_EVENT;
1080 buf.frame_or_window = frame;
1081 buf.arg = entry;
1082 /* Free memory used by owner-drawn and help-echo strings. */
1083 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1084 kbd_buffer_store_event (&buf);
1086 f->output_data.w32->menubar_active = 0;
1087 return;
1089 i += MENU_ITEMS_ITEM_LENGTH;
1092 /* Free memory used by owner-drawn and help-echo strings. */
1093 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1094 f->output_data.w32->menubar_active = 0;
1097 /* Allocate a widget_value, blocking input. */
1099 widget_value *
1100 xmalloc_widget_value ()
1102 widget_value *value;
1104 BLOCK_INPUT;
1105 value = malloc_widget_value ();
1106 UNBLOCK_INPUT;
1108 return value;
1111 /* This recursively calls free_widget_value on the tree of widgets.
1112 It must free all data that was malloc'ed for these widget_values.
1113 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1114 must be left alone. */
1116 void
1117 free_menubar_widget_value_tree (wv)
1118 widget_value *wv;
1120 if (! wv) return;
1122 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1124 if (wv->contents && (wv->contents != (widget_value*)1))
1126 free_menubar_widget_value_tree (wv->contents);
1127 wv->contents = (widget_value *) 0xDEADBEEF;
1129 if (wv->next)
1131 free_menubar_widget_value_tree (wv->next);
1132 wv->next = (widget_value *) 0xDEADBEEF;
1134 BLOCK_INPUT;
1135 free_widget_value (wv);
1136 UNBLOCK_INPUT;
1139 /* Set up data i menu_items for a menu bar item
1140 whose event type is ITEM_KEY (with string ITEM_NAME)
1141 and whose contents come from the list of keymaps MAPS. */
1143 static int
1144 parse_single_submenu (item_key, item_name, maps)
1145 Lisp_Object item_key, item_name, maps;
1147 Lisp_Object length;
1148 int len;
1149 Lisp_Object *mapvec;
1150 int i;
1151 int top_level_items = 0;
1153 length = Flength (maps);
1154 len = XINT (length);
1156 /* Convert the list MAPS into a vector MAPVEC. */
1157 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1158 for (i = 0; i < len; i++)
1160 mapvec[i] = Fcar (maps);
1161 maps = Fcdr (maps);
1164 /* Loop over the given keymaps, making a pane for each map.
1165 But don't make a pane that is empty--ignore that map instead. */
1166 for (i = 0; i < len; i++)
1168 if (SYMBOLP (mapvec[i])
1169 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1171 /* Here we have a command at top level in the menu bar
1172 as opposed to a submenu. */
1173 top_level_items = 1;
1174 push_menu_pane (Qnil, Qnil);
1175 push_menu_item (item_name, Qt, item_key, mapvec[i],
1176 Qnil, Qnil, Qnil, Qnil);
1178 else
1180 Lisp_Object prompt;
1181 prompt = Fkeymap_prompt (mapvec[i]);
1182 single_keymap_panes (mapvec[i],
1183 !NILP (prompt) ? prompt : item_name,
1184 item_key, 0, 10);
1188 return top_level_items;
1192 /* Create a tree of widget_value objects
1193 representing the panes and items
1194 in menu_items starting at index START, up to index END. */
1196 static widget_value *
1197 digest_single_submenu (start, end, top_level_items)
1198 int start, end, top_level_items;
1200 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1201 int i;
1202 int submenu_depth = 0;
1203 widget_value **submenu_stack;
1205 submenu_stack
1206 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1207 wv = xmalloc_widget_value ();
1208 wv->name = "menu";
1209 wv->value = 0;
1210 wv->enabled = 1;
1211 wv->button_type = BUTTON_TYPE_NONE;
1212 wv->help = Qnil;
1213 first_wv = wv;
1214 save_wv = 0;
1215 prev_wv = 0;
1217 /* Loop over all panes and items made by the preceding call
1218 to parse_single_submenu and construct a tree of widget_value objects.
1219 Ignore the panes and items used by previous calls to
1220 digest_single_submenu, even though those are also in menu_items. */
1221 i = start;
1222 while (i < end)
1224 if (EQ (AREF (menu_items, i), Qnil))
1226 submenu_stack[submenu_depth++] = save_wv;
1227 save_wv = prev_wv;
1228 prev_wv = 0;
1229 i++;
1231 else if (EQ (AREF (menu_items, i), Qlambda))
1233 prev_wv = save_wv;
1234 save_wv = submenu_stack[--submenu_depth];
1235 i++;
1237 else if (EQ (AREF (menu_items, i), Qt)
1238 && submenu_depth != 0)
1239 i += MENU_ITEMS_PANE_LENGTH;
1240 /* Ignore a nil in the item list.
1241 It's meaningful only for dialog boxes. */
1242 else if (EQ (AREF (menu_items, i), Qquote))
1243 i += 1;
1244 else if (EQ (AREF (menu_items, i), Qt))
1246 /* Create a new pane. */
1247 Lisp_Object pane_name, prefix;
1248 char *pane_string;
1250 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1251 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1253 if (STRINGP (pane_name))
1255 if (unicode_append_menu)
1256 /* Encode as UTF-8 for now. */
1257 pane_name = ENCODE_UTF_8 (pane_name);
1258 else if (STRING_MULTIBYTE (pane_name))
1259 pane_name = ENCODE_SYSTEM (pane_name);
1261 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1264 pane_string = (NILP (pane_name)
1265 ? "" : (char *) SDATA (pane_name));
1266 /* If there is just one top-level pane, put all its items directly
1267 under the top-level menu. */
1268 if (menu_items_n_panes == 1)
1269 pane_string = "";
1271 /* If the pane has a meaningful name,
1272 make the pane a top-level menu item
1273 with its items as a submenu beneath it. */
1274 if (strcmp (pane_string, ""))
1276 wv = xmalloc_widget_value ();
1277 if (save_wv)
1278 save_wv->next = wv;
1279 else
1280 first_wv->contents = wv;
1281 wv->lname = pane_name;
1282 /* Set value to 1 so update_submenu_strings can handle '@' */
1283 wv->value = (char *) 1;
1284 wv->enabled = 1;
1285 wv->button_type = BUTTON_TYPE_NONE;
1286 wv->help = Qnil;
1288 save_wv = wv;
1289 prev_wv = 0;
1290 i += MENU_ITEMS_PANE_LENGTH;
1292 else
1294 /* Create a new item within current pane. */
1295 Lisp_Object item_name, enable, descrip, def, type, selected;
1296 Lisp_Object help;
1298 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1299 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1300 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1301 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1302 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1303 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1304 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1306 if (STRINGP (item_name))
1308 if (unicode_append_menu)
1309 item_name = ENCODE_UTF_8 (item_name);
1310 else if (STRING_MULTIBYTE (item_name))
1311 item_name = ENCODE_SYSTEM (item_name);
1313 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1316 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1318 descrip = ENCODE_SYSTEM (descrip);
1319 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1322 wv = xmalloc_widget_value ();
1323 if (prev_wv)
1324 prev_wv->next = wv;
1325 else
1326 save_wv->contents = wv;
1328 wv->lname = item_name;
1329 if (!NILP (descrip))
1330 wv->lkey = descrip;
1331 wv->value = 0;
1332 /* The EMACS_INT cast avoids a warning. There's no problem
1333 as long as pointers have enough bits to hold small integers. */
1334 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1335 wv->enabled = !NILP (enable);
1337 if (NILP (type))
1338 wv->button_type = BUTTON_TYPE_NONE;
1339 else if (EQ (type, QCradio))
1340 wv->button_type = BUTTON_TYPE_RADIO;
1341 else if (EQ (type, QCtoggle))
1342 wv->button_type = BUTTON_TYPE_TOGGLE;
1343 else
1344 abort ();
1346 wv->selected = !NILP (selected);
1347 if (!STRINGP (help))
1348 help = Qnil;
1350 wv->help = help;
1352 prev_wv = wv;
1354 i += MENU_ITEMS_ITEM_LENGTH;
1358 /* If we have just one "menu item"
1359 that was originally a button, return it by itself. */
1360 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1362 wv = first_wv->contents;
1363 free_widget_value (first_wv);
1364 return wv;
1367 return first_wv;
1371 /* Walk through the widget_value tree starting at FIRST_WV and update
1372 the char * pointers from the corresponding lisp values.
1373 We do this after building the whole tree, since GC may happen while the
1374 tree is constructed, and small strings are relocated. So we must wait
1375 until no GC can happen before storing pointers into lisp values. */
1376 static void
1377 update_submenu_strings (first_wv)
1378 widget_value *first_wv;
1380 widget_value *wv;
1382 for (wv = first_wv; wv; wv = wv->next)
1384 if (wv->lname && ! NILP (wv->lname))
1386 wv->name = SDATA (wv->lname);
1388 /* Ignore the @ that means "separate pane".
1389 This is a kludge, but this isn't worth more time. */
1390 if (wv->value == (char *)1)
1392 if (wv->name[0] == '@')
1393 wv->name++;
1394 wv->value = 0;
1398 if (wv->lkey && ! NILP (wv->lkey))
1399 wv->key = SDATA (wv->lkey);
1401 if (wv->contents)
1402 update_submenu_strings (wv->contents);
1407 /* Set the contents of the menubar widgets of frame F.
1408 The argument FIRST_TIME is currently ignored;
1409 it is set the first time this is called, from initialize_frame_menubar. */
1411 void
1412 set_frame_menubar (f, first_time, deep_p)
1413 FRAME_PTR f;
1414 int first_time;
1415 int deep_p;
1417 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1418 Lisp_Object items;
1419 widget_value *wv, *first_wv, *prev_wv = 0;
1420 int i, last_i;
1421 int *submenu_start, *submenu_end;
1422 int *submenu_top_level_items, *submenu_n_panes;
1424 /* We must not change the menubar when actually in use. */
1425 if (f->output_data.w32->menubar_active)
1426 return;
1428 XSETFRAME (Vmenu_updating_frame, f);
1430 if (! menubar_widget)
1431 deep_p = 1;
1432 else if (pending_menu_activation && !deep_p)
1433 deep_p = 1;
1435 if (deep_p)
1437 /* Make a widget-value tree representing the entire menu trees. */
1439 struct buffer *prev = current_buffer;
1440 Lisp_Object buffer;
1441 int specpdl_count = SPECPDL_INDEX ();
1442 int previous_menu_items_used = f->menu_bar_items_used;
1443 Lisp_Object *previous_items
1444 = (Lisp_Object *) alloca (previous_menu_items_used
1445 * sizeof (Lisp_Object));
1447 /* If we are making a new widget, its contents are empty,
1448 do always reinitialize them. */
1449 if (! menubar_widget)
1450 previous_menu_items_used = 0;
1452 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1453 specbind (Qinhibit_quit, Qt);
1454 /* Don't let the debugger step into this code
1455 because it is not reentrant. */
1456 specbind (Qdebug_on_next_call, Qnil);
1458 record_unwind_save_match_data ();
1460 if (NILP (Voverriding_local_map_menu_flag))
1462 specbind (Qoverriding_terminal_local_map, Qnil);
1463 specbind (Qoverriding_local_map, Qnil);
1466 set_buffer_internal_1 (XBUFFER (buffer));
1468 /* Run the Lucid hook. */
1469 safe_run_hooks (Qactivate_menubar_hook);
1470 /* If it has changed current-menubar from previous value,
1471 really recompute the menubar from the value. */
1472 if (! NILP (Vlucid_menu_bar_dirty_flag))
1473 call0 (Qrecompute_lucid_menubar);
1474 safe_run_hooks (Qmenu_bar_update_hook);
1475 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1477 items = FRAME_MENU_BAR_ITEMS (f);
1479 /* Save the frame's previous menu bar contents data. */
1480 if (previous_menu_items_used)
1481 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1482 previous_menu_items_used * sizeof (Lisp_Object));
1484 /* Fill in menu_items with the current menu bar contents.
1485 This can evaluate Lisp code. */
1486 menu_items = f->menu_bar_vector;
1487 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1488 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1489 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1490 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1491 submenu_top_level_items
1492 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1493 init_menu_items ();
1494 for (i = 0; i < ASIZE (items); i += 4)
1496 Lisp_Object key, string, maps;
1498 last_i = i;
1500 key = AREF (items, i);
1501 string = AREF (items, i + 1);
1502 maps = AREF (items, i + 2);
1503 if (NILP (string))
1504 break;
1506 submenu_start[i] = menu_items_used;
1508 menu_items_n_panes = 0;
1509 submenu_top_level_items[i]
1510 = parse_single_submenu (key, string, maps);
1511 submenu_n_panes[i] = menu_items_n_panes;
1513 submenu_end[i] = menu_items_used;
1516 finish_menu_items ();
1518 /* Convert menu_items into widget_value trees
1519 to display the menu. This cannot evaluate Lisp code. */
1521 wv = xmalloc_widget_value ();
1522 wv->name = "menubar";
1523 wv->value = 0;
1524 wv->enabled = 1;
1525 wv->button_type = BUTTON_TYPE_NONE;
1526 wv->help = Qnil;
1527 first_wv = wv;
1529 for (i = 0; i < last_i; i += 4)
1531 menu_items_n_panes = submenu_n_panes[i];
1532 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1533 submenu_top_level_items[i]);
1534 if (prev_wv)
1535 prev_wv->next = wv;
1536 else
1537 first_wv->contents = wv;
1538 /* Don't set wv->name here; GC during the loop might relocate it. */
1539 wv->enabled = 1;
1540 wv->button_type = BUTTON_TYPE_NONE;
1541 prev_wv = wv;
1544 set_buffer_internal_1 (prev);
1545 unbind_to (specpdl_count, Qnil);
1547 /* If there has been no change in the Lisp-level contents
1548 of the menu bar, skip redisplaying it. Just exit. */
1550 for (i = 0; i < previous_menu_items_used; i++)
1551 if (menu_items_used == i
1552 || (!EQ (previous_items[i], AREF (menu_items, i))))
1553 break;
1554 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1556 free_menubar_widget_value_tree (first_wv);
1557 menu_items = Qnil;
1559 return;
1562 /* Now GC cannot happen during the lifetime of the widget_value,
1563 so it's safe to store data from a Lisp_String, as long as
1564 local copies are made when the actual menu is created.
1565 Windows takes care of this for normal string items, but
1566 not for owner-drawn items or additional item-info. */
1567 wv = first_wv->contents;
1568 for (i = 0; i < ASIZE (items); i += 4)
1570 Lisp_Object string;
1571 string = AREF (items, i + 1);
1572 if (NILP (string))
1573 break;
1574 wv->name = (char *) SDATA (string);
1575 update_submenu_strings (wv->contents);
1576 wv = wv->next;
1579 f->menu_bar_vector = menu_items;
1580 f->menu_bar_items_used = menu_items_used;
1581 menu_items = Qnil;
1583 else
1585 /* Make a widget-value tree containing
1586 just the top level menu bar strings. */
1588 wv = xmalloc_widget_value ();
1589 wv->name = "menubar";
1590 wv->value = 0;
1591 wv->enabled = 1;
1592 wv->button_type = BUTTON_TYPE_NONE;
1593 wv->help = Qnil;
1594 first_wv = wv;
1596 items = FRAME_MENU_BAR_ITEMS (f);
1597 for (i = 0; i < ASIZE (items); i += 4)
1599 Lisp_Object string;
1601 string = AREF (items, i + 1);
1602 if (NILP (string))
1603 break;
1605 wv = xmalloc_widget_value ();
1606 wv->name = (char *) SDATA (string);
1607 wv->value = 0;
1608 wv->enabled = 1;
1609 wv->button_type = BUTTON_TYPE_NONE;
1610 wv->help = Qnil;
1611 /* This prevents lwlib from assuming this
1612 menu item is really supposed to be empty. */
1613 /* The EMACS_INT cast avoids a warning.
1614 This value just has to be different from small integers. */
1615 wv->call_data = (void *) (EMACS_INT) (-1);
1617 if (prev_wv)
1618 prev_wv->next = wv;
1619 else
1620 first_wv->contents = wv;
1621 prev_wv = wv;
1624 /* Forget what we thought we knew about what is in the
1625 detailed contents of the menu bar menus.
1626 Changing the top level always destroys the contents. */
1627 f->menu_bar_items_used = 0;
1630 /* Create or update the menu bar widget. */
1632 BLOCK_INPUT;
1634 if (menubar_widget)
1636 /* Empty current menubar, rather than creating a fresh one. */
1637 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1640 else
1642 menubar_widget = CreateMenu ();
1644 fill_in_menu (menubar_widget, first_wv->contents);
1646 free_menubar_widget_value_tree (first_wv);
1649 HMENU old_widget = f->output_data.w32->menubar_widget;
1651 f->output_data.w32->menubar_widget = menubar_widget;
1652 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1653 /* Causes flicker when menu bar is updated
1654 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1656 /* Force the window size to be recomputed so that the frame's text
1657 area remains the same, if menubar has just been created. */
1658 if (old_widget == NULL)
1659 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1662 UNBLOCK_INPUT;
1665 /* Called from Fx_create_frame to create the initial menubar of a frame
1666 before it is mapped, so that the window is mapped with the menubar already
1667 there instead of us tacking it on later and thrashing the window after it
1668 is visible. */
1670 void
1671 initialize_frame_menubar (f)
1672 FRAME_PTR f;
1674 /* This function is called before the first chance to redisplay
1675 the frame. It has to be, so the frame will have the right size. */
1676 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1677 set_frame_menubar (f, 1, 1);
1680 /* Get rid of the menu bar of frame F, and free its storage.
1681 This is used when deleting a frame, and when turning off the menu bar. */
1683 void
1684 free_frame_menubar (f)
1685 FRAME_PTR f;
1687 BLOCK_INPUT;
1690 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1691 SetMenu (FRAME_W32_WINDOW (f), NULL);
1692 f->output_data.w32->menubar_widget = NULL;
1693 DestroyMenu (old);
1696 UNBLOCK_INPUT;
1700 /* w32_menu_show actually displays a menu using the panes and items in
1701 menu_items and returns the value selected from it; we assume input
1702 is blocked by the caller. */
1704 /* F is the frame the menu is for.
1705 X and Y are the frame-relative specified position,
1706 relative to the inside upper left corner of the frame F.
1707 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1708 KEYMAPS is 1 if this menu was specified with keymaps;
1709 in that case, we return a list containing the chosen item's value
1710 and perhaps also the pane's prefix.
1711 TITLE is the specified menu title.
1712 ERROR is a place to store an error message string in case of failure.
1713 (We return nil on failure, but the value doesn't actually matter.) */
1715 static Lisp_Object
1716 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1717 FRAME_PTR f;
1718 int x;
1719 int y;
1720 int for_click;
1721 int keymaps;
1722 Lisp_Object title;
1723 char **error;
1725 int i;
1726 int menu_item_selection;
1727 HMENU menu;
1728 POINT pos;
1729 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1730 widget_value **submenu_stack
1731 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1732 Lisp_Object *subprefix_stack
1733 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1734 int submenu_depth = 0;
1735 int first_pane;
1737 *error = NULL;
1739 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1741 *error = "Empty menu";
1742 return Qnil;
1745 /* Create a tree of widget_value objects
1746 representing the panes and their items. */
1747 wv = xmalloc_widget_value ();
1748 wv->name = "menu";
1749 wv->value = 0;
1750 wv->enabled = 1;
1751 wv->button_type = BUTTON_TYPE_NONE;
1752 wv->help = Qnil;
1753 first_wv = wv;
1754 first_pane = 1;
1756 /* Loop over all panes and items, filling in the tree. */
1757 i = 0;
1758 while (i < menu_items_used)
1760 if (EQ (AREF (menu_items, i), Qnil))
1762 submenu_stack[submenu_depth++] = save_wv;
1763 save_wv = prev_wv;
1764 prev_wv = 0;
1765 first_pane = 1;
1766 i++;
1768 else if (EQ (AREF (menu_items, i), Qlambda))
1770 prev_wv = save_wv;
1771 save_wv = submenu_stack[--submenu_depth];
1772 first_pane = 0;
1773 i++;
1775 else if (EQ (AREF (menu_items, i), Qt)
1776 && submenu_depth != 0)
1777 i += MENU_ITEMS_PANE_LENGTH;
1778 /* Ignore a nil in the item list.
1779 It's meaningful only for dialog boxes. */
1780 else if (EQ (AREF (menu_items, i), Qquote))
1781 i += 1;
1782 else if (EQ (AREF (menu_items, i), Qt))
1784 /* Create a new pane. */
1785 Lisp_Object pane_name, prefix;
1786 char *pane_string;
1787 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1788 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1790 if (STRINGP (pane_name))
1792 if (unicode_append_menu)
1793 pane_name = ENCODE_UTF_8 (pane_name);
1794 else if (STRING_MULTIBYTE (pane_name))
1795 pane_name = ENCODE_SYSTEM (pane_name);
1797 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1800 pane_string = (NILP (pane_name)
1801 ? "" : (char *) SDATA (pane_name));
1802 /* If there is just one top-level pane, put all its items directly
1803 under the top-level menu. */
1804 if (menu_items_n_panes == 1)
1805 pane_string = "";
1807 /* If the pane has a meaningful name,
1808 make the pane a top-level menu item
1809 with its items as a submenu beneath it. */
1810 if (!keymaps && strcmp (pane_string, ""))
1812 wv = xmalloc_widget_value ();
1813 if (save_wv)
1814 save_wv->next = wv;
1815 else
1816 first_wv->contents = wv;
1817 wv->name = pane_string;
1818 if (keymaps && !NILP (prefix))
1819 wv->name++;
1820 wv->value = 0;
1821 wv->enabled = 1;
1822 wv->button_type = BUTTON_TYPE_NONE;
1823 wv->help = Qnil;
1824 save_wv = wv;
1825 prev_wv = 0;
1827 else if (first_pane)
1829 save_wv = wv;
1830 prev_wv = 0;
1832 first_pane = 0;
1833 i += MENU_ITEMS_PANE_LENGTH;
1835 else
1837 /* Create a new item within current pane. */
1838 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1840 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1841 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1842 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1843 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1844 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1845 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1846 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1848 if (STRINGP (item_name))
1850 if (unicode_append_menu)
1851 item_name = ENCODE_UTF_8 (item_name);
1852 else if (STRING_MULTIBYTE (item_name))
1853 item_name = ENCODE_SYSTEM (item_name);
1855 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1858 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1860 descrip = ENCODE_SYSTEM (descrip);
1861 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1864 wv = xmalloc_widget_value ();
1865 if (prev_wv)
1866 prev_wv->next = wv;
1867 else
1868 save_wv->contents = wv;
1869 wv->name = (char *) SDATA (item_name);
1870 if (!NILP (descrip))
1871 wv->key = (char *) SDATA (descrip);
1872 wv->value = 0;
1873 /* Use the contents index as call_data, since we are
1874 restricted to 16-bits. */
1875 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1876 wv->enabled = !NILP (enable);
1878 if (NILP (type))
1879 wv->button_type = BUTTON_TYPE_NONE;
1880 else if (EQ (type, QCtoggle))
1881 wv->button_type = BUTTON_TYPE_TOGGLE;
1882 else if (EQ (type, QCradio))
1883 wv->button_type = BUTTON_TYPE_RADIO;
1884 else
1885 abort ();
1887 wv->selected = !NILP (selected);
1888 if (!STRINGP (help))
1889 help = Qnil;
1891 wv->help = help;
1893 prev_wv = wv;
1895 i += MENU_ITEMS_ITEM_LENGTH;
1899 /* Deal with the title, if it is non-nil. */
1900 if (!NILP (title))
1902 widget_value *wv_title = xmalloc_widget_value ();
1903 widget_value *wv_sep = xmalloc_widget_value ();
1905 /* Maybe replace this separator with a bitmap or owner-draw item
1906 so that it looks better. Having two separators looks odd. */
1907 wv_sep->name = "--";
1908 wv_sep->next = first_wv->contents;
1909 wv_sep->help = Qnil;
1911 if (unicode_append_menu)
1912 title = ENCODE_UTF_8 (title);
1913 else if (STRING_MULTIBYTE (title))
1914 title = ENCODE_SYSTEM (title);
1916 wv_title->name = (char *) SDATA (title);
1917 wv_title->enabled = TRUE;
1918 wv_title->title = TRUE;
1919 wv_title->button_type = BUTTON_TYPE_NONE;
1920 wv_title->help = Qnil;
1921 wv_title->next = wv_sep;
1922 first_wv->contents = wv_title;
1925 /* Actually create the menu. */
1926 current_popup_menu = menu = CreatePopupMenu ();
1927 fill_in_menu (menu, first_wv->contents);
1929 /* Adjust coordinates to be root-window-relative. */
1930 pos.x = x;
1931 pos.y = y;
1932 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1934 /* No selection has been chosen yet. */
1935 menu_item_selection = 0;
1937 /* Display the menu. */
1938 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1939 WM_EMACS_TRACKPOPUPMENU,
1940 (WPARAM)menu, (LPARAM)&pos);
1942 /* Clean up extraneous mouse events which might have been generated
1943 during the call. */
1944 discard_mouse_events ();
1946 /* Free the widget_value objects we used to specify the contents. */
1947 free_menubar_widget_value_tree (first_wv);
1949 DestroyMenu (menu);
1951 /* Free the owner-drawn and help-echo menu strings. */
1952 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1953 f->output_data.w32->menubar_active = 0;
1955 /* Find the selected item, and its pane, to return
1956 the proper value. */
1957 if (menu_item_selection != 0)
1959 Lisp_Object prefix, entry;
1961 prefix = entry = Qnil;
1962 i = 0;
1963 while (i < menu_items_used)
1965 if (EQ (AREF (menu_items, i), Qnil))
1967 subprefix_stack[submenu_depth++] = prefix;
1968 prefix = entry;
1969 i++;
1971 else if (EQ (AREF (menu_items, i), Qlambda))
1973 prefix = subprefix_stack[--submenu_depth];
1974 i++;
1976 else if (EQ (AREF (menu_items, i), Qt))
1978 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1979 i += MENU_ITEMS_PANE_LENGTH;
1981 /* Ignore a nil in the item list.
1982 It's meaningful only for dialog boxes. */
1983 else if (EQ (AREF (menu_items, i), Qquote))
1984 i += 1;
1985 else
1987 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1988 if (menu_item_selection == i)
1990 if (keymaps != 0)
1992 int j;
1994 entry = Fcons (entry, Qnil);
1995 if (!NILP (prefix))
1996 entry = Fcons (prefix, entry);
1997 for (j = submenu_depth - 1; j >= 0; j--)
1998 if (!NILP (subprefix_stack[j]))
1999 entry = Fcons (subprefix_stack[j], entry);
2001 return entry;
2003 i += MENU_ITEMS_ITEM_LENGTH;
2007 else if (!for_click)
2008 /* Make "Cancel" equivalent to C-g. */
2009 Fsignal (Qquit, Qnil);
2011 return Qnil;
2015 #ifdef HAVE_DIALOGS
2016 /* TODO: On Windows, there are two ways of defining a dialog.
2018 1. Create a predefined dialog resource and include it in nt/emacs.rc.
2019 Using this method, we could then set the titles and make unneeded
2020 buttons invisible before displaying the dialog. Everything would
2021 be a fixed size though, so there is a risk that text does not
2022 fit on a button.
2023 2. Create the dialog template in memory on the fly. This allows us
2024 to size the dialog and buttons dynamically, probably giving more
2025 natural looking results for dialogs with few buttons, and eliminating
2026 the problem of text overflowing the buttons. But the API for this is
2027 quite complex - structures have to be allocated in particular ways,
2028 text content is tacked onto the end of structures in variable length
2029 arrays with further structures tacked on after these, there are
2030 certain alignment requirements for all this, and we have to
2031 measure all the text and convert to "dialog coordinates" to figure
2032 out how big to make everything.
2034 For now, we'll just stick with menus for dialogs that are more
2035 complicated than simple yes/no type questions for which we can use
2036 the MessageBox function.
2039 static char * button_names [] = {
2040 "button1", "button2", "button3", "button4", "button5",
2041 "button6", "button7", "button8", "button9", "button10" };
2043 static Lisp_Object
2044 w32_dialog_show (f, keymaps, title, header, error)
2045 FRAME_PTR f;
2046 int keymaps;
2047 Lisp_Object title, header;
2048 char **error;
2050 int i, nb_buttons=0;
2051 char dialog_name[6];
2052 int menu_item_selection;
2054 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2056 /* Number of elements seen so far, before boundary. */
2057 int left_count = 0;
2058 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2059 int boundary_seen = 0;
2061 *error = NULL;
2063 if (menu_items_n_panes > 1)
2065 *error = "Multiple panes in dialog box";
2066 return Qnil;
2069 /* Create a tree of widget_value objects
2070 representing the text label and buttons. */
2072 Lisp_Object pane_name, prefix;
2073 char *pane_string;
2074 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2075 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2076 pane_string = (NILP (pane_name)
2077 ? "" : (char *) SDATA (pane_name));
2078 prev_wv = xmalloc_widget_value ();
2079 prev_wv->value = pane_string;
2080 if (keymaps && !NILP (prefix))
2081 prev_wv->name++;
2082 prev_wv->enabled = 1;
2083 prev_wv->name = "message";
2084 prev_wv->help = Qnil;
2085 first_wv = prev_wv;
2087 /* Loop over all panes and items, filling in the tree. */
2088 i = MENU_ITEMS_PANE_LENGTH;
2089 while (i < menu_items_used)
2092 /* Create a new item within current pane. */
2093 Lisp_Object item_name, enable, descrip, help;
2095 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2096 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2097 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2098 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2100 if (NILP (item_name))
2102 free_menubar_widget_value_tree (first_wv);
2103 *error = "Submenu in dialog items";
2104 return Qnil;
2106 if (EQ (item_name, Qquote))
2108 /* This is the boundary between left-side elts
2109 and right-side elts. Stop incrementing right_count. */
2110 boundary_seen = 1;
2111 i++;
2112 continue;
2114 if (nb_buttons >= 9)
2116 free_menubar_widget_value_tree (first_wv);
2117 *error = "Too many dialog items";
2118 return Qnil;
2121 wv = xmalloc_widget_value ();
2122 prev_wv->next = wv;
2123 wv->name = (char *) button_names[nb_buttons];
2124 if (!NILP (descrip))
2125 wv->key = (char *) SDATA (descrip);
2126 wv->value = (char *) SDATA (item_name);
2127 wv->call_data = (void *) &AREF (menu_items, i);
2128 wv->enabled = !NILP (enable);
2129 wv->help = Qnil;
2130 prev_wv = wv;
2132 if (! boundary_seen)
2133 left_count++;
2135 nb_buttons++;
2136 i += MENU_ITEMS_ITEM_LENGTH;
2139 /* If the boundary was not specified,
2140 by default put half on the left and half on the right. */
2141 if (! boundary_seen)
2142 left_count = nb_buttons - nb_buttons / 2;
2144 wv = xmalloc_widget_value ();
2145 wv->name = dialog_name;
2146 wv->help = Qnil;
2148 /* Frame title: 'Q' = Question, 'I' = Information.
2149 Can also have 'E' = Error if, one day, we want
2150 a popup for errors. */
2151 if (NILP(header))
2152 dialog_name[0] = 'Q';
2153 else
2154 dialog_name[0] = 'I';
2156 /* Dialog boxes use a really stupid name encoding
2157 which specifies how many buttons to use
2158 and how many buttons are on the right. */
2159 dialog_name[1] = '0' + nb_buttons;
2160 dialog_name[2] = 'B';
2161 dialog_name[3] = 'R';
2162 /* Number of buttons to put on the right. */
2163 dialog_name[4] = '0' + nb_buttons - left_count;
2164 dialog_name[5] = 0;
2165 wv->contents = first_wv;
2166 first_wv = wv;
2169 /* Actually create the dialog. */
2170 dialog_id = widget_id_tick++;
2171 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2172 f->output_data.w32->widget, 1, 0,
2173 dialog_selection_callback, 0);
2174 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2176 /* Free the widget_value objects we used to specify the contents. */
2177 free_menubar_widget_value_tree (first_wv);
2179 /* No selection has been chosen yet. */
2180 menu_item_selection = 0;
2182 /* Display the menu. */
2183 lw_pop_up_all_widgets (dialog_id);
2185 /* Process events that apply to the menu. */
2186 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2188 lw_destroy_all_widgets (dialog_id);
2190 /* Find the selected item, and its pane, to return
2191 the proper value. */
2192 if (menu_item_selection != 0)
2194 Lisp_Object prefix;
2196 prefix = Qnil;
2197 i = 0;
2198 while (i < menu_items_used)
2200 Lisp_Object entry;
2202 if (EQ (AREF (menu_items, i), Qt))
2204 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2205 i += MENU_ITEMS_PANE_LENGTH;
2207 else
2209 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2210 if (menu_item_selection == i)
2212 if (keymaps != 0)
2214 entry = Fcons (entry, Qnil);
2215 if (!NILP (prefix))
2216 entry = Fcons (prefix, entry);
2218 return entry;
2220 i += MENU_ITEMS_ITEM_LENGTH;
2224 else
2225 /* Make "Cancel" equivalent to C-g. */
2226 Fsignal (Qquit, Qnil);
2228 return Qnil;
2230 #else /* !HAVE_DIALOGS */
2232 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
2233 simple dialogs. We could handle a few more, but I'm not aware of
2234 anywhere in Emacs that uses the other specific dialog choices that
2235 MessageBox provides. */
2237 static int is_simple_dialog (contents)
2238 Lisp_Object contents;
2240 Lisp_Object options = XCDR (contents);
2241 Lisp_Object name, yes, no, other;
2243 yes = build_string ("Yes");
2244 no = build_string ("No");
2246 if (!CONSP (options))
2247 return 0;
2249 name = XCAR (XCAR (options));
2250 if (!CONSP (options))
2251 return 0;
2253 if (!NILP (Fstring_equal (name, yes)))
2254 other = no;
2255 else if (!NILP (Fstring_equal (name, no)))
2256 other = yes;
2257 else
2258 return 0;
2260 options = XCDR (options);
2261 if (!CONSP (options))
2262 return 0;
2264 name = XCAR (XCAR (options));
2265 if (NILP (Fstring_equal (name, other)))
2266 return 0;
2268 /* Check there are no more options. */
2269 options = XCDR (options);
2270 return !(CONSP (options));
2273 static Lisp_Object simple_dialog_show (f, contents, header)
2274 FRAME_PTR f;
2275 Lisp_Object contents, header;
2277 int answer;
2278 UINT type;
2279 char *text, *title;
2280 Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
2282 if (STRINGP (temp))
2283 text = SDATA (temp);
2284 else
2285 text = "";
2287 if (NILP (header))
2289 title = "Question";
2290 type = MB_ICONQUESTION;
2292 else
2294 title = "Information";
2295 type = MB_ICONINFORMATION;
2297 type |= MB_YESNO;
2299 /* Since we only handle Yes/No dialogs, and we already checked
2300 is_simple_dialog, we don't need to worry about checking contents
2301 to see what type of dialog to use. */
2302 answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
2304 if (answer == IDYES)
2305 lispy_answer = build_string ("Yes");
2306 else if (answer == IDNO)
2307 lispy_answer = build_string ("No");
2308 else
2309 Fsignal (Qquit, Qnil);
2311 for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
2313 Lisp_Object item, name, value;
2314 item = XCAR (temp);
2315 if (CONSP (item))
2317 name = XCAR (item);
2318 value = XCDR (item);
2320 else
2322 name = item;
2323 value = Qnil;
2326 if (!NILP (Fstring_equal (name, lispy_answer)))
2328 return value;
2331 Fsignal (Qquit, Qnil);
2332 return Qnil;
2334 #endif /* !HAVE_DIALOGS */
2337 /* Is this item a separator? */
2338 static int
2339 name_is_separator (name)
2340 char *name;
2342 char *start = name;
2344 /* Check if name string consists of only dashes ('-'). */
2345 while (*name == '-') name++;
2346 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2347 or "--deep-shadow". We don't implement them yet, se we just treat
2348 them like normal separators. */
2349 return (*name == '\0' || start + 2 == name);
2353 /* Indicate boundary between left and right. */
2354 static int
2355 add_left_right_boundary (HMENU menu)
2357 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2360 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2361 static void
2362 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2364 while (len > 0)
2366 int utf16;
2367 if (*src < 0x80)
2369 *dest = (WCHAR) *src;
2370 dest++; src++; len--;
2372 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2373 else if (*src < 0xC0)
2375 src++; len--;
2377 /* 2 char UTF-8 sequence. */
2378 else if (*src < 0xE0)
2380 *dest = (WCHAR) (((*src & 0x1f) << 6)
2381 | (*(src + 1) & 0x3f));
2382 src += 2; len -= 2; dest++;
2384 else if (*src < 0xF0)
2386 *dest = (WCHAR) (((*src & 0x0f) << 12)
2387 | ((*(src + 1) & 0x3f) << 6)
2388 | (*(src + 2) & 0x3f));
2389 src += 3; len -= 3; dest++;
2391 else /* Not encodable. Insert Unicode Substitution char. */
2393 *dest = (WCHAR) 0xfffd;
2394 src++; len--; dest++;
2397 *dest = 0;
2400 static int
2401 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2403 UINT fuFlags;
2404 char *out_string, *p, *q;
2405 int return_value;
2406 size_t nlen, orig_len;
2408 if (name_is_separator (wv->name))
2410 fuFlags = MF_SEPARATOR;
2411 out_string = NULL;
2413 else
2415 if (wv->enabled)
2416 fuFlags = MF_STRING;
2417 else
2418 fuFlags = MF_STRING | MF_GRAYED;
2420 if (wv->key != NULL)
2422 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2423 strcpy (out_string, wv->name);
2424 strcat (out_string, "\t");
2425 strcat (out_string, wv->key);
2427 else
2428 out_string = wv->name;
2430 /* Quote any special characters within the menu item's text and
2431 key binding. */
2432 nlen = orig_len = strlen (out_string);
2433 if (unicode_append_menu)
2435 /* With UTF-8, & cannot be part of a multibyte character. */
2436 for (p = out_string; *p; p++)
2438 if (*p == '&')
2439 nlen++;
2442 else
2444 /* If encoded with the system codepage, use multibyte string
2445 functions in case of multibyte characters that contain '&'. */
2446 for (p = out_string; *p; p = _mbsinc (p))
2448 if (_mbsnextc (p) == '&')
2449 nlen++;
2453 if (nlen > orig_len)
2455 p = out_string;
2456 out_string = alloca (nlen + 1);
2457 q = out_string;
2458 while (*p)
2460 if (unicode_append_menu)
2462 if (*p == '&')
2463 *q++ = *p;
2464 *q++ = *p++;
2466 else
2468 if (_mbsnextc (p) == '&')
2470 _mbsncpy (q, p, 1);
2471 q = _mbsinc (q);
2473 _mbsncpy (q, p, 1);
2474 p = _mbsinc (p);
2475 q = _mbsinc (q);
2478 *q = '\0';
2481 if (item != NULL)
2482 fuFlags = MF_POPUP;
2483 else if (wv->title || wv->call_data == 0)
2485 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2486 we can't deallocate the memory otherwise. */
2487 if (get_menu_item_info)
2489 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2490 strcpy (out_string, wv->name);
2491 #ifdef MENU_DEBUG
2492 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2493 #endif
2494 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2496 else
2497 fuFlags = MF_DISABLED;
2500 /* Draw radio buttons and tickboxes. */
2501 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2502 wv->button_type == BUTTON_TYPE_RADIO))
2503 fuFlags |= MF_CHECKED;
2504 else
2505 fuFlags |= MF_UNCHECKED;
2508 if (unicode_append_menu && out_string)
2510 /* Convert out_string from UTF-8 to UTF-16-LE. */
2511 int utf8_len = strlen (out_string);
2512 WCHAR * utf16_string;
2513 if (fuFlags & MF_OWNERDRAW)
2514 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2515 else
2516 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2518 utf8to16 (out_string, utf8_len, utf16_string);
2519 return_value = unicode_append_menu (menu, fuFlags,
2520 item != NULL ? (UINT) item
2521 : (UINT) wv->call_data,
2522 utf16_string);
2523 if (!return_value)
2525 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2526 apparently does exist at least in some cases and appears to be
2527 stubbed out to do nothing. out_string is UTF-8, but since
2528 our standard menus are in English and this is only going to
2529 happen the first time a menu is used, the encoding is
2530 of minor importance compared with menus not working at all. */
2531 return_value =
2532 AppendMenu (menu, fuFlags,
2533 item != NULL ? (UINT) item: (UINT) wv->call_data,
2534 out_string);
2535 /* Don't use unicode menus in future. */
2536 unicode_append_menu = NULL;
2539 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2540 local_free (out_string);
2542 else
2544 return_value =
2545 AppendMenu (menu,
2546 fuFlags,
2547 item != NULL ? (UINT) item : (UINT) wv->call_data,
2548 out_string );
2551 /* This must be done after the menu item is created. */
2552 if (!wv->title && wv->call_data != 0)
2554 if (set_menu_item_info)
2556 MENUITEMINFO info;
2557 bzero (&info, sizeof (info));
2558 info.cbSize = sizeof (info);
2559 info.fMask = MIIM_DATA;
2561 /* Set help string for menu item. Leave it as a Lisp_Object
2562 until it is ready to be displayed, since GC can happen while
2563 menus are active. */
2564 if (!NILP (wv->help))
2565 #ifdef USE_LISP_UNION_TYPE
2566 info.dwItemData = (DWORD) (wv->help).i;
2567 #else
2568 info.dwItemData = (DWORD) (wv->help);
2569 #endif
2570 if (wv->button_type == BUTTON_TYPE_RADIO)
2572 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2573 RADIO items, but is not available on NT 3.51 and earlier. */
2574 info.fMask |= MIIM_TYPE | MIIM_STATE;
2575 info.fType = MFT_RADIOCHECK | MFT_STRING;
2576 info.dwTypeData = out_string;
2577 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2580 set_menu_item_info (menu,
2581 item != NULL ? (UINT) item : (UINT) wv->call_data,
2582 FALSE, &info);
2585 return return_value;
2588 /* Construct native Windows menu(bar) based on widget_value tree. */
2590 fill_in_menu (HMENU menu, widget_value *wv)
2592 int items_added = 0;
2594 for ( ; wv != NULL; wv = wv->next)
2596 if (wv->contents)
2598 HMENU sub_menu = CreatePopupMenu ();
2600 if (sub_menu == NULL)
2601 return 0;
2603 if (!fill_in_menu (sub_menu, wv->contents) ||
2604 !add_menu_item (menu, wv, sub_menu))
2606 DestroyMenu (sub_menu);
2607 return 0;
2610 else
2612 if (!add_menu_item (menu, wv, NULL))
2613 return 0;
2616 return 1;
2619 /* Display help string for currently pointed to menu item. Not
2620 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2621 available. */
2622 void
2623 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2625 if (get_menu_item_info)
2627 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2628 Lisp_Object frame, help;
2630 /* No help echo on owner-draw menu items, or when the keyboard is used
2631 to navigate the menus, since tooltips are distracting if they pop
2632 up elsewhere. */
2633 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2634 || !(flags & MF_MOUSESELECT))
2635 help = Qnil;
2636 else
2638 MENUITEMINFO info;
2640 bzero (&info, sizeof (info));
2641 info.cbSize = sizeof (info);
2642 info.fMask = MIIM_DATA;
2643 get_menu_item_info (menu, item, FALSE, &info);
2645 #ifdef USE_LISP_UNION_TYPE
2646 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2647 : Qnil;
2648 #else
2649 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2650 #endif
2653 /* Store the help echo in the keyboard buffer as the X toolkit
2654 version does, rather than directly showing it. This seems to
2655 solve the GC problems that were present when we based the
2656 Windows code on the non-toolkit version. */
2657 if (f)
2659 XSETFRAME (frame, f);
2660 kbd_buffer_store_help_event (frame, help);
2662 else
2663 /* X version has a loop through frames here, which doesn't
2664 appear to do anything, unless it has some side effect. */
2665 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2669 /* Free memory used by owner-drawn strings. */
2670 static void
2671 w32_free_submenu_strings (menu)
2672 HMENU menu;
2674 int i, num = GetMenuItemCount (menu);
2675 for (i = 0; i < num; i++)
2677 MENUITEMINFO info;
2678 bzero (&info, sizeof (info));
2679 info.cbSize = sizeof (info);
2680 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2682 get_menu_item_info (menu, i, TRUE, &info);
2684 /* Owner-drawn names are held in dwItemData. */
2685 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2687 #ifdef MENU_DEBUG
2688 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2689 #endif
2690 local_free (info.dwItemData);
2693 /* Recurse down submenus. */
2694 if (info.hSubMenu)
2695 w32_free_submenu_strings (info.hSubMenu);
2699 void
2700 w32_free_menu_strings (hwnd)
2701 HWND hwnd;
2703 HMENU menu = current_popup_menu;
2705 if (get_menu_item_info)
2707 /* If there is no popup menu active, free the strings from the frame's
2708 menubar. */
2709 if (!menu)
2710 menu = GetMenu (hwnd);
2712 if (menu)
2713 w32_free_submenu_strings (menu);
2716 current_popup_menu = NULL;
2719 #endif /* HAVE_MENUS */
2721 /* The following is used by delayed window autoselection. */
2723 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2724 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2727 #ifdef HAVE_MENUS
2728 FRAME_PTR f;
2729 f = SELECTED_FRAME ();
2730 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2731 #else
2732 return Qnil;
2733 #endif /* HAVE_MENUS */
2736 void syms_of_w32menu ()
2738 globals_of_w32menu ();
2739 staticpro (&menu_items);
2740 menu_items = Qnil;
2742 current_popup_menu = NULL;
2744 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
2746 defsubr (&Sx_popup_menu);
2747 defsubr (&Smenu_or_popup_active_p);
2748 #ifdef HAVE_MENUS
2749 defsubr (&Sx_popup_dialog);
2750 #endif
2754 globals_of_w32menu is used to initialize those global variables that
2755 must always be initialized on startup even when the global variable
2756 initialized is non zero (see the function main in emacs.c).
2757 globals_of_w32menu is called from syms_of_w32menu when the global
2758 variable initialized is 0 and directly from main when initialized
2759 is non zero.
2761 void globals_of_w32menu ()
2763 /* See if Get/SetMenuItemInfo functions are available. */
2764 HMODULE user32 = GetModuleHandle ("user32.dll");
2765 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2766 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2767 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2770 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2771 (do not change this comment) */