(top-level): Don't require cl when compiling.
[emacs.git] / src / w32menu.c
blob8957da895ddfc195ca1b117a4ba59d80fd08a8c7
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 of the License, or
11 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
21 #include <config.h>
23 #include <signal.h>
24 #include <stdio.h>
25 #include <mbstring.h>
27 #include "lisp.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31 #include "termhooks.h"
32 #include "window.h"
33 #include "blockinput.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "character.h"
37 #include "coding.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
41 #include "w32term.h"
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
45 #ifndef makedev
46 #include <sys/types.h>
47 #endif
49 #include "dispextern.h"
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
53 /******************************************************************/
54 /* Definitions copied from lwlib.h */
56 typedef void * XtPointer;
57 typedef char Boolean;
59 enum button_type
61 BUTTON_TYPE_NONE,
62 BUTTON_TYPE_TOGGLE,
63 BUTTON_TYPE_RADIO
66 /* This structure is based on the one in ../lwlib/lwlib.h, modified
67 for Windows. */
68 typedef struct _widget_value
70 /* name of widget */
71 Lisp_Object lname;
72 char* name;
73 /* value (meaning depend on widget type) */
74 char* value;
75 /* keyboard equivalent. no implications for XtTranslations */
76 Lisp_Object lkey;
77 char* key;
78 /* Help string or nil if none.
79 GC finds this string through the frame's menu_bar_vector
80 or through menu_items. */
81 Lisp_Object help;
82 /* true if enabled */
83 Boolean enabled;
84 /* true if selected */
85 Boolean selected;
86 /* The type of a button. */
87 enum button_type button_type;
88 /* true if menu title */
89 Boolean title;
90 #if 0
91 /* true if was edited (maintained by get_value) */
92 Boolean edited;
93 /* true if has changed (maintained by lw library) */
94 change_type change;
95 /* true if this widget itself has changed,
96 but not counting the other widgets found in the `next' field. */
97 change_type this_one_change;
98 #endif
99 /* Contents of the sub-widgets, also selected slot for checkbox */
100 struct _widget_value* contents;
101 /* data passed to callback */
102 XtPointer call_data;
103 /* next one in the list */
104 struct _widget_value* next;
105 #if 0
106 /* slot for the toolkit dependent part. Always initialize to NULL. */
107 void* toolkit_data;
108 /* tell us if we should free the toolkit data slot when freeing the
109 widget_value itself. */
110 Boolean free_toolkit_data;
112 /* we resource the widget_value structures; this points to the next
113 one on the free list if this one has been deallocated.
115 struct _widget_value *free_list;
116 #endif
117 } widget_value;
119 /* Local memory management */
120 #define local_heap (GetProcessHeap ())
121 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
122 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
124 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
125 #define free_widget_value(wv) (local_free ((wv)))
127 /******************************************************************/
129 #ifndef TRUE
130 #define TRUE 1
131 #define FALSE 0
132 #endif /* no TRUE */
134 HMENU current_popup_menu;
136 void syms_of_w32menu ();
137 void globals_of_w32menu ();
139 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
140 IN HMENU,
141 IN UINT,
142 IN BOOL,
143 IN OUT LPMENUITEMINFOA);
144 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
145 IN HMENU,
146 IN UINT,
147 IN BOOL,
148 IN LPCMENUITEMINFOA);
150 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
151 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
152 AppendMenuW_Proc unicode_append_menu = NULL;
154 Lisp_Object Qdebug_on_next_call;
156 extern Lisp_Object Vmenu_updating_frame;
158 extern Lisp_Object Qmenu_bar;
160 extern Lisp_Object QCtoggle, QCradio;
162 extern Lisp_Object Voverriding_local_map;
163 extern Lisp_Object Voverriding_local_map_menu_flag;
165 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
167 extern Lisp_Object Qmenu_bar_update_hook;
169 void set_frame_menubar P_ ((FRAME_PTR, int, int));
171 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
172 Lisp_Object, Lisp_Object, Lisp_Object,
173 Lisp_Object, Lisp_Object));
174 #ifdef HAVE_DIALOGS
175 static Lisp_Object w32_dialog_show P_ ((FRAME_PTR, int, Lisp_Object, char**));
176 #else
177 static int is_simple_dialog P_ ((Lisp_Object));
178 static Lisp_Object simple_dialog_show P_ ((FRAME_PTR, Lisp_Object, Lisp_Object));
179 #endif
180 static Lisp_Object w32_menu_show P_ ((FRAME_PTR, int, int, int, int,
181 Lisp_Object, char **));
183 static void keymap_panes P_ ((Lisp_Object *, int, int));
184 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
185 int, int));
186 static void single_menu_item P_ ((Lisp_Object, Lisp_Object,
187 Lisp_Object *, int, int));
188 static void list_of_panes P_ ((Lisp_Object));
189 static void list_of_items P_ ((Lisp_Object));
190 void w32_free_menu_strings P_((HWND));
192 /* This holds a Lisp vector that holds the results of decoding
193 the keymaps or alist-of-alists that specify a menu.
195 It describes the panes and items within the panes.
197 Each pane is described by 3 elements in the vector:
198 t, the pane name, the pane's prefix key.
199 Then follow the pane's items, with 5 elements per item:
200 the item string, the enable flag, the item's value,
201 the definition, and the equivalent keyboard key's description string.
203 In some cases, multiple levels of menus may be described.
204 A single vector slot containing nil indicates the start of a submenu.
205 A single vector slot containing lambda indicates the end of a submenu.
206 The submenu follows a menu item which is the way to reach the submenu.
208 A single vector slot containing quote indicates that the
209 following items should appear on the right of a dialog box.
211 Using a Lisp vector to hold this information while we decode it
212 takes care of protecting all the data from GC. */
214 #define MENU_ITEMS_PANE_NAME 1
215 #define MENU_ITEMS_PANE_PREFIX 2
216 #define MENU_ITEMS_PANE_LENGTH 3
218 enum menu_item_idx
220 MENU_ITEMS_ITEM_NAME = 0,
221 MENU_ITEMS_ITEM_ENABLE,
222 MENU_ITEMS_ITEM_VALUE,
223 MENU_ITEMS_ITEM_EQUIV_KEY,
224 MENU_ITEMS_ITEM_DEFINITION,
225 MENU_ITEMS_ITEM_TYPE,
226 MENU_ITEMS_ITEM_SELECTED,
227 MENU_ITEMS_ITEM_HELP,
228 MENU_ITEMS_ITEM_LENGTH
231 static Lisp_Object menu_items;
233 /* Number of slots currently allocated in menu_items. */
234 static int menu_items_allocated;
236 /* This is the index in menu_items of the first empty slot. */
237 static int menu_items_used;
239 /* The number of panes currently recorded in menu_items,
240 excluding those within submenus. */
241 static int menu_items_n_panes;
243 /* Current depth within submenus. */
244 static int menu_items_submenu_depth;
246 static int next_menubar_widget_id;
248 /* This is set nonzero after the user activates the menu bar, and set
249 to zero again after the menu bars are redisplayed by prepare_menu_bar.
250 While it is nonzero, all calls to set_frame_menubar go deep.
252 I don't understand why this is needed, but it does seem to be
253 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
255 int pending_menu_activation;
258 /* Return the frame whose ->output_data.w32->menubar_widget equals
259 ID, or 0 if none. */
261 static struct frame *
262 menubar_id_to_frame (id)
263 HMENU id;
265 Lisp_Object tail, frame;
266 FRAME_PTR f;
268 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
270 frame = XCAR (tail);
271 if (!FRAMEP (frame))
272 continue;
273 f = XFRAME (frame);
274 if (!FRAME_WINDOW_P (f))
275 continue;
276 if (f->output_data.w32->menubar_widget == id)
277 return f;
279 return 0;
282 /* Initialize the menu_items structure if we haven't already done so.
283 Also mark it as currently empty. */
285 static void
286 init_menu_items ()
288 if (NILP (menu_items))
290 menu_items_allocated = 60;
291 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
294 menu_items_used = 0;
295 menu_items_n_panes = 0;
296 menu_items_submenu_depth = 0;
299 /* Call at the end of generating the data in menu_items.
300 This fills in the number of items in the last pane. */
302 static void
303 finish_menu_items ()
307 /* Call when finished using the data for the current menu
308 in menu_items. */
310 static void
311 discard_menu_items ()
313 /* Free the structure if it is especially large.
314 Otherwise, hold on to it, to save time. */
315 if (menu_items_allocated > 200)
317 menu_items = Qnil;
318 menu_items_allocated = 0;
322 /* Make the menu_items vector twice as large. */
324 static void
325 grow_menu_items ()
327 menu_items_allocated *= 2;
328 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
331 /* Begin a submenu. */
333 static void
334 push_submenu_start ()
336 if (menu_items_used + 1 > menu_items_allocated)
337 grow_menu_items ();
339 ASET (menu_items, menu_items_used, Qnil);
340 menu_items_used++;
341 menu_items_submenu_depth++;
344 /* End a submenu. */
346 static void
347 push_submenu_end ()
349 if (menu_items_used + 1 > menu_items_allocated)
350 grow_menu_items ();
352 ASET (menu_items, menu_items_used, Qlambda);
353 menu_items_used++;
354 menu_items_submenu_depth--;
357 /* Indicate boundary between left and right. */
359 static void
360 push_left_right_boundary ()
362 if (menu_items_used + 1 > menu_items_allocated)
363 grow_menu_items ();
365 ASET (menu_items, menu_items_used, Qquote);
366 menu_items_used++;
369 /* Start a new menu pane in menu_items.
370 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
372 static void
373 push_menu_pane (name, prefix_vec)
374 Lisp_Object name, prefix_vec;
376 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
377 grow_menu_items ();
379 if (menu_items_submenu_depth == 0)
380 menu_items_n_panes++;
381 ASET (menu_items, menu_items_used, Qt); menu_items_used++;
382 ASET (menu_items, menu_items_used, name); menu_items_used++;
383 ASET (menu_items, menu_items_used, prefix_vec); menu_items_used++;
386 /* Push one menu item into the current pane. NAME is the string to
387 display. ENABLE if non-nil means this item can be selected. KEY
388 is the key generated by choosing this item, or nil if this item
389 doesn't really have a definition. DEF is the definition of this
390 item. EQUIV is the textual description of the keyboard equivalent
391 for this item (or nil if none). TYPE is the type of this menu
392 item, one of nil, `toggle' or `radio'. */
394 static void
395 push_menu_item (name, enable, key, def, equiv, type, selected, help)
396 Lisp_Object name, enable, key, def, equiv, type, selected, help;
398 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
399 grow_menu_items ();
401 ASET (menu_items, menu_items_used, name); menu_items_used++;
402 ASET (menu_items, menu_items_used, enable); menu_items_used++;
403 ASET (menu_items, menu_items_used, key); menu_items_used++;
404 ASET (menu_items, menu_items_used, equiv); menu_items_used++;
405 ASET (menu_items, menu_items_used, def); menu_items_used++;
406 ASET (menu_items, menu_items_used, type); menu_items_used++;
407 ASET (menu_items, menu_items_used, selected); menu_items_used++;
408 ASET (menu_items, menu_items_used, help); menu_items_used++;
411 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
412 and generate menu panes for them in menu_items.
413 If NOTREAL is nonzero,
414 don't bother really computing whether an item is enabled. */
416 static void
417 keymap_panes (keymaps, nmaps, notreal)
418 Lisp_Object *keymaps;
419 int nmaps;
420 int notreal;
422 int mapno;
424 init_menu_items ();
426 /* Loop over the given keymaps, making a pane for each map.
427 But don't make a pane that is empty--ignore that map instead.
428 P is the number of panes we have made so far. */
429 for (mapno = 0; mapno < nmaps; mapno++)
430 single_keymap_panes (keymaps[mapno],
431 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
433 finish_menu_items ();
436 /* This is a recursive subroutine of keymap_panes.
437 It handles one keymap, KEYMAP.
438 The other arguments are passed along
439 or point to local variables of the previous function.
440 If NOTREAL is nonzero, only check for equivalent key bindings, don't
441 evaluate expressions in menu items and don't make any menu.
443 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
445 static void
446 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
447 Lisp_Object keymap;
448 Lisp_Object pane_name;
449 Lisp_Object prefix;
450 int notreal;
451 int maxdepth;
453 Lisp_Object pending_maps = Qnil;
454 Lisp_Object tail, item;
455 struct gcpro gcpro1, gcpro2;
457 if (maxdepth <= 0)
458 return;
460 push_menu_pane (pane_name, prefix);
462 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
464 GCPRO2 (keymap, pending_maps);
465 /* Look at each key binding, and if it is a menu item add it
466 to this menu. */
467 item = XCAR (tail);
468 if (CONSP (item))
469 single_menu_item (XCAR (item), XCDR (item),
470 &pending_maps, notreal, maxdepth);
471 else if (VECTORP (item))
473 /* Loop over the char values represented in the vector. */
474 int len = ASIZE (item);
475 int c;
476 for (c = 0; c < len; c++)
478 Lisp_Object character;
479 XSETFASTINT (character, c);
480 single_menu_item (character, AREF (item, c),
481 &pending_maps, notreal, maxdepth);
484 UNGCPRO;
487 /* Process now any submenus which want to be panes at this level. */
488 while (!NILP (pending_maps))
490 Lisp_Object elt, eltcdr, string;
491 elt = Fcar (pending_maps);
492 eltcdr = XCDR (elt);
493 string = XCAR (eltcdr);
494 /* We no longer discard the @ from the beginning of the string here.
495 Instead, we do this in w32_menu_show. */
496 single_keymap_panes (Fcar (elt), string,
497 XCDR (eltcdr), notreal, maxdepth - 1);
498 pending_maps = Fcdr (pending_maps);
502 /* This is a subroutine of single_keymap_panes that handles one
503 keymap entry.
504 KEY is a key in a keymap and ITEM is its binding.
505 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
506 separate panes.
507 If NOTREAL is nonzero, only check for equivalent key bindings, don't
508 evaluate expressions in menu items and don't make any menu.
509 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
511 static void
512 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
513 Lisp_Object key, item;
514 Lisp_Object *pending_maps_ptr;
515 int maxdepth, notreal;
517 Lisp_Object map, item_string, enabled;
518 struct gcpro gcpro1, gcpro2;
519 int res;
521 /* Parse the menu item and leave the result in item_properties. */
522 GCPRO2 (key, item);
523 res = parse_menu_item (item, notreal, 0);
524 UNGCPRO;
525 if (!res)
526 return; /* Not a menu item. */
528 map = AREF (item_properties, ITEM_PROPERTY_MAP);
530 if (notreal)
532 /* We don't want to make a menu, just traverse the keymaps to
533 precompute equivalent key bindings. */
534 if (!NILP (map))
535 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
536 return;
539 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
540 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
542 if (!NILP (map) && SREF (item_string, 0) == '@')
544 if (!NILP (enabled))
545 /* An enabled separate pane. Remember this to handle it later. */
546 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
547 *pending_maps_ptr);
548 return;
551 push_menu_item (item_string, enabled, key,
552 AREF (item_properties, ITEM_PROPERTY_DEF),
553 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
554 AREF (item_properties, ITEM_PROPERTY_TYPE),
555 AREF (item_properties, ITEM_PROPERTY_SELECTED),
556 AREF (item_properties, ITEM_PROPERTY_HELP));
558 /* Display a submenu using the toolkit. */
559 if (! (NILP (map) || NILP (enabled)))
561 push_submenu_start ();
562 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
563 push_submenu_end ();
567 /* Push all the panes and items of a menu described by the
568 alist-of-alists MENU.
569 This handles old-fashioned calls to x-popup-menu. */
571 static void
572 list_of_panes (menu)
573 Lisp_Object menu;
575 Lisp_Object tail;
577 init_menu_items ();
579 for (tail = menu; CONSP (tail); tail = XCDR (tail))
581 Lisp_Object elt, pane_name, pane_data;
582 elt = XCAR (tail);
583 pane_name = Fcar (elt);
584 CHECK_STRING (pane_name);
585 push_menu_pane (pane_name, Qnil);
586 pane_data = Fcdr (elt);
587 CHECK_CONS (pane_data);
588 list_of_items (pane_data);
591 finish_menu_items ();
594 /* Push the items in a single pane defined by the alist PANE. */
596 static void
597 list_of_items (pane)
598 Lisp_Object pane;
600 Lisp_Object tail, item, item1;
602 for (tail = pane; CONSP (tail); tail = XCDR (tail))
604 item = XCAR (tail);
605 if (STRINGP (item))
606 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
607 else if (NILP (item))
608 push_left_right_boundary ();
609 else
611 CHECK_CONS (item);
612 item1 = Fcar (item);
613 CHECK_STRING (item1);
614 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
619 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
620 doc: /* Pop up a deck-of-cards menu and return user's selection.
621 POSITION is a position specification. This is either a mouse button
622 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
623 are positions in pixels from the top left corner of WINDOW's frame
624 \(WINDOW may be a frame object instead of a window). This controls the
625 position of the center of the first line in the first pane of the
626 menu, not the top left of the menu as a whole. If POSITION is t, it
627 means to use the current mouse position.
629 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
630 The menu items come from key bindings that have a menu string as well as
631 a definition; actually, the \"definition\" in such a key binding looks like
632 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
633 the keymap as a top-level element.
635 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
636 Otherwise, REAL-DEFINITION should be a valid key binding definition.
638 You can also use a list of keymaps as MENU. Then each keymap makes a
639 separate pane. When MENU is a keymap or a list of keymaps, the return
640 value is a list of events.
642 Alternatively, you can specify a menu of multiple panes with a list of
643 the form (TITLE PANE1 PANE2...), where each pane is a list of
644 form (TITLE ITEM1 ITEM2...).
645 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
646 appear as an item--that makes a nonselectable line in the menu.
647 With this form of menu, the return value is VALUE from the chosen item.
649 If POSITION is nil, don't display the menu at all, just precalculate the
650 cached information about equivalent key sequences. */)
651 (position, menu)
652 Lisp_Object position, menu;
654 Lisp_Object keymap, tem;
655 int xpos = 0, ypos = 0;
656 Lisp_Object title;
657 char *error_name;
658 Lisp_Object selection;
659 FRAME_PTR f = NULL;
660 Lisp_Object x, y, window;
661 int keymaps = 0;
662 int for_click = 0;
663 struct gcpro gcpro1;
665 #ifdef HAVE_MENUS
666 if (! NILP (position))
668 check_w32 ();
670 /* Decode the first argument: find the window and the coordinates. */
671 if (EQ (position, Qt)
672 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
673 || EQ (XCAR (position), Qtool_bar))))
675 /* Use the mouse's current position. */
676 FRAME_PTR new_f = SELECTED_FRAME ();
677 Lisp_Object bar_window;
678 enum scroll_bar_part part;
679 unsigned long time;
681 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
682 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
683 &part, &x, &y, &time);
684 if (new_f != 0)
685 XSETFRAME (window, new_f);
686 else
688 window = selected_window;
689 XSETFASTINT (x, 0);
690 XSETFASTINT (y, 0);
693 else
695 tem = Fcar (position);
696 if (CONSP (tem))
698 window = Fcar (Fcdr (position));
699 x = Fcar (tem);
700 y = Fcar (Fcdr (tem));
702 else
704 for_click = 1;
705 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
706 window = Fcar (tem); /* POSN_WINDOW (tem) */
707 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
708 x = Fcar (tem);
709 y = Fcdr (tem);
713 CHECK_NUMBER (x);
714 CHECK_NUMBER (y);
716 /* Decode where to put the menu. */
718 if (FRAMEP (window))
720 f = XFRAME (window);
721 xpos = 0;
722 ypos = 0;
724 else if (WINDOWP (window))
726 CHECK_LIVE_WINDOW (window);
727 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
729 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
730 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
732 else
733 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
734 but I don't want to make one now. */
735 CHECK_WINDOW (window);
737 xpos += XINT (x);
738 ypos += XINT (y);
740 XSETFRAME (Vmenu_updating_frame, f);
742 else
743 Vmenu_updating_frame = Qnil;
744 #endif /* HAVE_MENUS */
746 title = Qnil;
747 GCPRO1 (title);
749 /* Decode the menu items from what was specified. */
751 keymap = get_keymap (menu, 0, 0);
752 if (CONSP (keymap))
754 /* We were given a keymap. Extract menu info from the keymap. */
755 Lisp_Object prompt;
757 /* Extract the detailed info to make one pane. */
758 keymap_panes (&menu, 1, NILP (position));
760 /* Search for a string appearing directly as an element of the keymap.
761 That string is the title of the menu. */
762 prompt = Fkeymap_prompt (keymap);
763 if (NILP (title) && !NILP (prompt))
764 title = prompt;
766 /* Make that be the pane title of the first pane. */
767 if (!NILP (prompt) && menu_items_n_panes >= 0)
768 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
770 keymaps = 1;
772 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
774 /* We were given a list of keymaps. */
775 int nmaps = XFASTINT (Flength (menu));
776 Lisp_Object *maps
777 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
778 int i;
780 title = Qnil;
782 /* The first keymap that has a prompt string
783 supplies the menu title. */
784 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
786 Lisp_Object prompt;
788 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
790 prompt = Fkeymap_prompt (keymap);
791 if (NILP (title) && !NILP (prompt))
792 title = prompt;
795 /* Extract the detailed info to make one pane. */
796 keymap_panes (maps, nmaps, NILP (position));
798 /* Make the title be the pane title of the first pane. */
799 if (!NILP (title) && menu_items_n_panes >= 0)
800 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
802 keymaps = 1;
804 else
806 /* We were given an old-fashioned menu. */
807 title = Fcar (menu);
808 CHECK_STRING (title);
810 list_of_panes (Fcdr (menu));
812 keymaps = 0;
815 if (NILP (position))
817 discard_menu_items ();
818 UNGCPRO;
819 return Qnil;
822 #ifdef HAVE_MENUS
823 /* If resources from a previous popup menu still exist, does nothing
824 until the `menu_free_timer' has freed them (see w32fns.c). This
825 can occur if you press ESC or click outside a menu without selecting
826 a menu item.
828 if (current_popup_menu)
830 discard_menu_items ();
831 UNGCPRO;
832 return Qnil;
835 /* Display them in a menu. */
836 BLOCK_INPUT;
838 selection = w32_menu_show (f, xpos, ypos, for_click,
839 keymaps, title, &error_name);
840 UNBLOCK_INPUT;
842 discard_menu_items ();
844 #endif /* HAVE_MENUS */
846 UNGCPRO;
848 if (error_name) error (error_name);
849 return selection;
852 #ifdef HAVE_MENUS
854 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
855 doc: /* Pop up a dialog box and return user's selection.
856 POSITION specifies which frame to use.
857 This is normally a mouse button event or a window or frame.
858 If POSITION is t, it means to use the frame the mouse is on.
859 The dialog box appears in the middle of the specified frame.
861 CONTENTS specifies the alternatives to display in the dialog box.
862 It is a list of the form (TITLE ITEM1 ITEM2...).
863 Each ITEM is a cons cell (STRING . VALUE).
864 The return value is VALUE from the chosen item.
866 An ITEM may also be just a string--that makes a nonselectable item.
867 An ITEM may also be nil--that means to put all preceding items
868 on the left of the dialog box and all following items on the right.
869 \(By default, approximately half appear on each side.)
871 If HEADER is non-nil, the frame title for the box is "Information",
872 otherwise it is "Question". */)
873 (position, contents, header)
874 Lisp_Object position, contents, header;
876 FRAME_PTR f = NULL;
877 Lisp_Object window;
879 check_w32 ();
881 /* Decode the first argument: find the window or frame to use. */
882 if (EQ (position, Qt)
883 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
884 || EQ (XCAR (position), Qtool_bar))))
886 #if 0 /* Using the frame the mouse is on may not be right. */
887 /* Use the mouse's current position. */
888 FRAME_PTR new_f = SELECTED_FRAME ();
889 Lisp_Object bar_window;
890 enum scroll_bar_part part;
891 unsigned long time;
892 Lisp_Object x, y;
894 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
896 if (new_f != 0)
897 XSETFRAME (window, new_f);
898 else
899 window = selected_window;
900 #endif
901 window = selected_window;
903 else if (CONSP (position))
905 Lisp_Object tem;
906 tem = Fcar (position);
907 if (CONSP (tem))
908 window = Fcar (Fcdr (position));
909 else
911 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
912 window = Fcar (tem); /* POSN_WINDOW (tem) */
915 else if (WINDOWP (position) || FRAMEP (position))
916 window = position;
917 else
918 window = Qnil;
920 /* Decode where to put the menu. */
922 if (FRAMEP (window))
923 f = XFRAME (window);
924 else if (WINDOWP (window))
926 CHECK_LIVE_WINDOW (window);
927 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
929 else
930 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
931 but I don't want to make one now. */
932 CHECK_WINDOW (window);
934 #ifndef HAVE_DIALOGS
937 /* Handle simple Yes/No choices as MessageBox popups. */
938 if (is_simple_dialog (contents))
939 return simple_dialog_show (f, contents, header);
940 else
942 /* Display a menu with these alternatives
943 in the middle of frame F. */
944 Lisp_Object x, y, frame, newpos;
945 XSETFRAME (frame, f);
946 XSETINT (x, x_pixel_width (f) / 2);
947 XSETINT (y, x_pixel_height (f) / 2);
948 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
949 return Fx_popup_menu (newpos,
950 Fcons (Fcar (contents), Fcons (contents, Qnil)));
953 #else /* HAVE_DIALOGS */
955 Lisp_Object title;
956 char *error_name;
957 Lisp_Object selection;
959 /* Decode the dialog items from what was specified. */
960 title = Fcar (contents);
961 CHECK_STRING (title);
963 list_of_panes (Fcons (contents, Qnil));
965 /* Display them in a dialog box. */
966 BLOCK_INPUT;
967 selection = w32_dialog_show (f, 0, title, header, &error_name);
968 UNBLOCK_INPUT;
970 discard_menu_items ();
972 if (error_name) error (error_name);
973 return selection;
975 #endif /* HAVE_DIALOGS */
978 /* Activate the menu bar of frame F.
979 This is called from keyboard.c when it gets the
980 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
982 To activate the menu bar, we signal to the input thread that it can
983 return from the WM_INITMENU message, allowing the normal Windows
984 processing of the menus.
986 But first we recompute the menu bar contents (the whole tree).
988 This way we can safely execute Lisp code. */
990 void
991 x_activate_menubar (f)
992 FRAME_PTR f;
994 set_frame_menubar (f, 0, 1);
996 /* Lock out further menubar changes while active. */
997 f->output_data.w32->menubar_active = 1;
999 /* Signal input thread to return from WM_INITMENU. */
1000 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
1003 /* This callback is called from the menu bar pulldown menu
1004 when the user makes a selection.
1005 Figure out what the user chose
1006 and put the appropriate events into the keyboard buffer. */
1008 void
1009 menubar_selection_callback (FRAME_PTR f, void * client_data)
1011 Lisp_Object prefix, entry;
1012 Lisp_Object vector;
1013 Lisp_Object *subprefix_stack;
1014 int submenu_depth = 0;
1015 int i;
1017 if (!f)
1018 return;
1019 entry = Qnil;
1020 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1021 vector = f->menu_bar_vector;
1022 prefix = Qnil;
1023 i = 0;
1024 while (i < f->menu_bar_items_used)
1026 if (EQ (AREF (vector, i), Qnil))
1028 subprefix_stack[submenu_depth++] = prefix;
1029 prefix = entry;
1030 i++;
1032 else if (EQ (AREF (vector, i), Qlambda))
1034 prefix = subprefix_stack[--submenu_depth];
1035 i++;
1037 else if (EQ (AREF (vector, i), Qt))
1039 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1040 i += MENU_ITEMS_PANE_LENGTH;
1042 else
1044 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1045 /* The EMACS_INT cast avoids a warning. There's no problem
1046 as long as pointers have enough bits to hold small integers. */
1047 if ((int) (EMACS_INT) client_data == i)
1049 int j;
1050 struct input_event buf;
1051 Lisp_Object frame;
1052 EVENT_INIT (buf);
1054 XSETFRAME (frame, f);
1055 buf.kind = MENU_BAR_EVENT;
1056 buf.frame_or_window = frame;
1057 buf.arg = frame;
1058 kbd_buffer_store_event (&buf);
1060 for (j = 0; j < submenu_depth; j++)
1061 if (!NILP (subprefix_stack[j]))
1063 buf.kind = MENU_BAR_EVENT;
1064 buf.frame_or_window = frame;
1065 buf.arg = subprefix_stack[j];
1066 kbd_buffer_store_event (&buf);
1069 if (!NILP (prefix))
1071 buf.kind = MENU_BAR_EVENT;
1072 buf.frame_or_window = frame;
1073 buf.arg = prefix;
1074 kbd_buffer_store_event (&buf);
1077 buf.kind = MENU_BAR_EVENT;
1078 buf.frame_or_window = frame;
1079 buf.arg = entry;
1080 /* Free memory used by owner-drawn and help-echo strings. */
1081 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1082 kbd_buffer_store_event (&buf);
1084 f->output_data.w32->menubar_active = 0;
1085 return;
1087 i += MENU_ITEMS_ITEM_LENGTH;
1090 /* Free memory used by owner-drawn and help-echo strings. */
1091 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1092 f->output_data.w32->menubar_active = 0;
1095 /* Allocate a widget_value, blocking input. */
1097 widget_value *
1098 xmalloc_widget_value ()
1100 widget_value *value;
1102 BLOCK_INPUT;
1103 value = malloc_widget_value ();
1104 UNBLOCK_INPUT;
1106 return value;
1109 /* This recursively calls free_widget_value on the tree of widgets.
1110 It must free all data that was malloc'ed for these widget_values.
1111 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1112 must be left alone. */
1114 void
1115 free_menubar_widget_value_tree (wv)
1116 widget_value *wv;
1118 if (! wv) return;
1120 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1122 if (wv->contents && (wv->contents != (widget_value*)1))
1124 free_menubar_widget_value_tree (wv->contents);
1125 wv->contents = (widget_value *) 0xDEADBEEF;
1127 if (wv->next)
1129 free_menubar_widget_value_tree (wv->next);
1130 wv->next = (widget_value *) 0xDEADBEEF;
1132 BLOCK_INPUT;
1133 free_widget_value (wv);
1134 UNBLOCK_INPUT;
1137 /* Set up data i menu_items for a menu bar item
1138 whose event type is ITEM_KEY (with string ITEM_NAME)
1139 and whose contents come from the list of keymaps MAPS. */
1141 static int
1142 parse_single_submenu (item_key, item_name, maps)
1143 Lisp_Object item_key, item_name, maps;
1145 Lisp_Object length;
1146 int len;
1147 Lisp_Object *mapvec;
1148 int i;
1149 int top_level_items = 0;
1151 length = Flength (maps);
1152 len = XINT (length);
1154 /* Convert the list MAPS into a vector MAPVEC. */
1155 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1156 for (i = 0; i < len; i++)
1158 mapvec[i] = Fcar (maps);
1159 maps = Fcdr (maps);
1162 /* Loop over the given keymaps, making a pane for each map.
1163 But don't make a pane that is empty--ignore that map instead. */
1164 for (i = 0; i < len; i++)
1166 if (SYMBOLP (mapvec[i])
1167 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1169 /* Here we have a command at top level in the menu bar
1170 as opposed to a submenu. */
1171 top_level_items = 1;
1172 push_menu_pane (Qnil, Qnil);
1173 push_menu_item (item_name, Qt, item_key, mapvec[i],
1174 Qnil, Qnil, Qnil, Qnil);
1176 else
1178 Lisp_Object prompt;
1179 prompt = Fkeymap_prompt (mapvec[i]);
1180 single_keymap_panes (mapvec[i],
1181 !NILP (prompt) ? prompt : item_name,
1182 item_key, 0, 10);
1186 return top_level_items;
1190 /* Create a tree of widget_value objects
1191 representing the panes and items
1192 in menu_items starting at index START, up to index END. */
1194 static widget_value *
1195 digest_single_submenu (start, end, top_level_items)
1196 int start, end, top_level_items;
1198 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1199 int i;
1200 int submenu_depth = 0;
1201 widget_value **submenu_stack;
1203 submenu_stack
1204 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1205 wv = xmalloc_widget_value ();
1206 wv->name = "menu";
1207 wv->value = 0;
1208 wv->enabled = 1;
1209 wv->button_type = BUTTON_TYPE_NONE;
1210 wv->help = Qnil;
1211 first_wv = wv;
1212 save_wv = 0;
1213 prev_wv = 0;
1215 /* Loop over all panes and items made by the preceding call
1216 to parse_single_submenu and construct a tree of widget_value objects.
1217 Ignore the panes and items used by previous calls to
1218 digest_single_submenu, even though those are also in menu_items. */
1219 i = start;
1220 while (i < end)
1222 if (EQ (AREF (menu_items, i), Qnil))
1224 submenu_stack[submenu_depth++] = save_wv;
1225 save_wv = prev_wv;
1226 prev_wv = 0;
1227 i++;
1229 else if (EQ (AREF (menu_items, i), Qlambda))
1231 prev_wv = save_wv;
1232 save_wv = submenu_stack[--submenu_depth];
1233 i++;
1235 else if (EQ (AREF (menu_items, i), Qt)
1236 && submenu_depth != 0)
1237 i += MENU_ITEMS_PANE_LENGTH;
1238 /* Ignore a nil in the item list.
1239 It's meaningful only for dialog boxes. */
1240 else if (EQ (AREF (menu_items, i), Qquote))
1241 i += 1;
1242 else if (EQ (AREF (menu_items, i), Qt))
1244 /* Create a new pane. */
1245 Lisp_Object pane_name, prefix;
1246 char *pane_string;
1248 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1249 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1251 if (STRINGP (pane_name))
1253 if (unicode_append_menu)
1254 /* Encode as UTF-8 for now. */
1255 pane_name = ENCODE_UTF_8 (pane_name);
1256 else if (STRING_MULTIBYTE (pane_name))
1257 pane_name = ENCODE_SYSTEM (pane_name);
1259 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1262 pane_string = (NILP (pane_name)
1263 ? "" : (char *) SDATA (pane_name));
1264 /* If there is just one top-level pane, put all its items directly
1265 under the top-level menu. */
1266 if (menu_items_n_panes == 1)
1267 pane_string = "";
1269 /* If the pane has a meaningful name,
1270 make the pane a top-level menu item
1271 with its items as a submenu beneath it. */
1272 if (strcmp (pane_string, ""))
1274 wv = xmalloc_widget_value ();
1275 if (save_wv)
1276 save_wv->next = wv;
1277 else
1278 first_wv->contents = wv;
1279 wv->lname = pane_name;
1280 /* Set value to 1 so update_submenu_strings can handle '@' */
1281 wv->value = (char *) 1;
1282 wv->enabled = 1;
1283 wv->button_type = BUTTON_TYPE_NONE;
1284 wv->help = Qnil;
1286 save_wv = wv;
1287 prev_wv = 0;
1288 i += MENU_ITEMS_PANE_LENGTH;
1290 else
1292 /* Create a new item within current pane. */
1293 Lisp_Object item_name, enable, descrip, def, type, selected;
1294 Lisp_Object help;
1296 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1297 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1298 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1299 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1300 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1301 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1302 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1304 if (STRINGP (item_name))
1306 if (unicode_append_menu)
1307 item_name = ENCODE_UTF_8 (item_name);
1308 else if (STRING_MULTIBYTE (item_name))
1309 item_name = ENCODE_SYSTEM (item_name);
1311 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1314 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1316 descrip = ENCODE_SYSTEM (descrip);
1317 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1320 wv = xmalloc_widget_value ();
1321 if (prev_wv)
1322 prev_wv->next = wv;
1323 else
1324 save_wv->contents = wv;
1326 wv->lname = item_name;
1327 if (!NILP (descrip))
1328 wv->lkey = descrip;
1329 wv->value = 0;
1330 /* The EMACS_INT cast avoids a warning. There's no problem
1331 as long as pointers have enough bits to hold small integers. */
1332 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1333 wv->enabled = !NILP (enable);
1335 if (NILP (type))
1336 wv->button_type = BUTTON_TYPE_NONE;
1337 else if (EQ (type, QCradio))
1338 wv->button_type = BUTTON_TYPE_RADIO;
1339 else if (EQ (type, QCtoggle))
1340 wv->button_type = BUTTON_TYPE_TOGGLE;
1341 else
1342 abort ();
1344 wv->selected = !NILP (selected);
1345 if (!STRINGP (help))
1346 help = Qnil;
1348 wv->help = help;
1350 prev_wv = wv;
1352 i += MENU_ITEMS_ITEM_LENGTH;
1356 /* If we have just one "menu item"
1357 that was originally a button, return it by itself. */
1358 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1360 wv = first_wv->contents;
1361 free_widget_value (first_wv);
1362 return wv;
1365 return first_wv;
1369 /* Walk through the widget_value tree starting at FIRST_WV and update
1370 the char * pointers from the corresponding lisp values.
1371 We do this after building the whole tree, since GC may happen while the
1372 tree is constructed, and small strings are relocated. So we must wait
1373 until no GC can happen before storing pointers into lisp values. */
1374 static void
1375 update_submenu_strings (first_wv)
1376 widget_value *first_wv;
1378 widget_value *wv;
1380 for (wv = first_wv; wv; wv = wv->next)
1382 if (wv->lname && ! NILP (wv->lname))
1384 wv->name = SDATA (wv->lname);
1386 /* Ignore the @ that means "separate pane".
1387 This is a kludge, but this isn't worth more time. */
1388 if (wv->value == (char *)1)
1390 if (wv->name[0] == '@')
1391 wv->name++;
1392 wv->value = 0;
1396 if (wv->lkey && ! NILP (wv->lkey))
1397 wv->key = SDATA (wv->lkey);
1399 if (wv->contents)
1400 update_submenu_strings (wv->contents);
1405 /* Set the contents of the menubar widgets of frame F.
1406 The argument FIRST_TIME is currently ignored;
1407 it is set the first time this is called, from initialize_frame_menubar. */
1409 void
1410 set_frame_menubar (f, first_time, deep_p)
1411 FRAME_PTR f;
1412 int first_time;
1413 int deep_p;
1415 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1416 Lisp_Object items;
1417 widget_value *wv, *first_wv, *prev_wv = 0;
1418 int i, last_i;
1419 int *submenu_start, *submenu_end;
1420 int *submenu_top_level_items, *submenu_n_panes;
1422 /* We must not change the menubar when actually in use. */
1423 if (f->output_data.w32->menubar_active)
1424 return;
1426 XSETFRAME (Vmenu_updating_frame, f);
1428 if (! menubar_widget)
1429 deep_p = 1;
1430 else if (pending_menu_activation && !deep_p)
1431 deep_p = 1;
1433 if (deep_p)
1435 /* Make a widget-value tree representing the entire menu trees. */
1437 struct buffer *prev = current_buffer;
1438 Lisp_Object buffer;
1439 int specpdl_count = SPECPDL_INDEX ();
1440 int previous_menu_items_used = f->menu_bar_items_used;
1441 Lisp_Object *previous_items
1442 = (Lisp_Object *) alloca (previous_menu_items_used
1443 * sizeof (Lisp_Object));
1445 /* If we are making a new widget, its contents are empty,
1446 do always reinitialize them. */
1447 if (! menubar_widget)
1448 previous_menu_items_used = 0;
1450 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1451 specbind (Qinhibit_quit, Qt);
1452 /* Don't let the debugger step into this code
1453 because it is not reentrant. */
1454 specbind (Qdebug_on_next_call, Qnil);
1456 record_unwind_save_match_data ();
1458 if (NILP (Voverriding_local_map_menu_flag))
1460 specbind (Qoverriding_terminal_local_map, Qnil);
1461 specbind (Qoverriding_local_map, Qnil);
1464 set_buffer_internal_1 (XBUFFER (buffer));
1466 /* Run the Lucid hook. */
1467 safe_run_hooks (Qactivate_menubar_hook);
1468 /* If it has changed current-menubar from previous value,
1469 really recompute the menubar from the value. */
1470 if (! NILP (Vlucid_menu_bar_dirty_flag))
1471 call0 (Qrecompute_lucid_menubar);
1472 safe_run_hooks (Qmenu_bar_update_hook);
1473 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1475 items = FRAME_MENU_BAR_ITEMS (f);
1477 /* Save the frame's previous menu bar contents data. */
1478 if (previous_menu_items_used)
1479 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1480 previous_menu_items_used * sizeof (Lisp_Object));
1482 /* Fill in menu_items with the current menu bar contents.
1483 This can evaluate Lisp code. */
1484 menu_items = f->menu_bar_vector;
1485 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1486 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1487 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1488 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1489 submenu_top_level_items
1490 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1491 init_menu_items ();
1492 for (i = 0; i < ASIZE (items); i += 4)
1494 Lisp_Object key, string, maps;
1496 last_i = i;
1498 key = AREF (items, i);
1499 string = AREF (items, i + 1);
1500 maps = AREF (items, i + 2);
1501 if (NILP (string))
1502 break;
1504 submenu_start[i] = menu_items_used;
1506 menu_items_n_panes = 0;
1507 submenu_top_level_items[i]
1508 = parse_single_submenu (key, string, maps);
1509 submenu_n_panes[i] = menu_items_n_panes;
1511 submenu_end[i] = menu_items_used;
1514 finish_menu_items ();
1516 /* Convert menu_items into widget_value trees
1517 to display the menu. This cannot evaluate Lisp code. */
1519 wv = xmalloc_widget_value ();
1520 wv->name = "menubar";
1521 wv->value = 0;
1522 wv->enabled = 1;
1523 wv->button_type = BUTTON_TYPE_NONE;
1524 wv->help = Qnil;
1525 first_wv = wv;
1527 for (i = 0; i < last_i; i += 4)
1529 menu_items_n_panes = submenu_n_panes[i];
1530 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1531 submenu_top_level_items[i]);
1532 if (prev_wv)
1533 prev_wv->next = wv;
1534 else
1535 first_wv->contents = wv;
1536 /* Don't set wv->name here; GC during the loop might relocate it. */
1537 wv->enabled = 1;
1538 wv->button_type = BUTTON_TYPE_NONE;
1539 prev_wv = wv;
1542 set_buffer_internal_1 (prev);
1543 unbind_to (specpdl_count, Qnil);
1545 /* If there has been no change in the Lisp-level contents
1546 of the menu bar, skip redisplaying it. Just exit. */
1548 for (i = 0; i < previous_menu_items_used; i++)
1549 if (menu_items_used == i
1550 || (!EQ (previous_items[i], AREF (menu_items, i))))
1551 break;
1552 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1554 free_menubar_widget_value_tree (first_wv);
1555 menu_items = Qnil;
1557 return;
1560 /* Now GC cannot happen during the lifetime of the widget_value,
1561 so it's safe to store data from a Lisp_String, as long as
1562 local copies are made when the actual menu is created.
1563 Windows takes care of this for normal string items, but
1564 not for owner-drawn items or additional item-info. */
1565 wv = first_wv->contents;
1566 for (i = 0; i < ASIZE (items); i += 4)
1568 Lisp_Object string;
1569 string = AREF (items, i + 1);
1570 if (NILP (string))
1571 break;
1572 wv->name = (char *) SDATA (string);
1573 update_submenu_strings (wv->contents);
1574 wv = wv->next;
1577 f->menu_bar_vector = menu_items;
1578 f->menu_bar_items_used = menu_items_used;
1579 menu_items = Qnil;
1581 else
1583 /* Make a widget-value tree containing
1584 just the top level menu bar strings. */
1586 wv = xmalloc_widget_value ();
1587 wv->name = "menubar";
1588 wv->value = 0;
1589 wv->enabled = 1;
1590 wv->button_type = BUTTON_TYPE_NONE;
1591 wv->help = Qnil;
1592 first_wv = wv;
1594 items = FRAME_MENU_BAR_ITEMS (f);
1595 for (i = 0; i < ASIZE (items); i += 4)
1597 Lisp_Object string;
1599 string = AREF (items, i + 1);
1600 if (NILP (string))
1601 break;
1603 wv = xmalloc_widget_value ();
1604 wv->name = (char *) SDATA (string);
1605 wv->value = 0;
1606 wv->enabled = 1;
1607 wv->button_type = BUTTON_TYPE_NONE;
1608 wv->help = Qnil;
1609 /* This prevents lwlib from assuming this
1610 menu item is really supposed to be empty. */
1611 /* The EMACS_INT cast avoids a warning.
1612 This value just has to be different from small integers. */
1613 wv->call_data = (void *) (EMACS_INT) (-1);
1615 if (prev_wv)
1616 prev_wv->next = wv;
1617 else
1618 first_wv->contents = wv;
1619 prev_wv = wv;
1622 /* Forget what we thought we knew about what is in the
1623 detailed contents of the menu bar menus.
1624 Changing the top level always destroys the contents. */
1625 f->menu_bar_items_used = 0;
1628 /* Create or update the menu bar widget. */
1630 BLOCK_INPUT;
1632 if (menubar_widget)
1634 /* Empty current menubar, rather than creating a fresh one. */
1635 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1638 else
1640 menubar_widget = CreateMenu ();
1642 fill_in_menu (menubar_widget, first_wv->contents);
1644 free_menubar_widget_value_tree (first_wv);
1647 HMENU old_widget = f->output_data.w32->menubar_widget;
1649 f->output_data.w32->menubar_widget = menubar_widget;
1650 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1651 /* Causes flicker when menu bar is updated
1652 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1654 /* Force the window size to be recomputed so that the frame's text
1655 area remains the same, if menubar has just been created. */
1656 if (old_widget == NULL)
1657 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1660 UNBLOCK_INPUT;
1663 /* Called from Fx_create_frame to create the initial menubar of a frame
1664 before it is mapped, so that the window is mapped with the menubar already
1665 there instead of us tacking it on later and thrashing the window after it
1666 is visible. */
1668 void
1669 initialize_frame_menubar (f)
1670 FRAME_PTR f;
1672 /* This function is called before the first chance to redisplay
1673 the frame. It has to be, so the frame will have the right size. */
1674 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1675 set_frame_menubar (f, 1, 1);
1678 /* Get rid of the menu bar of frame F, and free its storage.
1679 This is used when deleting a frame, and when turning off the menu bar. */
1681 void
1682 free_frame_menubar (f)
1683 FRAME_PTR f;
1685 BLOCK_INPUT;
1688 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1689 SetMenu (FRAME_W32_WINDOW (f), NULL);
1690 f->output_data.w32->menubar_widget = NULL;
1691 DestroyMenu (old);
1694 UNBLOCK_INPUT;
1698 /* w32_menu_show actually displays a menu using the panes and items in
1699 menu_items and returns the value selected from it; we assume input
1700 is blocked by the caller. */
1702 /* F is the frame the menu is for.
1703 X and Y are the frame-relative specified position,
1704 relative to the inside upper left corner of the frame F.
1705 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1706 KEYMAPS is 1 if this menu was specified with keymaps;
1707 in that case, we return a list containing the chosen item's value
1708 and perhaps also the pane's prefix.
1709 TITLE is the specified menu title.
1710 ERROR is a place to store an error message string in case of failure.
1711 (We return nil on failure, but the value doesn't actually matter.) */
1713 static Lisp_Object
1714 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1715 FRAME_PTR f;
1716 int x;
1717 int y;
1718 int for_click;
1719 int keymaps;
1720 Lisp_Object title;
1721 char **error;
1723 int i;
1724 int menu_item_selection;
1725 HMENU menu;
1726 POINT pos;
1727 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1728 widget_value **submenu_stack
1729 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1730 Lisp_Object *subprefix_stack
1731 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1732 int submenu_depth = 0;
1733 int first_pane;
1735 *error = NULL;
1737 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1739 *error = "Empty menu";
1740 return Qnil;
1743 /* Create a tree of widget_value objects
1744 representing the panes and their items. */
1745 wv = xmalloc_widget_value ();
1746 wv->name = "menu";
1747 wv->value = 0;
1748 wv->enabled = 1;
1749 wv->button_type = BUTTON_TYPE_NONE;
1750 wv->help = Qnil;
1751 first_wv = wv;
1752 first_pane = 1;
1754 /* Loop over all panes and items, filling in the tree. */
1755 i = 0;
1756 while (i < menu_items_used)
1758 if (EQ (AREF (menu_items, i), Qnil))
1760 submenu_stack[submenu_depth++] = save_wv;
1761 save_wv = prev_wv;
1762 prev_wv = 0;
1763 first_pane = 1;
1764 i++;
1766 else if (EQ (AREF (menu_items, i), Qlambda))
1768 prev_wv = save_wv;
1769 save_wv = submenu_stack[--submenu_depth];
1770 first_pane = 0;
1771 i++;
1773 else if (EQ (AREF (menu_items, i), Qt)
1774 && submenu_depth != 0)
1775 i += MENU_ITEMS_PANE_LENGTH;
1776 /* Ignore a nil in the item list.
1777 It's meaningful only for dialog boxes. */
1778 else if (EQ (AREF (menu_items, i), Qquote))
1779 i += 1;
1780 else if (EQ (AREF (menu_items, i), Qt))
1782 /* Create a new pane. */
1783 Lisp_Object pane_name, prefix;
1784 char *pane_string;
1785 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1786 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1788 if (STRINGP (pane_name))
1790 if (unicode_append_menu)
1791 pane_name = ENCODE_UTF_8 (pane_name);
1792 else if (STRING_MULTIBYTE (pane_name))
1793 pane_name = ENCODE_SYSTEM (pane_name);
1795 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1798 pane_string = (NILP (pane_name)
1799 ? "" : (char *) SDATA (pane_name));
1800 /* If there is just one top-level pane, put all its items directly
1801 under the top-level menu. */
1802 if (menu_items_n_panes == 1)
1803 pane_string = "";
1805 /* If the pane has a meaningful name,
1806 make the pane a top-level menu item
1807 with its items as a submenu beneath it. */
1808 if (!keymaps && strcmp (pane_string, ""))
1810 wv = xmalloc_widget_value ();
1811 if (save_wv)
1812 save_wv->next = wv;
1813 else
1814 first_wv->contents = wv;
1815 wv->name = pane_string;
1816 if (keymaps && !NILP (prefix))
1817 wv->name++;
1818 wv->value = 0;
1819 wv->enabled = 1;
1820 wv->button_type = BUTTON_TYPE_NONE;
1821 wv->help = Qnil;
1822 save_wv = wv;
1823 prev_wv = 0;
1825 else if (first_pane)
1827 save_wv = wv;
1828 prev_wv = 0;
1830 first_pane = 0;
1831 i += MENU_ITEMS_PANE_LENGTH;
1833 else
1835 /* Create a new item within current pane. */
1836 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1838 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1839 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1840 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1841 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1842 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1843 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1844 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1846 if (STRINGP (item_name))
1848 if (unicode_append_menu)
1849 item_name = ENCODE_UTF_8 (item_name);
1850 else if (STRING_MULTIBYTE (item_name))
1851 item_name = ENCODE_SYSTEM (item_name);
1853 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1856 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1858 descrip = ENCODE_SYSTEM (descrip);
1859 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1862 wv = xmalloc_widget_value ();
1863 if (prev_wv)
1864 prev_wv->next = wv;
1865 else
1866 save_wv->contents = wv;
1867 wv->name = (char *) SDATA (item_name);
1868 if (!NILP (descrip))
1869 wv->key = (char *) SDATA (descrip);
1870 wv->value = 0;
1871 /* Use the contents index as call_data, since we are
1872 restricted to 16-bits. */
1873 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1874 wv->enabled = !NILP (enable);
1876 if (NILP (type))
1877 wv->button_type = BUTTON_TYPE_NONE;
1878 else if (EQ (type, QCtoggle))
1879 wv->button_type = BUTTON_TYPE_TOGGLE;
1880 else if (EQ (type, QCradio))
1881 wv->button_type = BUTTON_TYPE_RADIO;
1882 else
1883 abort ();
1885 wv->selected = !NILP (selected);
1886 if (!STRINGP (help))
1887 help = Qnil;
1889 wv->help = help;
1891 prev_wv = wv;
1893 i += MENU_ITEMS_ITEM_LENGTH;
1897 /* Deal with the title, if it is non-nil. */
1898 if (!NILP (title))
1900 widget_value *wv_title = xmalloc_widget_value ();
1901 widget_value *wv_sep = xmalloc_widget_value ();
1903 /* Maybe replace this separator with a bitmap or owner-draw item
1904 so that it looks better. Having two separators looks odd. */
1905 wv_sep->name = "--";
1906 wv_sep->next = first_wv->contents;
1907 wv_sep->help = Qnil;
1909 if (unicode_append_menu)
1910 title = ENCODE_UTF_8 (title);
1911 else if (STRING_MULTIBYTE (title))
1912 title = ENCODE_SYSTEM (title);
1914 wv_title->name = (char *) SDATA (title);
1915 wv_title->enabled = TRUE;
1916 wv_title->title = TRUE;
1917 wv_title->button_type = BUTTON_TYPE_NONE;
1918 wv_title->help = Qnil;
1919 wv_title->next = wv_sep;
1920 first_wv->contents = wv_title;
1923 /* Actually create the menu. */
1924 current_popup_menu = menu = CreatePopupMenu ();
1925 fill_in_menu (menu, first_wv->contents);
1927 /* Adjust coordinates to be root-window-relative. */
1928 pos.x = x;
1929 pos.y = y;
1930 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1932 /* No selection has been chosen yet. */
1933 menu_item_selection = 0;
1935 /* Display the menu. */
1936 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1937 WM_EMACS_TRACKPOPUPMENU,
1938 (WPARAM)menu, (LPARAM)&pos);
1940 /* Clean up extraneous mouse events which might have been generated
1941 during the call. */
1942 discard_mouse_events ();
1944 /* Free the widget_value objects we used to specify the contents. */
1945 free_menubar_widget_value_tree (first_wv);
1947 DestroyMenu (menu);
1949 /* Free the owner-drawn and help-echo menu strings. */
1950 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1951 f->output_data.w32->menubar_active = 0;
1953 /* Find the selected item, and its pane, to return
1954 the proper value. */
1955 if (menu_item_selection != 0)
1957 Lisp_Object prefix, entry;
1959 prefix = entry = Qnil;
1960 i = 0;
1961 while (i < menu_items_used)
1963 if (EQ (AREF (menu_items, i), Qnil))
1965 subprefix_stack[submenu_depth++] = prefix;
1966 prefix = entry;
1967 i++;
1969 else if (EQ (AREF (menu_items, i), Qlambda))
1971 prefix = subprefix_stack[--submenu_depth];
1972 i++;
1974 else if (EQ (AREF (menu_items, i), Qt))
1976 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1977 i += MENU_ITEMS_PANE_LENGTH;
1979 /* Ignore a nil in the item list.
1980 It's meaningful only for dialog boxes. */
1981 else if (EQ (AREF (menu_items, i), Qquote))
1982 i += 1;
1983 else
1985 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1986 if (menu_item_selection == i)
1988 if (keymaps != 0)
1990 int j;
1992 entry = Fcons (entry, Qnil);
1993 if (!NILP (prefix))
1994 entry = Fcons (prefix, entry);
1995 for (j = submenu_depth - 1; j >= 0; j--)
1996 if (!NILP (subprefix_stack[j]))
1997 entry = Fcons (subprefix_stack[j], entry);
1999 return entry;
2001 i += MENU_ITEMS_ITEM_LENGTH;
2005 else if (!for_click)
2006 /* Make "Cancel" equivalent to C-g. */
2007 Fsignal (Qquit, Qnil);
2009 return Qnil;
2013 #ifdef HAVE_DIALOGS
2014 /* TODO: On Windows, there are two ways of defining a dialog.
2016 1. Create a predefined dialog resource and include it in nt/emacs.rc.
2017 Using this method, we could then set the titles and make unneeded
2018 buttons invisible before displaying the dialog. Everything would
2019 be a fixed size though, so there is a risk that text does not
2020 fit on a button.
2021 2. Create the dialog template in memory on the fly. This allows us
2022 to size the dialog and buttons dynamically, probably giving more
2023 natural looking results for dialogs with few buttons, and eliminating
2024 the problem of text overflowing the buttons. But the API for this is
2025 quite complex - structures have to be allocated in particular ways,
2026 text content is tacked onto the end of structures in variable length
2027 arrays with further structures tacked on after these, there are
2028 certain alignment requirements for all this, and we have to
2029 measure all the text and convert to "dialog coordinates" to figure
2030 out how big to make everything.
2032 For now, we'll just stick with menus for dialogs that are more
2033 complicated than simple yes/no type questions for which we can use
2034 the MessageBox function.
2037 static char * button_names [] = {
2038 "button1", "button2", "button3", "button4", "button5",
2039 "button6", "button7", "button8", "button9", "button10" };
2041 static Lisp_Object
2042 w32_dialog_show (f, keymaps, title, header, error)
2043 FRAME_PTR f;
2044 int keymaps;
2045 Lisp_Object title, header;
2046 char **error;
2048 int i, nb_buttons=0;
2049 char dialog_name[6];
2050 int menu_item_selection;
2052 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2054 /* Number of elements seen so far, before boundary. */
2055 int left_count = 0;
2056 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2057 int boundary_seen = 0;
2059 *error = NULL;
2061 if (menu_items_n_panes > 1)
2063 *error = "Multiple panes in dialog box";
2064 return Qnil;
2067 /* Create a tree of widget_value objects
2068 representing the text label and buttons. */
2070 Lisp_Object pane_name, prefix;
2071 char *pane_string;
2072 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2073 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2074 pane_string = (NILP (pane_name)
2075 ? "" : (char *) SDATA (pane_name));
2076 prev_wv = xmalloc_widget_value ();
2077 prev_wv->value = pane_string;
2078 if (keymaps && !NILP (prefix))
2079 prev_wv->name++;
2080 prev_wv->enabled = 1;
2081 prev_wv->name = "message";
2082 prev_wv->help = Qnil;
2083 first_wv = prev_wv;
2085 /* Loop over all panes and items, filling in the tree. */
2086 i = MENU_ITEMS_PANE_LENGTH;
2087 while (i < menu_items_used)
2090 /* Create a new item within current pane. */
2091 Lisp_Object item_name, enable, descrip, help;
2093 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2094 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2095 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2096 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2098 if (NILP (item_name))
2100 free_menubar_widget_value_tree (first_wv);
2101 *error = "Submenu in dialog items";
2102 return Qnil;
2104 if (EQ (item_name, Qquote))
2106 /* This is the boundary between left-side elts
2107 and right-side elts. Stop incrementing right_count. */
2108 boundary_seen = 1;
2109 i++;
2110 continue;
2112 if (nb_buttons >= 9)
2114 free_menubar_widget_value_tree (first_wv);
2115 *error = "Too many dialog items";
2116 return Qnil;
2119 wv = xmalloc_widget_value ();
2120 prev_wv->next = wv;
2121 wv->name = (char *) button_names[nb_buttons];
2122 if (!NILP (descrip))
2123 wv->key = (char *) SDATA (descrip);
2124 wv->value = (char *) SDATA (item_name);
2125 wv->call_data = (void *) &AREF (menu_items, i);
2126 wv->enabled = !NILP (enable);
2127 wv->help = Qnil;
2128 prev_wv = wv;
2130 if (! boundary_seen)
2131 left_count++;
2133 nb_buttons++;
2134 i += MENU_ITEMS_ITEM_LENGTH;
2137 /* If the boundary was not specified,
2138 by default put half on the left and half on the right. */
2139 if (! boundary_seen)
2140 left_count = nb_buttons - nb_buttons / 2;
2142 wv = xmalloc_widget_value ();
2143 wv->name = dialog_name;
2144 wv->help = Qnil;
2146 /* Frame title: 'Q' = Question, 'I' = Information.
2147 Can also have 'E' = Error if, one day, we want
2148 a popup for errors. */
2149 if (NILP(header))
2150 dialog_name[0] = 'Q';
2151 else
2152 dialog_name[0] = 'I';
2154 /* Dialog boxes use a really stupid name encoding
2155 which specifies how many buttons to use
2156 and how many buttons are on the right. */
2157 dialog_name[1] = '0' + nb_buttons;
2158 dialog_name[2] = 'B';
2159 dialog_name[3] = 'R';
2160 /* Number of buttons to put on the right. */
2161 dialog_name[4] = '0' + nb_buttons - left_count;
2162 dialog_name[5] = 0;
2163 wv->contents = first_wv;
2164 first_wv = wv;
2167 /* Actually create the dialog. */
2168 dialog_id = widget_id_tick++;
2169 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2170 f->output_data.w32->widget, 1, 0,
2171 dialog_selection_callback, 0);
2172 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2174 /* Free the widget_value objects we used to specify the contents. */
2175 free_menubar_widget_value_tree (first_wv);
2177 /* No selection has been chosen yet. */
2178 menu_item_selection = 0;
2180 /* Display the menu. */
2181 lw_pop_up_all_widgets (dialog_id);
2183 /* Process events that apply to the menu. */
2184 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2186 lw_destroy_all_widgets (dialog_id);
2188 /* Find the selected item, and its pane, to return
2189 the proper value. */
2190 if (menu_item_selection != 0)
2192 Lisp_Object prefix;
2194 prefix = Qnil;
2195 i = 0;
2196 while (i < menu_items_used)
2198 Lisp_Object entry;
2200 if (EQ (AREF (menu_items, i), Qt))
2202 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2203 i += MENU_ITEMS_PANE_LENGTH;
2205 else
2207 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2208 if (menu_item_selection == i)
2210 if (keymaps != 0)
2212 entry = Fcons (entry, Qnil);
2213 if (!NILP (prefix))
2214 entry = Fcons (prefix, entry);
2216 return entry;
2218 i += MENU_ITEMS_ITEM_LENGTH;
2222 else
2223 /* Make "Cancel" equivalent to C-g. */
2224 Fsignal (Qquit, Qnil);
2226 return Qnil;
2228 #else /* !HAVE_DIALOGS */
2230 /* Currently we only handle Yes No dialogs (y-or-n-p and yes-or-no-p) as
2231 simple dialogs. We could handle a few more, but I'm not aware of
2232 anywhere in Emacs that uses the other specific dialog choices that
2233 MessageBox provides. */
2235 static int is_simple_dialog (contents)
2236 Lisp_Object contents;
2238 Lisp_Object options = XCDR (contents);
2239 Lisp_Object name, yes, no, other;
2241 yes = build_string ("Yes");
2242 no = build_string ("No");
2244 if (!CONSP (options))
2245 return 0;
2247 name = XCAR (XCAR (options));
2248 if (!CONSP (options))
2249 return 0;
2251 if (!NILP (Fstring_equal (name, yes)))
2252 other = no;
2253 else if (!NILP (Fstring_equal (name, no)))
2254 other = yes;
2255 else
2256 return 0;
2258 options = XCDR (options);
2259 if (!CONSP (options))
2260 return 0;
2262 name = XCAR (XCAR (options));
2263 if (NILP (Fstring_equal (name, other)))
2264 return 0;
2266 /* Check there are no more options. */
2267 options = XCDR (options);
2268 return !(CONSP (options));
2271 static Lisp_Object simple_dialog_show (f, contents, header)
2272 FRAME_PTR f;
2273 Lisp_Object contents, header;
2275 int answer;
2276 UINT type;
2277 char *text, *title;
2278 Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
2280 if (STRINGP (temp))
2281 text = SDATA (temp);
2282 else
2283 text = "";
2285 if (NILP (header))
2287 title = "Question";
2288 type = MB_ICONQUESTION;
2290 else
2292 title = "Information";
2293 type = MB_ICONINFORMATION;
2295 type |= MB_YESNO;
2297 /* Since we only handle Yes/No dialogs, and we already checked
2298 is_simple_dialog, we don't need to worry about checking contents
2299 to see what type of dialog to use. */
2300 answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type);
2302 if (answer == IDYES)
2303 lispy_answer = build_string ("Yes");
2304 else if (answer == IDNO)
2305 lispy_answer = build_string ("No");
2306 else
2307 Fsignal (Qquit, Qnil);
2309 for (temp = XCDR (contents); CONSP (temp); temp = XCDR (temp))
2311 Lisp_Object item, name, value;
2312 item = XCAR (temp);
2313 if (CONSP (item))
2315 name = XCAR (item);
2316 value = XCDR (item);
2318 else
2320 name = item;
2321 value = Qnil;
2324 if (!NILP (Fstring_equal (name, lispy_answer)))
2326 return value;
2329 Fsignal (Qquit, Qnil);
2330 return Qnil;
2332 #endif /* !HAVE_DIALOGS */
2335 /* Is this item a separator? */
2336 static int
2337 name_is_separator (name)
2338 char *name;
2340 char *start = name;
2342 /* Check if name string consists of only dashes ('-'). */
2343 while (*name == '-') name++;
2344 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2345 or "--deep-shadow". We don't implement them yet, se we just treat
2346 them like normal separators. */
2347 return (*name == '\0' || start + 2 == name);
2351 /* Indicate boundary between left and right. */
2352 static int
2353 add_left_right_boundary (HMENU menu)
2355 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2358 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2359 static void
2360 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2362 while (len > 0)
2364 int utf16;
2365 if (*src < 0x80)
2367 *dest = (WCHAR) *src;
2368 dest++; src++; len--;
2370 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2371 else if (*src < 0xC0)
2373 src++; len--;
2375 /* 2 char UTF-8 sequence. */
2376 else if (*src < 0xE0)
2378 *dest = (WCHAR) (((*src & 0x1f) << 6)
2379 | (*(src + 1) & 0x3f));
2380 src += 2; len -= 2; dest++;
2382 else if (*src < 0xF0)
2384 *dest = (WCHAR) (((*src & 0x0f) << 12)
2385 | ((*(src + 1) & 0x3f) << 6)
2386 | (*(src + 2) & 0x3f));
2387 src += 3; len -= 3; dest++;
2389 else /* Not encodable. Insert Unicode Substitution char. */
2391 *dest = (WCHAR) 0xfffd;
2392 src++; len--; dest++;
2395 *dest = 0;
2398 static int
2399 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2401 UINT fuFlags;
2402 char *out_string, *p, *q;
2403 int return_value;
2404 size_t nlen, orig_len;
2406 if (name_is_separator (wv->name))
2408 fuFlags = MF_SEPARATOR;
2409 out_string = NULL;
2411 else
2413 if (wv->enabled)
2414 fuFlags = MF_STRING;
2415 else
2416 fuFlags = MF_STRING | MF_GRAYED;
2418 if (wv->key != NULL)
2420 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2421 strcpy (out_string, wv->name);
2422 strcat (out_string, "\t");
2423 strcat (out_string, wv->key);
2425 else
2426 out_string = wv->name;
2428 /* Quote any special characters within the menu item's text and
2429 key binding. */
2430 nlen = orig_len = strlen (out_string);
2431 if (unicode_append_menu)
2433 /* With UTF-8, & cannot be part of a multibyte character. */
2434 for (p = out_string; *p; p++)
2436 if (*p == '&')
2437 nlen++;
2440 else
2442 /* If encoded with the system codepage, use multibyte string
2443 functions in case of multibyte characters that contain '&'. */
2444 for (p = out_string; *p; p = _mbsinc (p))
2446 if (_mbsnextc (p) == '&')
2447 nlen++;
2451 if (nlen > orig_len)
2453 p = out_string;
2454 out_string = alloca (nlen + 1);
2455 q = out_string;
2456 while (*p)
2458 if (unicode_append_menu)
2460 if (*p == '&')
2461 *q++ = *p;
2462 *q++ = *p++;
2464 else
2466 if (_mbsnextc (p) == '&')
2468 _mbsncpy (q, p, 1);
2469 q = _mbsinc (q);
2471 _mbsncpy (q, p, 1);
2472 p = _mbsinc (p);
2473 q = _mbsinc (q);
2476 *q = '\0';
2479 if (item != NULL)
2480 fuFlags = MF_POPUP;
2481 else if (wv->title || wv->call_data == 0)
2483 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2484 we can't deallocate the memory otherwise. */
2485 if (get_menu_item_info)
2487 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2488 strcpy (out_string, wv->name);
2489 #ifdef MENU_DEBUG
2490 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2491 #endif
2492 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2494 else
2495 fuFlags = MF_DISABLED;
2498 /* Draw radio buttons and tickboxes. */
2499 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2500 wv->button_type == BUTTON_TYPE_RADIO))
2501 fuFlags |= MF_CHECKED;
2502 else
2503 fuFlags |= MF_UNCHECKED;
2506 if (unicode_append_menu && out_string)
2508 /* Convert out_string from UTF-8 to UTF-16-LE. */
2509 int utf8_len = strlen (out_string);
2510 WCHAR * utf16_string;
2511 if (fuFlags & MF_OWNERDRAW)
2512 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2513 else
2514 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2516 utf8to16 (out_string, utf8_len, utf16_string);
2517 return_value = unicode_append_menu (menu, fuFlags,
2518 item != NULL ? (UINT) item
2519 : (UINT) wv->call_data,
2520 utf16_string);
2521 if (!return_value)
2523 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2524 apparently does exist at least in some cases and appears to be
2525 stubbed out to do nothing. out_string is UTF-8, but since
2526 our standard menus are in English and this is only going to
2527 happen the first time a menu is used, the encoding is
2528 of minor importance compared with menus not working at all. */
2529 return_value =
2530 AppendMenu (menu, fuFlags,
2531 item != NULL ? (UINT) item: (UINT) wv->call_data,
2532 out_string);
2533 /* Don't use unicode menus in future. */
2534 unicode_append_menu = NULL;
2537 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2538 local_free (out_string);
2540 else
2542 return_value =
2543 AppendMenu (menu,
2544 fuFlags,
2545 item != NULL ? (UINT) item : (UINT) wv->call_data,
2546 out_string );
2549 /* This must be done after the menu item is created. */
2550 if (!wv->title && wv->call_data != 0)
2552 if (set_menu_item_info)
2554 MENUITEMINFO info;
2555 bzero (&info, sizeof (info));
2556 info.cbSize = sizeof (info);
2557 info.fMask = MIIM_DATA;
2559 /* Set help string for menu item. Leave it as a Lisp_Object
2560 until it is ready to be displayed, since GC can happen while
2561 menus are active. */
2562 if (!NILP (wv->help))
2563 #ifdef USE_LISP_UNION_TYPE
2564 info.dwItemData = (DWORD) (wv->help).i;
2565 #else
2566 info.dwItemData = (DWORD) (wv->help);
2567 #endif
2568 if (wv->button_type == BUTTON_TYPE_RADIO)
2570 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2571 RADIO items, but is not available on NT 3.51 and earlier. */
2572 info.fMask |= MIIM_TYPE | MIIM_STATE;
2573 info.fType = MFT_RADIOCHECK | MFT_STRING;
2574 info.dwTypeData = out_string;
2575 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2578 set_menu_item_info (menu,
2579 item != NULL ? (UINT) item : (UINT) wv->call_data,
2580 FALSE, &info);
2583 return return_value;
2586 /* Construct native Windows menu(bar) based on widget_value tree. */
2588 fill_in_menu (HMENU menu, widget_value *wv)
2590 int items_added = 0;
2592 for ( ; wv != NULL; wv = wv->next)
2594 if (wv->contents)
2596 HMENU sub_menu = CreatePopupMenu ();
2598 if (sub_menu == NULL)
2599 return 0;
2601 if (!fill_in_menu (sub_menu, wv->contents) ||
2602 !add_menu_item (menu, wv, sub_menu))
2604 DestroyMenu (sub_menu);
2605 return 0;
2608 else
2610 if (!add_menu_item (menu, wv, NULL))
2611 return 0;
2614 return 1;
2617 /* Display help string for currently pointed to menu item. Not
2618 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2619 available. */
2620 void
2621 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2623 if (get_menu_item_info)
2625 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2626 Lisp_Object frame, help;
2628 /* No help echo on owner-draw menu items, or when the keyboard is used
2629 to navigate the menus, since tooltips are distracting if they pop
2630 up elsewhere. */
2631 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2632 || !(flags & MF_MOUSESELECT))
2633 help = Qnil;
2634 else
2636 MENUITEMINFO info;
2638 bzero (&info, sizeof (info));
2639 info.cbSize = sizeof (info);
2640 info.fMask = MIIM_DATA;
2641 get_menu_item_info (menu, item, FALSE, &info);
2643 #ifdef USE_LISP_UNION_TYPE
2644 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2645 : Qnil;
2646 #else
2647 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2648 #endif
2651 /* Store the help echo in the keyboard buffer as the X toolkit
2652 version does, rather than directly showing it. This seems to
2653 solve the GC problems that were present when we based the
2654 Windows code on the non-toolkit version. */
2655 if (f)
2657 XSETFRAME (frame, f);
2658 kbd_buffer_store_help_event (frame, help);
2660 else
2661 /* X version has a loop through frames here, which doesn't
2662 appear to do anything, unless it has some side effect. */
2663 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2667 /* Free memory used by owner-drawn strings. */
2668 static void
2669 w32_free_submenu_strings (menu)
2670 HMENU menu;
2672 int i, num = GetMenuItemCount (menu);
2673 for (i = 0; i < num; i++)
2675 MENUITEMINFO info;
2676 bzero (&info, sizeof (info));
2677 info.cbSize = sizeof (info);
2678 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2680 get_menu_item_info (menu, i, TRUE, &info);
2682 /* Owner-drawn names are held in dwItemData. */
2683 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2685 #ifdef MENU_DEBUG
2686 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2687 #endif
2688 local_free (info.dwItemData);
2691 /* Recurse down submenus. */
2692 if (info.hSubMenu)
2693 w32_free_submenu_strings (info.hSubMenu);
2697 void
2698 w32_free_menu_strings (hwnd)
2699 HWND hwnd;
2701 HMENU menu = current_popup_menu;
2703 if (get_menu_item_info)
2705 /* If there is no popup menu active, free the strings from the frame's
2706 menubar. */
2707 if (!menu)
2708 menu = GetMenu (hwnd);
2710 if (menu)
2711 w32_free_submenu_strings (menu);
2714 current_popup_menu = NULL;
2717 #endif /* HAVE_MENUS */
2719 /* The following is used by delayed window autoselection. */
2721 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2722 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2725 #ifdef HAVE_MENUS
2726 FRAME_PTR f;
2727 f = SELECTED_FRAME ();
2728 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2729 #else
2730 return Qnil;
2731 #endif /* HAVE_MENUS */
2734 void syms_of_w32menu ()
2736 globals_of_w32menu ();
2737 staticpro (&menu_items);
2738 menu_items = Qnil;
2740 current_popup_menu = NULL;
2742 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
2744 defsubr (&Sx_popup_menu);
2745 defsubr (&Smenu_or_popup_active_p);
2746 #ifdef HAVE_MENUS
2747 defsubr (&Sx_popup_dialog);
2748 #endif
2752 globals_of_w32menu is used to initialize those global variables that
2753 must always be initialized on startup even when the global variable
2754 initialized is non zero (see the function main in emacs.c).
2755 globals_of_w32menu is called from syms_of_w32menu when the global
2756 variable initialized is 0 and directly from main when initialized
2757 is non zero.
2759 void globals_of_w32menu ()
2761 /* See if Get/SetMenuItemInfo functions are available. */
2762 HMODULE user32 = GetModuleHandle ("user32.dll");
2763 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2764 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2765 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2768 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2769 (do not change this comment) */