Load ediff-*.el files silently.
[emacs.git] / src / w32menu.c
bloba0ce8c655cb054208ffbd8f84a0e74acba933285
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 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 #include <config.h>
24 #include <signal.h>
25 #include <stdio.h>
26 #include <mbstring.h>
28 #include "lisp.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "frame.h"
32 #include "termhooks.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.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 ();
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 ();
176 #endif
177 static Lisp_Object w32_menu_show ();
179 static void keymap_panes ();
180 static void single_keymap_panes ();
181 static void single_menu_item ();
182 static void list_of_panes ();
183 static void list_of_items ();
184 void w32_free_menu_strings (HWND);
186 /* This holds a Lisp vector that holds the results of decoding
187 the keymaps or alist-of-alists that specify a menu.
189 It describes the panes and items within the panes.
191 Each pane is described by 3 elements in the vector:
192 t, the pane name, the pane's prefix key.
193 Then follow the pane's items, with 5 elements per item:
194 the item string, the enable flag, the item's value,
195 the definition, and the equivalent keyboard key's description string.
197 In some cases, multiple levels of menus may be described.
198 A single vector slot containing nil indicates the start of a submenu.
199 A single vector slot containing lambda indicates the end of a submenu.
200 The submenu follows a menu item which is the way to reach the submenu.
202 A single vector slot containing quote indicates that the
203 following items should appear on the right of a dialog box.
205 Using a Lisp vector to hold this information while we decode it
206 takes care of protecting all the data from GC. */
208 #define MENU_ITEMS_PANE_NAME 1
209 #define MENU_ITEMS_PANE_PREFIX 2
210 #define MENU_ITEMS_PANE_LENGTH 3
212 enum menu_item_idx
214 MENU_ITEMS_ITEM_NAME = 0,
215 MENU_ITEMS_ITEM_ENABLE,
216 MENU_ITEMS_ITEM_VALUE,
217 MENU_ITEMS_ITEM_EQUIV_KEY,
218 MENU_ITEMS_ITEM_DEFINITION,
219 MENU_ITEMS_ITEM_TYPE,
220 MENU_ITEMS_ITEM_SELECTED,
221 MENU_ITEMS_ITEM_HELP,
222 MENU_ITEMS_ITEM_LENGTH
225 static Lisp_Object menu_items;
227 /* Number of slots currently allocated in menu_items. */
228 static int menu_items_allocated;
230 /* This is the index in menu_items of the first empty slot. */
231 static int menu_items_used;
233 /* The number of panes currently recorded in menu_items,
234 excluding those within submenus. */
235 static int menu_items_n_panes;
237 /* Current depth within submenus. */
238 static int menu_items_submenu_depth;
240 static int next_menubar_widget_id;
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249 int pending_menu_activation;
252 /* Return the frame whose ->output_data.w32->menubar_widget equals
253 ID, or 0 if none. */
255 static struct frame *
256 menubar_id_to_frame (id)
257 HMENU id;
259 Lisp_Object tail, frame;
260 FRAME_PTR f;
262 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
264 frame = XCAR (tail);
265 if (!GC_FRAMEP (frame))
266 continue;
267 f = XFRAME (frame);
268 if (!FRAME_WINDOW_P (f))
269 continue;
270 if (f->output_data.w32->menubar_widget == id)
271 return f;
273 return 0;
276 /* Initialize the menu_items structure if we haven't already done so.
277 Also mark it as currently empty. */
279 static void
280 init_menu_items ()
282 if (NILP (menu_items))
284 menu_items_allocated = 60;
285 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
288 menu_items_used = 0;
289 menu_items_n_panes = 0;
290 menu_items_submenu_depth = 0;
293 /* Call at the end of generating the data in menu_items.
294 This fills in the number of items in the last pane. */
296 static void
297 finish_menu_items ()
301 /* Call when finished using the data for the current menu
302 in menu_items. */
304 static void
305 discard_menu_items ()
307 /* Free the structure if it is especially large.
308 Otherwise, hold on to it, to save time. */
309 if (menu_items_allocated > 200)
311 menu_items = Qnil;
312 menu_items_allocated = 0;
316 /* Make the menu_items vector twice as large. */
318 static void
319 grow_menu_items ()
321 menu_items_allocated *= 2;
322 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
325 /* Begin a submenu. */
327 static void
328 push_submenu_start ()
330 if (menu_items_used + 1 > menu_items_allocated)
331 grow_menu_items ();
333 ASET (menu_items, menu_items_used++, Qnil);
334 menu_items_submenu_depth++;
337 /* End a submenu. */
339 static void
340 push_submenu_end ()
342 if (menu_items_used + 1 > menu_items_allocated)
343 grow_menu_items ();
345 ASET (menu_items, menu_items_used++, Qlambda);
346 menu_items_submenu_depth--;
349 /* Indicate boundary between left and right. */
351 static void
352 push_left_right_boundary ()
354 if (menu_items_used + 1 > menu_items_allocated)
355 grow_menu_items ();
357 ASET (menu_items, menu_items_used++, Qquote);
360 /* Start a new menu pane in menu_items.
361 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
363 static void
364 push_menu_pane (name, prefix_vec)
365 Lisp_Object name, prefix_vec;
367 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
368 grow_menu_items ();
370 if (menu_items_submenu_depth == 0)
371 menu_items_n_panes++;
372 ASET (menu_items, menu_items_used++, Qt);
373 ASET (menu_items, menu_items_used++, name);
374 ASET (menu_items, menu_items_used++, prefix_vec);
377 /* Push one menu item into the current pane. NAME is the string to
378 display. ENABLE if non-nil means this item can be selected. KEY
379 is the key generated by choosing this item, or nil if this item
380 doesn't really have a definition. DEF is the definition of this
381 item. EQUIV is the textual description of the keyboard equivalent
382 for this item (or nil if none). TYPE is the type of this menu
383 item, one of nil, `toggle' or `radio'. */
385 static void
386 push_menu_item (name, enable, key, def, equiv, type, selected, help)
387 Lisp_Object name, enable, key, def, equiv, type, selected, help;
389 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
390 grow_menu_items ();
392 ASET (menu_items, menu_items_used++, name);
393 ASET (menu_items, menu_items_used++, enable);
394 ASET (menu_items, menu_items_used++, key);
395 ASET (menu_items, menu_items_used++, equiv);
396 ASET (menu_items, menu_items_used++, def);
397 ASET (menu_items, menu_items_used++, type);
398 ASET (menu_items, menu_items_used++, selected);
399 ASET (menu_items, menu_items_used++, help);
402 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
403 and generate menu panes for them in menu_items.
404 If NOTREAL is nonzero,
405 don't bother really computing whether an item is enabled. */
407 static void
408 keymap_panes (keymaps, nmaps, notreal)
409 Lisp_Object *keymaps;
410 int nmaps;
411 int notreal;
413 int mapno;
415 init_menu_items ();
417 /* Loop over the given keymaps, making a pane for each map.
418 But don't make a pane that is empty--ignore that map instead.
419 P is the number of panes we have made so far. */
420 for (mapno = 0; mapno < nmaps; mapno++)
421 single_keymap_panes (keymaps[mapno],
422 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
424 finish_menu_items ();
427 /* This is a recursive subroutine of keymap_panes.
428 It handles one keymap, KEYMAP.
429 The other arguments are passed along
430 or point to local variables of the previous function.
431 If NOTREAL is nonzero, only check for equivalent key bindings, don't
432 evaluate expressions in menu items and don't make any menu.
434 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
436 static void
437 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
438 Lisp_Object keymap;
439 Lisp_Object pane_name;
440 Lisp_Object prefix;
441 int notreal;
442 int maxdepth;
444 Lisp_Object pending_maps = Qnil;
445 Lisp_Object tail, item;
446 struct gcpro gcpro1, gcpro2;
448 if (maxdepth <= 0)
449 return;
451 push_menu_pane (pane_name, prefix);
453 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
455 GCPRO2 (keymap, pending_maps);
456 /* Look at each key binding, and if it is a menu item add it
457 to this menu. */
458 item = XCAR (tail);
459 if (CONSP (item))
460 single_menu_item (XCAR (item), XCDR (item),
461 &pending_maps, notreal, maxdepth);
462 else if (VECTORP (item))
464 /* Loop over the char values represented in the vector. */
465 int len = ASIZE (item);
466 int c;
467 for (c = 0; c < len; c++)
469 Lisp_Object character;
470 XSETFASTINT (character, c);
471 single_menu_item (character, AREF (item, c),
472 &pending_maps, notreal, maxdepth);
475 UNGCPRO;
478 /* Process now any submenus which want to be panes at this level. */
479 while (!NILP (pending_maps))
481 Lisp_Object elt, eltcdr, string;
482 elt = Fcar (pending_maps);
483 eltcdr = XCDR (elt);
484 string = XCAR (eltcdr);
485 /* We no longer discard the @ from the beginning of the string here.
486 Instead, we do this in w32_menu_show. */
487 single_keymap_panes (Fcar (elt), string,
488 XCDR (eltcdr), notreal, maxdepth - 1);
489 pending_maps = Fcdr (pending_maps);
493 /* This is a subroutine of single_keymap_panes that handles one
494 keymap entry.
495 KEY is a key in a keymap and ITEM is its binding.
496 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
497 separate panes.
498 If NOTREAL is nonzero, only check for equivalent key bindings, don't
499 evaluate expressions in menu items and don't make any menu.
500 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
502 static void
503 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
504 Lisp_Object key, item;
505 Lisp_Object *pending_maps_ptr;
506 int maxdepth, notreal;
508 Lisp_Object map, item_string, enabled;
509 struct gcpro gcpro1, gcpro2;
510 int res;
512 /* Parse the menu item and leave the result in item_properties. */
513 GCPRO2 (key, item);
514 res = parse_menu_item (item, notreal, 0);
515 UNGCPRO;
516 if (!res)
517 return; /* Not a menu item. */
519 map = AREF (item_properties, ITEM_PROPERTY_MAP);
521 if (notreal)
523 /* We don't want to make a menu, just traverse the keymaps to
524 precompute equivalent key bindings. */
525 if (!NILP (map))
526 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
527 return;
530 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
531 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
533 if (!NILP (map) && SREF (item_string, 0) == '@')
535 if (!NILP (enabled))
536 /* An enabled separate pane. Remember this to handle it later. */
537 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
538 *pending_maps_ptr);
539 return;
542 push_menu_item (item_string, enabled, key,
543 AREF (item_properties, ITEM_PROPERTY_DEF),
544 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
545 AREF (item_properties, ITEM_PROPERTY_TYPE),
546 AREF (item_properties, ITEM_PROPERTY_SELECTED),
547 AREF (item_properties, ITEM_PROPERTY_HELP));
549 /* Display a submenu using the toolkit. */
550 if (! (NILP (map) || NILP (enabled)))
552 push_submenu_start ();
553 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
554 push_submenu_end ();
558 /* Push all the panes and items of a menu described by the
559 alist-of-alists MENU.
560 This handles old-fashioned calls to x-popup-menu. */
562 static void
563 list_of_panes (menu)
564 Lisp_Object menu;
566 Lisp_Object tail;
568 init_menu_items ();
570 for (tail = menu; CONSP (tail); tail = XCDR (tail))
572 Lisp_Object elt, pane_name, pane_data;
573 elt = XCAR (tail);
574 pane_name = Fcar (elt);
575 CHECK_STRING (pane_name);
576 push_menu_pane (pane_name, Qnil);
577 pane_data = Fcdr (elt);
578 CHECK_CONS (pane_data);
579 list_of_items (pane_data);
582 finish_menu_items ();
585 /* Push the items in a single pane defined by the alist PANE. */
587 static void
588 list_of_items (pane)
589 Lisp_Object pane;
591 Lisp_Object tail, item, item1;
593 for (tail = pane; CONSP (tail); tail = XCDR (tail))
595 item = XCAR (tail);
596 if (STRINGP (item))
597 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
598 else if (NILP (item))
599 push_left_right_boundary ();
600 else
602 CHECK_CONS (item);
603 item1 = Fcar (item);
604 CHECK_STRING (item1);
605 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
610 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
611 doc: /* Pop up a deck-of-cards menu and return user's selection.
612 POSITION is a position specification. This is either a mouse button
613 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
614 are positions in pixels from the top left corner of WINDOW's frame
615 \(WINDOW may be a frame object instead of a window). This controls the
616 position of the center of the first line in the first pane of the
617 menu, not the top left of the menu as a whole. If POSITION is t, it
618 means to use the current mouse position.
620 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
621 The menu items come from key bindings that have a menu string as well as
622 a definition; actually, the \"definition\" in such a key binding looks like
623 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
624 the keymap as a top-level element.
626 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
627 Otherwise, REAL-DEFINITION should be a valid key binding definition.
629 You can also use a list of keymaps as MENU. Then each keymap makes a
630 separate pane. When MENU is a keymap or a list of keymaps, the return
631 value is a list of events.
633 Alternatively, you can specify a menu of multiple panes with a list of
634 the form (TITLE PANE1 PANE2...), where each pane is a list of
635 form (TITLE ITEM1 ITEM2...).
636 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
637 appear as an item--that makes a nonselectable line in the menu.
638 With this form of menu, the return value is VALUE from the chosen item.
640 If POSITION is nil, don't display the menu at all, just precalculate the
641 cached information about equivalent key sequences. */)
642 (position, menu)
643 Lisp_Object position, menu;
645 Lisp_Object keymap, tem;
646 int xpos = 0, ypos = 0;
647 Lisp_Object title;
648 char *error_name;
649 Lisp_Object selection;
650 FRAME_PTR f = NULL;
651 Lisp_Object x, y, window;
652 int keymaps = 0;
653 int for_click = 0;
654 struct gcpro gcpro1;
656 #ifdef HAVE_MENUS
657 if (! NILP (position))
659 check_w32 ();
661 /* Decode the first argument: find the window and the coordinates. */
662 if (EQ (position, Qt)
663 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
664 || EQ (XCAR (position), Qtool_bar))))
666 /* Use the mouse's current position. */
667 FRAME_PTR new_f = SELECTED_FRAME ();
668 Lisp_Object bar_window;
669 enum scroll_bar_part part;
670 unsigned long time;
672 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
673 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
674 &part, &x, &y, &time);
675 if (new_f != 0)
676 XSETFRAME (window, new_f);
677 else
679 window = selected_window;
680 XSETFASTINT (x, 0);
681 XSETFASTINT (y, 0);
684 else
686 tem = Fcar (position);
687 if (CONSP (tem))
689 window = Fcar (Fcdr (position));
690 x = Fcar (tem);
691 y = Fcar (Fcdr (tem));
693 else
695 for_click = 1;
696 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
697 window = Fcar (tem); /* POSN_WINDOW (tem) */
698 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
699 x = Fcar (tem);
700 y = Fcdr (tem);
704 CHECK_NUMBER (x);
705 CHECK_NUMBER (y);
707 /* Decode where to put the menu. */
709 if (FRAMEP (window))
711 f = XFRAME (window);
712 xpos = 0;
713 ypos = 0;
715 else if (WINDOWP (window))
717 CHECK_LIVE_WINDOW (window);
718 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
720 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
721 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
723 else
724 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
725 but I don't want to make one now. */
726 CHECK_WINDOW (window);
728 xpos += XINT (x);
729 ypos += XINT (y);
731 XSETFRAME (Vmenu_updating_frame, f);
733 else
734 Vmenu_updating_frame = Qnil;
735 #endif /* HAVE_MENUS */
737 title = Qnil;
738 GCPRO1 (title);
740 /* Decode the menu items from what was specified. */
742 keymap = get_keymap (menu, 0, 0);
743 if (CONSP (keymap))
745 /* We were given a keymap. Extract menu info from the keymap. */
746 Lisp_Object prompt;
748 /* Extract the detailed info to make one pane. */
749 keymap_panes (&menu, 1, NILP (position));
751 /* Search for a string appearing directly as an element of the keymap.
752 That string is the title of the menu. */
753 prompt = Fkeymap_prompt (keymap);
754 if (NILP (title) && !NILP (prompt))
755 title = prompt;
757 /* Make that be the pane title of the first pane. */
758 if (!NILP (prompt) && menu_items_n_panes >= 0)
759 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
761 keymaps = 1;
763 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
765 /* We were given a list of keymaps. */
766 int nmaps = XFASTINT (Flength (menu));
767 Lisp_Object *maps
768 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
769 int i;
771 title = Qnil;
773 /* The first keymap that has a prompt string
774 supplies the menu title. */
775 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
777 Lisp_Object prompt;
779 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
781 prompt = Fkeymap_prompt (keymap);
782 if (NILP (title) && !NILP (prompt))
783 title = prompt;
786 /* Extract the detailed info to make one pane. */
787 keymap_panes (maps, nmaps, NILP (position));
789 /* Make the title be the pane title of the first pane. */
790 if (!NILP (title) && menu_items_n_panes >= 0)
791 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
793 keymaps = 1;
795 else
797 /* We were given an old-fashioned menu. */
798 title = Fcar (menu);
799 CHECK_STRING (title);
801 list_of_panes (Fcdr (menu));
803 keymaps = 0;
806 if (NILP (position))
808 discard_menu_items ();
809 UNGCPRO;
810 return Qnil;
813 #ifdef HAVE_MENUS
814 /* If resources from a previous popup menu still exist, does nothing
815 until the `menu_free_timer' has freed them (see w32fns.c). This
816 can occur if you press ESC or click outside a menu without selecting
817 a menu item.
819 if (current_popup_menu)
821 discard_menu_items ();
822 UNGCPRO;
823 return Qnil;
826 /* Display them in a menu. */
827 BLOCK_INPUT;
829 selection = w32_menu_show (f, xpos, ypos, for_click,
830 keymaps, title, &error_name);
831 UNBLOCK_INPUT;
833 discard_menu_items ();
835 #endif /* HAVE_MENUS */
837 UNGCPRO;
839 if (error_name) error (error_name);
840 return selection;
843 #ifdef HAVE_MENUS
845 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
846 doc: /* Pop up a dialog box and return user's selection.
847 POSITION specifies which frame to use.
848 This is normally a mouse button event or a window or frame.
849 If POSITION is t, it means to use the frame the mouse is on.
850 The dialog box appears in the middle of the specified frame.
852 CONTENTS specifies the alternatives to display in the dialog box.
853 It is a list of the form (TITLE ITEM1 ITEM2...).
854 Each ITEM is a cons cell (STRING . VALUE).
855 The return value is VALUE from the chosen item.
857 An ITEM may also be just a string--that makes a nonselectable item.
858 An ITEM may also be nil--that means to put all preceding items
859 on the left of the dialog box and all following items on the right.
860 \(By default, approximately half appear on each side.)
862 If HEADER is non-nil, the frame title for the box is "Information",
863 otherwise it is "Question". */)
864 (position, contents, header)
865 Lisp_Object position, contents, header;
867 FRAME_PTR f = NULL;
868 Lisp_Object window;
870 check_w32 ();
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position, Qt)
874 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
875 || EQ (XCAR (position), Qtool_bar))))
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f = SELECTED_FRAME ();
880 Lisp_Object bar_window;
881 enum scroll_bar_part part;
882 unsigned long time;
883 Lisp_Object x, y;
885 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
887 if (new_f != 0)
888 XSETFRAME (window, new_f);
889 else
890 window = selected_window;
891 #endif
892 window = selected_window;
894 else if (CONSP (position))
896 Lisp_Object tem;
897 tem = Fcar (position);
898 if (CONSP (tem))
899 window = Fcar (Fcdr (position));
900 else
902 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
903 window = Fcar (tem); /* POSN_WINDOW (tem) */
906 else if (WINDOWP (position) || FRAMEP (position))
907 window = position;
908 else
909 window = Qnil;
911 /* Decode where to put the menu. */
913 if (FRAMEP (window))
914 f = XFRAME (window);
915 else if (WINDOWP (window))
917 CHECK_LIVE_WINDOW (window);
918 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
920 else
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window);
925 #ifndef HAVE_DIALOGS
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
929 Lisp_Object x, y, frame, newpos;
930 XSETFRAME (frame, f);
931 XSETINT (x, x_pixel_width (f) / 2);
932 XSETINT (y, x_pixel_height (f) / 2);
933 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
935 return Fx_popup_menu (newpos,
936 Fcons (Fcar (contents), Fcons (contents, Qnil)));
938 #else /* HAVE_DIALOGS */
940 Lisp_Object title;
941 char *error_name;
942 Lisp_Object selection;
944 /* Decode the dialog items from what was specified. */
945 title = Fcar (contents);
946 CHECK_STRING (title);
948 list_of_panes (Fcons (contents, Qnil));
950 /* Display them in a dialog box. */
951 BLOCK_INPUT;
952 selection = w32_dialog_show (f, 0, title, header, &error_name);
953 UNBLOCK_INPUT;
955 discard_menu_items ();
957 if (error_name) error (error_name);
958 return selection;
960 #endif /* HAVE_DIALOGS */
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
971 But first we recompute the menu bar contents (the whole tree).
973 This way we can safely execute Lisp code. */
975 void
976 x_activate_menubar (f)
977 FRAME_PTR f;
979 set_frame_menubar (f, 0, 1);
981 /* Lock out further menubar changes while active. */
982 f->output_data.w32->menubar_active = 1;
984 /* Signal input thread to return from WM_INITMENU. */
985 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
993 void
994 menubar_selection_callback (FRAME_PTR f, void * client_data)
996 Lisp_Object prefix, entry;
997 Lisp_Object vector;
998 Lisp_Object *subprefix_stack;
999 int submenu_depth = 0;
1000 int i;
1002 if (!f)
1003 return;
1004 entry = Qnil;
1005 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1006 vector = f->menu_bar_vector;
1007 prefix = Qnil;
1008 i = 0;
1009 while (i < f->menu_bar_items_used)
1011 if (EQ (AREF (vector, i), Qnil))
1013 subprefix_stack[submenu_depth++] = prefix;
1014 prefix = entry;
1015 i++;
1017 else if (EQ (AREF (vector, i), Qlambda))
1019 prefix = subprefix_stack[--submenu_depth];
1020 i++;
1022 else if (EQ (AREF (vector, i), Qt))
1024 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1025 i += MENU_ITEMS_PANE_LENGTH;
1027 else
1029 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT) client_data == i)
1034 int j;
1035 struct input_event buf;
1036 Lisp_Object frame;
1037 EVENT_INIT (buf);
1039 XSETFRAME (frame, f);
1040 buf.kind = MENU_BAR_EVENT;
1041 buf.frame_or_window = frame;
1042 buf.arg = frame;
1043 kbd_buffer_store_event (&buf);
1045 for (j = 0; j < submenu_depth; j++)
1046 if (!NILP (subprefix_stack[j]))
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = subprefix_stack[j];
1051 kbd_buffer_store_event (&buf);
1054 if (!NILP (prefix))
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = prefix;
1059 kbd_buffer_store_event (&buf);
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = entry;
1065 /* Free memory used by owner-drawn and help-echo strings. */
1066 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1067 kbd_buffer_store_event (&buf);
1069 f->output_data.w32->menubar_active = 0;
1070 return;
1072 i += MENU_ITEMS_ITEM_LENGTH;
1075 /* Free memory used by owner-drawn and help-echo strings. */
1076 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1077 f->output_data.w32->menubar_active = 0;
1080 /* Allocate a widget_value, blocking input. */
1082 widget_value *
1083 xmalloc_widget_value ()
1085 widget_value *value;
1087 BLOCK_INPUT;
1088 value = malloc_widget_value ();
1089 UNBLOCK_INPUT;
1091 return value;
1094 /* This recursively calls free_widget_value on the tree of widgets.
1095 It must free all data that was malloc'ed for these widget_values.
1096 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1097 must be left alone. */
1099 void
1100 free_menubar_widget_value_tree (wv)
1101 widget_value *wv;
1103 if (! wv) return;
1105 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1107 if (wv->contents && (wv->contents != (widget_value*)1))
1109 free_menubar_widget_value_tree (wv->contents);
1110 wv->contents = (widget_value *) 0xDEADBEEF;
1112 if (wv->next)
1114 free_menubar_widget_value_tree (wv->next);
1115 wv->next = (widget_value *) 0xDEADBEEF;
1117 BLOCK_INPUT;
1118 free_widget_value (wv);
1119 UNBLOCK_INPUT;
1122 /* Set up data i menu_items for a menu bar item
1123 whose event type is ITEM_KEY (with string ITEM_NAME)
1124 and whose contents come from the list of keymaps MAPS. */
1126 static int
1127 parse_single_submenu (item_key, item_name, maps)
1128 Lisp_Object item_key, item_name, maps;
1130 Lisp_Object length;
1131 int len;
1132 Lisp_Object *mapvec;
1133 int i;
1134 int top_level_items = 0;
1136 length = Flength (maps);
1137 len = XINT (length);
1139 /* Convert the list MAPS into a vector MAPVEC. */
1140 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1141 for (i = 0; i < len; i++)
1143 mapvec[i] = Fcar (maps);
1144 maps = Fcdr (maps);
1147 /* Loop over the given keymaps, making a pane for each map.
1148 But don't make a pane that is empty--ignore that map instead. */
1149 for (i = 0; i < len; i++)
1151 if (SYMBOLP (mapvec[i])
1152 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1154 /* Here we have a command at top level in the menu bar
1155 as opposed to a submenu. */
1156 top_level_items = 1;
1157 push_menu_pane (Qnil, Qnil);
1158 push_menu_item (item_name, Qt, item_key, mapvec[i],
1159 Qnil, Qnil, Qnil, Qnil);
1161 else
1163 Lisp_Object prompt;
1164 prompt = Fkeymap_prompt (mapvec[i]);
1165 single_keymap_panes (mapvec[i],
1166 !NILP (prompt) ? prompt : item_name,
1167 item_key, 0, 10);
1171 return top_level_items;
1175 /* Create a tree of widget_value objects
1176 representing the panes and items
1177 in menu_items starting at index START, up to index END. */
1179 static widget_value *
1180 digest_single_submenu (start, end, top_level_items)
1181 int start, end, top_level_items;
1183 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1184 int i;
1185 int submenu_depth = 0;
1186 widget_value **submenu_stack;
1188 submenu_stack
1189 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1190 wv = xmalloc_widget_value ();
1191 wv->name = "menu";
1192 wv->value = 0;
1193 wv->enabled = 1;
1194 wv->button_type = BUTTON_TYPE_NONE;
1195 wv->help = Qnil;
1196 first_wv = wv;
1197 save_wv = 0;
1198 prev_wv = 0;
1200 /* Loop over all panes and items made by the preceding call
1201 to parse_single_submenu and construct a tree of widget_value objects.
1202 Ignore the panes and items used by previous calls to
1203 digest_single_submenu, even though those are also in menu_items. */
1204 i = start;
1205 while (i < end)
1207 if (EQ (AREF (menu_items, i), Qnil))
1209 submenu_stack[submenu_depth++] = save_wv;
1210 save_wv = prev_wv;
1211 prev_wv = 0;
1212 i++;
1214 else if (EQ (AREF (menu_items, i), Qlambda))
1216 prev_wv = save_wv;
1217 save_wv = submenu_stack[--submenu_depth];
1218 i++;
1220 else if (EQ (AREF (menu_items, i), Qt)
1221 && submenu_depth != 0)
1222 i += MENU_ITEMS_PANE_LENGTH;
1223 /* Ignore a nil in the item list.
1224 It's meaningful only for dialog boxes. */
1225 else if (EQ (AREF (menu_items, i), Qquote))
1226 i += 1;
1227 else if (EQ (AREF (menu_items, i), Qt))
1229 /* Create a new pane. */
1230 Lisp_Object pane_name, prefix;
1231 char *pane_string;
1233 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1234 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1236 if (STRINGP (pane_name))
1238 if (unicode_append_menu)
1239 /* Encode as UTF-8 for now. */
1240 pane_name = ENCODE_UTF_8 (pane_name);
1241 else if (STRING_MULTIBYTE (pane_name))
1242 pane_name = ENCODE_SYSTEM (pane_name);
1244 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1247 pane_string = (NILP (pane_name)
1248 ? "" : (char *) SDATA (pane_name));
1249 /* If there is just one top-level pane, put all its items directly
1250 under the top-level menu. */
1251 if (menu_items_n_panes == 1)
1252 pane_string = "";
1254 /* If the pane has a meaningful name,
1255 make the pane a top-level menu item
1256 with its items as a submenu beneath it. */
1257 if (strcmp (pane_string, ""))
1259 wv = xmalloc_widget_value ();
1260 if (save_wv)
1261 save_wv->next = wv;
1262 else
1263 first_wv->contents = wv;
1264 wv->lname = pane_name;
1265 /* Set value to 1 so update_submenu_strings can handle '@' */
1266 wv->value = (char *) 1;
1267 wv->enabled = 1;
1268 wv->button_type = BUTTON_TYPE_NONE;
1269 wv->help = Qnil;
1271 save_wv = wv;
1272 prev_wv = 0;
1273 i += MENU_ITEMS_PANE_LENGTH;
1275 else
1277 /* Create a new item within current pane. */
1278 Lisp_Object item_name, enable, descrip, def, type, selected;
1279 Lisp_Object help;
1281 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1282 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1283 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1284 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1285 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1286 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1287 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1289 if (STRINGP (item_name))
1291 if (unicode_append_menu)
1292 item_name = ENCODE_UTF_8 (item_name);
1293 else if (STRING_MULTIBYTE (item_name))
1294 item_name = ENCODE_SYSTEM (item_name);
1296 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1299 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1301 descrip = ENCODE_SYSTEM (descrip);
1302 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1305 wv = xmalloc_widget_value ();
1306 if (prev_wv)
1307 prev_wv->next = wv;
1308 else
1309 save_wv->contents = wv;
1311 wv->lname = item_name;
1312 if (!NILP (descrip))
1313 wv->lkey = descrip;
1314 wv->value = 0;
1315 /* The EMACS_INT cast avoids a warning. There's no problem
1316 as long as pointers have enough bits to hold small integers. */
1317 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1318 wv->enabled = !NILP (enable);
1320 if (NILP (type))
1321 wv->button_type = BUTTON_TYPE_NONE;
1322 else if (EQ (type, QCradio))
1323 wv->button_type = BUTTON_TYPE_RADIO;
1324 else if (EQ (type, QCtoggle))
1325 wv->button_type = BUTTON_TYPE_TOGGLE;
1326 else
1327 abort ();
1329 wv->selected = !NILP (selected);
1330 if (!STRINGP (help))
1331 help = Qnil;
1333 wv->help = help;
1335 prev_wv = wv;
1337 i += MENU_ITEMS_ITEM_LENGTH;
1341 /* If we have just one "menu item"
1342 that was originally a button, return it by itself. */
1343 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1345 wv = first_wv->contents;
1346 free_widget_value (first_wv);
1347 return wv;
1350 return first_wv;
1354 /* Walk through the widget_value tree starting at FIRST_WV and update
1355 the char * pointers from the corresponding lisp values.
1356 We do this after building the whole tree, since GC may happen while the
1357 tree is constructed, and small strings are relocated. So we must wait
1358 until no GC can happen before storing pointers into lisp values. */
1359 static void
1360 update_submenu_strings (first_wv)
1361 widget_value *first_wv;
1363 widget_value *wv;
1365 for (wv = first_wv; wv; wv = wv->next)
1367 if (wv->lname && ! NILP (wv->lname))
1369 wv->name = SDATA (wv->lname);
1371 /* Ignore the @ that means "separate pane".
1372 This is a kludge, but this isn't worth more time. */
1373 if (wv->value == (char *)1)
1375 if (wv->name[0] == '@')
1376 wv->name++;
1377 wv->value = 0;
1381 if (wv->lkey && ! NILP (wv->lkey))
1382 wv->key = SDATA (wv->lkey);
1384 if (wv->contents)
1385 update_submenu_strings (wv->contents);
1390 /* Set the contents of the menubar widgets of frame F.
1391 The argument FIRST_TIME is currently ignored;
1392 it is set the first time this is called, from initialize_frame_menubar. */
1394 void
1395 set_frame_menubar (f, first_time, deep_p)
1396 FRAME_PTR f;
1397 int first_time;
1398 int deep_p;
1400 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1401 Lisp_Object items;
1402 widget_value *wv, *first_wv, *prev_wv = 0;
1403 int i, last_i;
1404 int *submenu_start, *submenu_end;
1405 int *submenu_top_level_items, *submenu_n_panes;
1407 /* We must not change the menubar when actually in use. */
1408 if (f->output_data.w32->menubar_active)
1409 return;
1411 XSETFRAME (Vmenu_updating_frame, f);
1413 if (! menubar_widget)
1414 deep_p = 1;
1415 else if (pending_menu_activation && !deep_p)
1416 deep_p = 1;
1418 if (deep_p)
1420 /* Make a widget-value tree representing the entire menu trees. */
1422 struct buffer *prev = current_buffer;
1423 Lisp_Object buffer;
1424 int specpdl_count = SPECPDL_INDEX ();
1425 int previous_menu_items_used = f->menu_bar_items_used;
1426 Lisp_Object *previous_items
1427 = (Lisp_Object *) alloca (previous_menu_items_used
1428 * sizeof (Lisp_Object));
1430 /* If we are making a new widget, its contents are empty,
1431 do always reinitialize them. */
1432 if (! menubar_widget)
1433 previous_menu_items_used = 0;
1435 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1436 specbind (Qinhibit_quit, Qt);
1437 /* Don't let the debugger step into this code
1438 because it is not reentrant. */
1439 specbind (Qdebug_on_next_call, Qnil);
1441 record_unwind_save_match_data ();
1443 if (NILP (Voverriding_local_map_menu_flag))
1445 specbind (Qoverriding_terminal_local_map, Qnil);
1446 specbind (Qoverriding_local_map, Qnil);
1449 set_buffer_internal_1 (XBUFFER (buffer));
1451 /* Run the Lucid hook. */
1452 safe_run_hooks (Qactivate_menubar_hook);
1453 /* If it has changed current-menubar from previous value,
1454 really recompute the menubar from the value. */
1455 if (! NILP (Vlucid_menu_bar_dirty_flag))
1456 call0 (Qrecompute_lucid_menubar);
1457 safe_run_hooks (Qmenu_bar_update_hook);
1458 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1460 items = FRAME_MENU_BAR_ITEMS (f);
1462 /* Save the frame's previous menu bar contents data. */
1463 if (previous_menu_items_used)
1464 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1465 previous_menu_items_used * sizeof (Lisp_Object));
1467 /* Fill in menu_items with the current menu bar contents.
1468 This can evaluate Lisp code. */
1469 menu_items = f->menu_bar_vector;
1470 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1471 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1472 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1473 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1474 submenu_top_level_items
1475 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1476 init_menu_items ();
1477 for (i = 0; i < ASIZE (items); i += 4)
1479 Lisp_Object key, string, maps;
1481 last_i = i;
1483 key = AREF (items, i);
1484 string = AREF (items, i + 1);
1485 maps = AREF (items, i + 2);
1486 if (NILP (string))
1487 break;
1489 submenu_start[i] = menu_items_used;
1491 menu_items_n_panes = 0;
1492 submenu_top_level_items[i]
1493 = parse_single_submenu (key, string, maps);
1494 submenu_n_panes[i] = menu_items_n_panes;
1496 submenu_end[i] = menu_items_used;
1499 finish_menu_items ();
1501 /* Convert menu_items into widget_value trees
1502 to display the menu. This cannot evaluate Lisp code. */
1504 wv = xmalloc_widget_value ();
1505 wv->name = "menubar";
1506 wv->value = 0;
1507 wv->enabled = 1;
1508 wv->button_type = BUTTON_TYPE_NONE;
1509 wv->help = Qnil;
1510 first_wv = wv;
1512 for (i = 0; i < last_i; i += 4)
1514 menu_items_n_panes = submenu_n_panes[i];
1515 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1516 submenu_top_level_items[i]);
1517 if (prev_wv)
1518 prev_wv->next = wv;
1519 else
1520 first_wv->contents = wv;
1521 /* Don't set wv->name here; GC during the loop might relocate it. */
1522 wv->enabled = 1;
1523 wv->button_type = BUTTON_TYPE_NONE;
1524 prev_wv = wv;
1527 set_buffer_internal_1 (prev);
1528 unbind_to (specpdl_count, Qnil);
1530 /* If there has been no change in the Lisp-level contents
1531 of the menu bar, skip redisplaying it. Just exit. */
1533 for (i = 0; i < previous_menu_items_used; i++)
1534 if (menu_items_used == i
1535 || (!EQ (previous_items[i], AREF (menu_items, i))))
1536 break;
1537 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1539 free_menubar_widget_value_tree (first_wv);
1540 menu_items = Qnil;
1542 return;
1545 /* Now GC cannot happen during the lifetime of the widget_value,
1546 so it's safe to store data from a Lisp_String, as long as
1547 local copies are made when the actual menu is created.
1548 Windows takes care of this for normal string items, but
1549 not for owner-drawn items or additional item-info. */
1550 wv = first_wv->contents;
1551 for (i = 0; i < ASIZE (items); i += 4)
1553 Lisp_Object string;
1554 string = AREF (items, i + 1);
1555 if (NILP (string))
1556 break;
1557 wv->name = (char *) SDATA (string);
1558 update_submenu_strings (wv->contents);
1559 wv = wv->next;
1562 f->menu_bar_vector = menu_items;
1563 f->menu_bar_items_used = menu_items_used;
1564 menu_items = Qnil;
1566 else
1568 /* Make a widget-value tree containing
1569 just the top level menu bar strings. */
1571 wv = xmalloc_widget_value ();
1572 wv->name = "menubar";
1573 wv->value = 0;
1574 wv->enabled = 1;
1575 wv->button_type = BUTTON_TYPE_NONE;
1576 wv->help = Qnil;
1577 first_wv = wv;
1579 items = FRAME_MENU_BAR_ITEMS (f);
1580 for (i = 0; i < ASIZE (items); i += 4)
1582 Lisp_Object string;
1584 string = AREF (items, i + 1);
1585 if (NILP (string))
1586 break;
1588 wv = xmalloc_widget_value ();
1589 wv->name = (char *) SDATA (string);
1590 wv->value = 0;
1591 wv->enabled = 1;
1592 wv->button_type = BUTTON_TYPE_NONE;
1593 wv->help = Qnil;
1594 /* This prevents lwlib from assuming this
1595 menu item is really supposed to be empty. */
1596 /* The EMACS_INT cast avoids a warning.
1597 This value just has to be different from small integers. */
1598 wv->call_data = (void *) (EMACS_INT) (-1);
1600 if (prev_wv)
1601 prev_wv->next = wv;
1602 else
1603 first_wv->contents = wv;
1604 prev_wv = wv;
1607 /* Forget what we thought we knew about what is in the
1608 detailed contents of the menu bar menus.
1609 Changing the top level always destroys the contents. */
1610 f->menu_bar_items_used = 0;
1613 /* Create or update the menu bar widget. */
1615 BLOCK_INPUT;
1617 if (menubar_widget)
1619 /* Empty current menubar, rather than creating a fresh one. */
1620 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1623 else
1625 menubar_widget = CreateMenu ();
1627 fill_in_menu (menubar_widget, first_wv->contents);
1629 free_menubar_widget_value_tree (first_wv);
1632 HMENU old_widget = f->output_data.w32->menubar_widget;
1634 f->output_data.w32->menubar_widget = menubar_widget;
1635 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1636 /* Causes flicker when menu bar is updated
1637 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1639 /* Force the window size to be recomputed so that the frame's text
1640 area remains the same, if menubar has just been created. */
1641 if (old_widget == NULL)
1642 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1645 UNBLOCK_INPUT;
1648 /* Called from Fx_create_frame to create the initial menubar of a frame
1649 before it is mapped, so that the window is mapped with the menubar already
1650 there instead of us tacking it on later and thrashing the window after it
1651 is visible. */
1653 void
1654 initialize_frame_menubar (f)
1655 FRAME_PTR f;
1657 /* This function is called before the first chance to redisplay
1658 the frame. It has to be, so the frame will have the right size. */
1659 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1660 set_frame_menubar (f, 1, 1);
1663 /* Get rid of the menu bar of frame F, and free its storage.
1664 This is used when deleting a frame, and when turning off the menu bar. */
1666 void
1667 free_frame_menubar (f)
1668 FRAME_PTR f;
1670 BLOCK_INPUT;
1673 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1674 SetMenu (FRAME_W32_WINDOW (f), NULL);
1675 f->output_data.w32->menubar_widget = NULL;
1676 DestroyMenu (old);
1679 UNBLOCK_INPUT;
1683 /* w32_menu_show actually displays a menu using the panes and items in
1684 menu_items and returns the value selected from it; we assume input
1685 is blocked by the caller. */
1687 /* F is the frame the menu is for.
1688 X and Y are the frame-relative specified position,
1689 relative to the inside upper left corner of the frame F.
1690 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1691 KEYMAPS is 1 if this menu was specified with keymaps;
1692 in that case, we return a list containing the chosen item's value
1693 and perhaps also the pane's prefix.
1694 TITLE is the specified menu title.
1695 ERROR is a place to store an error message string in case of failure.
1696 (We return nil on failure, but the value doesn't actually matter.) */
1698 static Lisp_Object
1699 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1700 FRAME_PTR f;
1701 int x;
1702 int y;
1703 int for_click;
1704 int keymaps;
1705 Lisp_Object title;
1706 char **error;
1708 int i;
1709 int menu_item_selection;
1710 HMENU menu;
1711 POINT pos;
1712 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1713 widget_value **submenu_stack
1714 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1715 Lisp_Object *subprefix_stack
1716 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1717 int submenu_depth = 0;
1718 int first_pane;
1720 *error = NULL;
1722 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1724 *error = "Empty menu";
1725 return Qnil;
1728 /* Create a tree of widget_value objects
1729 representing the panes and their items. */
1730 wv = xmalloc_widget_value ();
1731 wv->name = "menu";
1732 wv->value = 0;
1733 wv->enabled = 1;
1734 wv->button_type = BUTTON_TYPE_NONE;
1735 wv->help = Qnil;
1736 first_wv = wv;
1737 first_pane = 1;
1739 /* Loop over all panes and items, filling in the tree. */
1740 i = 0;
1741 while (i < menu_items_used)
1743 if (EQ (AREF (menu_items, i), Qnil))
1745 submenu_stack[submenu_depth++] = save_wv;
1746 save_wv = prev_wv;
1747 prev_wv = 0;
1748 first_pane = 1;
1749 i++;
1751 else if (EQ (AREF (menu_items, i), Qlambda))
1753 prev_wv = save_wv;
1754 save_wv = submenu_stack[--submenu_depth];
1755 first_pane = 0;
1756 i++;
1758 else if (EQ (AREF (menu_items, i), Qt)
1759 && submenu_depth != 0)
1760 i += MENU_ITEMS_PANE_LENGTH;
1761 /* Ignore a nil in the item list.
1762 It's meaningful only for dialog boxes. */
1763 else if (EQ (AREF (menu_items, i), Qquote))
1764 i += 1;
1765 else if (EQ (AREF (menu_items, i), Qt))
1767 /* Create a new pane. */
1768 Lisp_Object pane_name, prefix;
1769 char *pane_string;
1770 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1771 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1773 if (STRINGP (pane_name))
1775 if (unicode_append_menu)
1776 pane_name = ENCODE_UTF_8 (pane_name);
1777 else if (STRING_MULTIBYTE (pane_name))
1778 pane_name = ENCODE_SYSTEM (pane_name);
1780 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1783 pane_string = (NILP (pane_name)
1784 ? "" : (char *) SDATA (pane_name));
1785 /* If there is just one top-level pane, put all its items directly
1786 under the top-level menu. */
1787 if (menu_items_n_panes == 1)
1788 pane_string = "";
1790 /* If the pane has a meaningful name,
1791 make the pane a top-level menu item
1792 with its items as a submenu beneath it. */
1793 if (!keymaps && strcmp (pane_string, ""))
1795 wv = xmalloc_widget_value ();
1796 if (save_wv)
1797 save_wv->next = wv;
1798 else
1799 first_wv->contents = wv;
1800 wv->name = pane_string;
1801 if (keymaps && !NILP (prefix))
1802 wv->name++;
1803 wv->value = 0;
1804 wv->enabled = 1;
1805 wv->button_type = BUTTON_TYPE_NONE;
1806 wv->help = Qnil;
1807 save_wv = wv;
1808 prev_wv = 0;
1810 else if (first_pane)
1812 save_wv = wv;
1813 prev_wv = 0;
1815 first_pane = 0;
1816 i += MENU_ITEMS_PANE_LENGTH;
1818 else
1820 /* Create a new item within current pane. */
1821 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1823 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1824 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1825 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1826 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1827 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1828 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1829 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1831 if (STRINGP (item_name))
1833 if (unicode_append_menu)
1834 item_name = ENCODE_UTF_8 (item_name);
1835 else if (STRING_MULTIBYTE (item_name))
1836 item_name = ENCODE_SYSTEM (item_name);
1838 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1841 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1843 descrip = ENCODE_SYSTEM (descrip);
1844 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1847 wv = xmalloc_widget_value ();
1848 if (prev_wv)
1849 prev_wv->next = wv;
1850 else
1851 save_wv->contents = wv;
1852 wv->name = (char *) SDATA (item_name);
1853 if (!NILP (descrip))
1854 wv->key = (char *) SDATA (descrip);
1855 wv->value = 0;
1856 /* Use the contents index as call_data, since we are
1857 restricted to 16-bits. */
1858 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1859 wv->enabled = !NILP (enable);
1861 if (NILP (type))
1862 wv->button_type = BUTTON_TYPE_NONE;
1863 else if (EQ (type, QCtoggle))
1864 wv->button_type = BUTTON_TYPE_TOGGLE;
1865 else if (EQ (type, QCradio))
1866 wv->button_type = BUTTON_TYPE_RADIO;
1867 else
1868 abort ();
1870 wv->selected = !NILP (selected);
1871 if (!STRINGP (help))
1872 help = Qnil;
1874 wv->help = help;
1876 prev_wv = wv;
1878 i += MENU_ITEMS_ITEM_LENGTH;
1882 /* Deal with the title, if it is non-nil. */
1883 if (!NILP (title))
1885 widget_value *wv_title = xmalloc_widget_value ();
1886 widget_value *wv_sep = xmalloc_widget_value ();
1888 /* Maybe replace this separator with a bitmap or owner-draw item
1889 so that it looks better. Having two separators looks odd. */
1890 wv_sep->name = "--";
1891 wv_sep->next = first_wv->contents;
1892 wv_sep->help = Qnil;
1894 if (unicode_append_menu)
1895 title = ENCODE_UTF_8 (title);
1896 else if (STRING_MULTIBYTE (title))
1897 title = ENCODE_SYSTEM (title);
1899 wv_title->name = (char *) SDATA (title);
1900 wv_title->enabled = TRUE;
1901 wv_title->title = TRUE;
1902 wv_title->button_type = BUTTON_TYPE_NONE;
1903 wv_title->help = Qnil;
1904 wv_title->next = wv_sep;
1905 first_wv->contents = wv_title;
1908 /* Actually create the menu. */
1909 current_popup_menu = menu = CreatePopupMenu ();
1910 fill_in_menu (menu, first_wv->contents);
1912 /* Adjust coordinates to be root-window-relative. */
1913 pos.x = x;
1914 pos.y = y;
1915 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1917 /* No selection has been chosen yet. */
1918 menu_item_selection = 0;
1920 /* Display the menu. */
1921 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1922 WM_EMACS_TRACKPOPUPMENU,
1923 (WPARAM)menu, (LPARAM)&pos);
1925 /* Clean up extraneous mouse events which might have been generated
1926 during the call. */
1927 discard_mouse_events ();
1929 /* Free the widget_value objects we used to specify the contents. */
1930 free_menubar_widget_value_tree (first_wv);
1932 DestroyMenu (menu);
1934 /* Free the owner-drawn and help-echo menu strings. */
1935 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1936 f->output_data.w32->menubar_active = 0;
1938 /* Find the selected item, and its pane, to return
1939 the proper value. */
1940 if (menu_item_selection != 0)
1942 Lisp_Object prefix, entry;
1944 prefix = entry = Qnil;
1945 i = 0;
1946 while (i < menu_items_used)
1948 if (EQ (AREF (menu_items, i), Qnil))
1950 subprefix_stack[submenu_depth++] = prefix;
1951 prefix = entry;
1952 i++;
1954 else if (EQ (AREF (menu_items, i), Qlambda))
1956 prefix = subprefix_stack[--submenu_depth];
1957 i++;
1959 else if (EQ (AREF (menu_items, i), Qt))
1961 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1962 i += MENU_ITEMS_PANE_LENGTH;
1964 /* Ignore a nil in the item list.
1965 It's meaningful only for dialog boxes. */
1966 else if (EQ (AREF (menu_items, i), Qquote))
1967 i += 1;
1968 else
1970 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1971 if (menu_item_selection == i)
1973 if (keymaps != 0)
1975 int j;
1977 entry = Fcons (entry, Qnil);
1978 if (!NILP (prefix))
1979 entry = Fcons (prefix, entry);
1980 for (j = submenu_depth - 1; j >= 0; j--)
1981 if (!NILP (subprefix_stack[j]))
1982 entry = Fcons (subprefix_stack[j], entry);
1984 return entry;
1986 i += MENU_ITEMS_ITEM_LENGTH;
1990 else if (!for_click)
1991 /* Make "Cancel" equivalent to C-g. */
1992 Fsignal (Qquit, Qnil);
1994 return Qnil;
1998 #ifdef HAVE_DIALOGS
1999 static char * button_names [] = {
2000 "button1", "button2", "button3", "button4", "button5",
2001 "button6", "button7", "button8", "button9", "button10" };
2003 static Lisp_Object
2004 w32_dialog_show (f, keymaps, title, header, error)
2005 FRAME_PTR f;
2006 int keymaps;
2007 Lisp_Object title, header;
2008 char **error;
2010 int i, nb_buttons=0;
2011 char dialog_name[6];
2012 int menu_item_selection;
2014 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2016 /* Number of elements seen so far, before boundary. */
2017 int left_count = 0;
2018 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2019 int boundary_seen = 0;
2021 *error = NULL;
2023 if (menu_items_n_panes > 1)
2025 *error = "Multiple panes in dialog box";
2026 return Qnil;
2029 /* Create a tree of widget_value objects
2030 representing the text label and buttons. */
2032 Lisp_Object pane_name, prefix;
2033 char *pane_string;
2034 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2035 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2036 pane_string = (NILP (pane_name)
2037 ? "" : (char *) SDATA (pane_name));
2038 prev_wv = xmalloc_widget_value ();
2039 prev_wv->value = pane_string;
2040 if (keymaps && !NILP (prefix))
2041 prev_wv->name++;
2042 prev_wv->enabled = 1;
2043 prev_wv->name = "message";
2044 prev_wv->help = Qnil;
2045 first_wv = prev_wv;
2047 /* Loop over all panes and items, filling in the tree. */
2048 i = MENU_ITEMS_PANE_LENGTH;
2049 while (i < menu_items_used)
2052 /* Create a new item within current pane. */
2053 Lisp_Object item_name, enable, descrip, help;
2055 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2056 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2057 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2058 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2060 if (NILP (item_name))
2062 free_menubar_widget_value_tree (first_wv);
2063 *error = "Submenu in dialog items";
2064 return Qnil;
2066 if (EQ (item_name, Qquote))
2068 /* This is the boundary between left-side elts
2069 and right-side elts. Stop incrementing right_count. */
2070 boundary_seen = 1;
2071 i++;
2072 continue;
2074 if (nb_buttons >= 9)
2076 free_menubar_widget_value_tree (first_wv);
2077 *error = "Too many dialog items";
2078 return Qnil;
2081 wv = xmalloc_widget_value ();
2082 prev_wv->next = wv;
2083 wv->name = (char *) button_names[nb_buttons];
2084 if (!NILP (descrip))
2085 wv->key = (char *) SDATA (descrip);
2086 wv->value = (char *) SDATA (item_name);
2087 wv->call_data = (void *) &AREF (menu_items, i);
2088 wv->enabled = !NILP (enable);
2089 wv->help = Qnil;
2090 prev_wv = wv;
2092 if (! boundary_seen)
2093 left_count++;
2095 nb_buttons++;
2096 i += MENU_ITEMS_ITEM_LENGTH;
2099 /* If the boundary was not specified,
2100 by default put half on the left and half on the right. */
2101 if (! boundary_seen)
2102 left_count = nb_buttons - nb_buttons / 2;
2104 wv = xmalloc_widget_value ();
2105 wv->name = dialog_name;
2106 wv->help = Qnil;
2108 /* Frame title: 'Q' = Question, 'I' = Information.
2109 Can also have 'E' = Error if, one day, we want
2110 a popup for errors. */
2111 if (NILP(header))
2112 dialog_name[0] = 'Q';
2113 else
2114 dialog_name[0] = 'I';
2116 /* Dialog boxes use a really stupid name encoding
2117 which specifies how many buttons to use
2118 and how many buttons are on the right. */
2119 dialog_name[1] = '0' + nb_buttons;
2120 dialog_name[2] = 'B';
2121 dialog_name[3] = 'R';
2122 /* Number of buttons to put on the right. */
2123 dialog_name[4] = '0' + nb_buttons - left_count;
2124 dialog_name[5] = 0;
2125 wv->contents = first_wv;
2126 first_wv = wv;
2129 /* Actually create the dialog. */
2130 dialog_id = widget_id_tick++;
2131 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2132 f->output_data.w32->widget, 1, 0,
2133 dialog_selection_callback, 0);
2134 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2136 /* Free the widget_value objects we used to specify the contents. */
2137 free_menubar_widget_value_tree (first_wv);
2139 /* No selection has been chosen yet. */
2140 menu_item_selection = 0;
2142 /* Display the menu. */
2143 lw_pop_up_all_widgets (dialog_id);
2145 /* Process events that apply to the menu. */
2146 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2148 lw_destroy_all_widgets (dialog_id);
2150 /* Find the selected item, and its pane, to return
2151 the proper value. */
2152 if (menu_item_selection != 0)
2154 Lisp_Object prefix;
2156 prefix = Qnil;
2157 i = 0;
2158 while (i < menu_items_used)
2160 Lisp_Object entry;
2162 if (EQ (AREF (menu_items, i), Qt))
2164 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2165 i += MENU_ITEMS_PANE_LENGTH;
2167 else
2169 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2170 if (menu_item_selection == i)
2172 if (keymaps != 0)
2174 entry = Fcons (entry, Qnil);
2175 if (!NILP (prefix))
2176 entry = Fcons (prefix, entry);
2178 return entry;
2180 i += MENU_ITEMS_ITEM_LENGTH;
2184 else
2185 /* Make "Cancel" equivalent to C-g. */
2186 Fsignal (Qquit, Qnil);
2188 return Qnil;
2190 #endif /* HAVE_DIALOGS */
2193 /* Is this item a separator? */
2194 static int
2195 name_is_separator (name)
2196 char *name;
2198 char *start = name;
2200 /* Check if name string consists of only dashes ('-'). */
2201 while (*name == '-') name++;
2202 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2203 or "--deep-shadow". We don't implement them yet, se we just treat
2204 them like normal separators. */
2205 return (*name == '\0' || start + 2 == name);
2209 /* Indicate boundary between left and right. */
2210 static int
2211 add_left_right_boundary (HMENU menu)
2213 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2216 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2217 static void
2218 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2220 while (len > 0)
2222 int utf16;
2223 if (*src < 0x80)
2225 *dest = (WCHAR) *src;
2226 dest++; src++; len--;
2228 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2229 else if (*src < 0xC0)
2231 src++; len--;
2233 /* 2 char UTF-8 sequence. */
2234 else if (*src < 0xE0)
2236 *dest = (WCHAR) (((*src & 0x1f) << 6)
2237 | (*(src + 1) & 0x3f));
2238 src += 2; len -= 2; dest++;
2240 else if (*src < 0xF0)
2242 *dest = (WCHAR) (((*src & 0x0f) << 12)
2243 | ((*(src + 1) & 0x3f) << 6)
2244 | (*(src + 2) & 0x3f));
2245 src += 3; len -= 3; dest++;
2247 else /* Not encodable. Insert Unicode Substitution char. */
2249 *dest = (WCHAR) 0xfffd;
2250 src++; len--; dest++;
2253 *dest = 0;
2256 static int
2257 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2259 UINT fuFlags;
2260 char *out_string, *p, *q;
2261 int return_value;
2262 size_t nlen, orig_len;
2264 if (name_is_separator (wv->name))
2266 fuFlags = MF_SEPARATOR;
2267 out_string = NULL;
2269 else
2271 if (wv->enabled)
2272 fuFlags = MF_STRING;
2273 else
2274 fuFlags = MF_STRING | MF_GRAYED;
2276 if (wv->key != NULL)
2278 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2279 strcpy (out_string, wv->name);
2280 strcat (out_string, "\t");
2281 strcat (out_string, wv->key);
2283 else
2284 out_string = wv->name;
2286 /* Quote any special characters within the menu item's text and
2287 key binding. */
2288 nlen = orig_len = strlen (out_string);
2289 if (unicode_append_menu)
2291 /* With UTF-8, & cannot be part of a multibyte character. */
2292 for (p = out_string; *p; p++)
2294 if (*p == '&')
2295 nlen++;
2298 else
2300 /* If encoded with the system codepage, use multibyte string
2301 functions in case of multibyte characters that contain '&'. */
2302 for (p = out_string; *p; p = _mbsinc (p))
2304 if (_mbsnextc (p) == '&')
2305 nlen++;
2309 if (nlen > orig_len)
2311 p = out_string;
2312 out_string = alloca (nlen + 1);
2313 q = out_string;
2314 while (*p)
2316 if (unicode_append_menu)
2318 if (*p == '&')
2319 *q++ = *p;
2320 *q++ = *p++;
2322 else
2324 if (_mbsnextc (p) == '&')
2326 _mbsncpy (q, p, 1);
2327 q = _mbsinc (q);
2329 _mbsncpy (q, p, 1);
2330 p = _mbsinc (p);
2331 q = _mbsinc (q);
2334 *q = '\0';
2337 if (item != NULL)
2338 fuFlags = MF_POPUP;
2339 else if (wv->title || wv->call_data == 0)
2341 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2342 we can't deallocate the memory otherwise. */
2343 if (get_menu_item_info)
2345 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2346 strcpy (out_string, wv->name);
2347 #ifdef MENU_DEBUG
2348 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2349 #endif
2350 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2352 else
2353 fuFlags = MF_DISABLED;
2356 /* Draw radio buttons and tickboxes. */
2357 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2358 wv->button_type == BUTTON_TYPE_RADIO))
2359 fuFlags |= MF_CHECKED;
2360 else
2361 fuFlags |= MF_UNCHECKED;
2364 if (unicode_append_menu && out_string)
2366 /* Convert out_string from UTF-8 to UTF-16-LE. */
2367 int utf8_len = strlen (out_string);
2368 WCHAR * utf16_string;
2369 if (fuFlags & MF_OWNERDRAW)
2370 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2371 else
2372 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2374 utf8to16 (out_string, utf8_len, utf16_string);
2375 return_value = unicode_append_menu (menu, fuFlags,
2376 item != NULL ? (UINT) item
2377 : (UINT) wv->call_data,
2378 utf16_string);
2379 if (!return_value)
2381 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2382 apparently does exist at least in some cases and appears to be
2383 stubbed out to do nothing. out_string is UTF-8, but since
2384 our standard menus are in English and this is only going to
2385 happen the first time a menu is used, the encoding is
2386 of minor importance compared with menus not working at all. */
2387 return_value =
2388 AppendMenu (menu, fuFlags,
2389 item != NULL ? (UINT) item: (UINT) wv->call_data,
2390 out_string);
2391 /* Don't use unicode menus in future. */
2392 unicode_append_menu = NULL;
2395 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2396 local_free (out_string);
2398 else
2400 return_value =
2401 AppendMenu (menu,
2402 fuFlags,
2403 item != NULL ? (UINT) item : (UINT) wv->call_data,
2404 out_string );
2407 /* This must be done after the menu item is created. */
2408 if (!wv->title && wv->call_data != 0)
2410 if (set_menu_item_info)
2412 MENUITEMINFO info;
2413 bzero (&info, sizeof (info));
2414 info.cbSize = sizeof (info);
2415 info.fMask = MIIM_DATA;
2417 /* Set help string for menu item. Leave it as a Lisp_Object
2418 until it is ready to be displayed, since GC can happen while
2419 menus are active. */
2420 if (!NILP (wv->help))
2421 #ifdef USE_LISP_UNION_TYPE
2422 info.dwItemData = (DWORD) (wv->help).i;
2423 #else
2424 info.dwItemData = (DWORD) (wv->help);
2425 #endif
2426 if (wv->button_type == BUTTON_TYPE_RADIO)
2428 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2429 RADIO items, but is not available on NT 3.51 and earlier. */
2430 info.fMask |= MIIM_TYPE | MIIM_STATE;
2431 info.fType = MFT_RADIOCHECK | MFT_STRING;
2432 info.dwTypeData = out_string;
2433 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2436 set_menu_item_info (menu,
2437 item != NULL ? (UINT) item : (UINT) wv->call_data,
2438 FALSE, &info);
2441 return return_value;
2444 /* Construct native Windows menu(bar) based on widget_value tree. */
2446 fill_in_menu (HMENU menu, widget_value *wv)
2448 int items_added = 0;
2450 for ( ; wv != NULL; wv = wv->next)
2452 if (wv->contents)
2454 HMENU sub_menu = CreatePopupMenu ();
2456 if (sub_menu == NULL)
2457 return 0;
2459 if (!fill_in_menu (sub_menu, wv->contents) ||
2460 !add_menu_item (menu, wv, sub_menu))
2462 DestroyMenu (sub_menu);
2463 return 0;
2466 else
2468 if (!add_menu_item (menu, wv, NULL))
2469 return 0;
2472 return 1;
2475 /* Display help string for currently pointed to menu item. Not
2476 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2477 available. */
2478 void
2479 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2481 if (get_menu_item_info)
2483 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2484 Lisp_Object frame, help;
2486 /* No help echo on owner-draw menu items, or when the keyboard is used
2487 to navigate the menus, since tooltips are distracting if they pop
2488 up elsewhere. */
2489 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2490 || !(flags & MF_MOUSESELECT))
2491 help = Qnil;
2492 else
2494 MENUITEMINFO info;
2496 bzero (&info, sizeof (info));
2497 info.cbSize = sizeof (info);
2498 info.fMask = MIIM_DATA;
2499 get_menu_item_info (menu, item, FALSE, &info);
2501 #ifdef USE_LISP_UNION_TYPE
2502 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2503 : Qnil;
2504 #else
2505 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2506 #endif
2509 /* Store the help echo in the keyboard buffer as the X toolkit
2510 version does, rather than directly showing it. This seems to
2511 solve the GC problems that were present when we based the
2512 Windows code on the non-toolkit version. */
2513 if (f)
2515 XSETFRAME (frame, f);
2516 kbd_buffer_store_help_event (frame, help);
2518 else
2519 /* X version has a loop through frames here, which doesn't
2520 appear to do anything, unless it has some side effect. */
2521 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2525 /* Free memory used by owner-drawn strings. */
2526 static void
2527 w32_free_submenu_strings (menu)
2528 HMENU menu;
2530 int i, num = GetMenuItemCount (menu);
2531 for (i = 0; i < num; i++)
2533 MENUITEMINFO info;
2534 bzero (&info, sizeof (info));
2535 info.cbSize = sizeof (info);
2536 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2538 get_menu_item_info (menu, i, TRUE, &info);
2540 /* Owner-drawn names are held in dwItemData. */
2541 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2543 #ifdef MENU_DEBUG
2544 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2545 #endif
2546 local_free (info.dwItemData);
2549 /* Recurse down submenus. */
2550 if (info.hSubMenu)
2551 w32_free_submenu_strings (info.hSubMenu);
2555 void
2556 w32_free_menu_strings (hwnd)
2557 HWND hwnd;
2559 HMENU menu = current_popup_menu;
2561 if (get_menu_item_info)
2563 /* If there is no popup menu active, free the strings from the frame's
2564 menubar. */
2565 if (!menu)
2566 menu = GetMenu (hwnd);
2568 if (menu)
2569 w32_free_submenu_strings (menu);
2572 current_popup_menu = NULL;
2575 #endif /* HAVE_MENUS */
2577 /* The following is used by delayed window autoselection. */
2579 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2580 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2583 #ifdef HAVE_MENUS
2584 FRAME_PTR f;
2585 f = SELECTED_FRAME ();
2586 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2587 #else
2588 return Qnil;
2589 #endif /* HAVE_MENUS */
2592 void syms_of_w32menu ()
2594 globals_of_w32menu ();
2595 staticpro (&menu_items);
2596 menu_items = Qnil;
2598 current_popup_menu = NULL;
2600 Qdebug_on_next_call = intern ("debug-on-next-call");
2601 staticpro (&Qdebug_on_next_call);
2603 defsubr (&Sx_popup_menu);
2604 defsubr (&Smenu_or_popup_active_p);
2605 #ifdef HAVE_MENUS
2606 defsubr (&Sx_popup_dialog);
2607 #endif
2611 globals_of_w32menu is used to initialize those global variables that
2612 must always be initialized on startup even when the global variable
2613 initialized is non zero (see the function main in emacs.c).
2614 globals_of_w32menu is called from syms_of_w32menu when the global
2615 variable initialized is 0 and directly from main when initialized
2616 is non zero.
2618 void globals_of_w32menu ()
2620 /* See if Get/SetMenuItemInfo functions are available. */
2621 HMODULE user32 = GetModuleHandle ("user32.dll");
2622 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2623 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2624 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2627 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2628 (do not change this comment) */