Merge from emacs--devo--0
[emacs.git] / src / w32menu.c
blobb1cc04cb10bb2f3d45c1d60cfcc58dfb6f1702eb
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2001, 2002,
3 2003, 2004, 2005, 2006, 2007, 2008
4 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
23 #include <config.h>
25 #include <signal.h>
26 #include <stdio.h>
27 #include <mbstring.h>
29 #include "lisp.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "termhooks.h"
34 #include "window.h"
35 #include "blockinput.h"
36 #include "buffer.h"
37 #include "charset.h"
38 #include "character.h"
39 #include "coding.h"
41 /* This may include sys/types.h, and that somehow loses
42 if this is not done before the other system files. */
43 #include "w32term.h"
45 /* Load sys/types.h if not already loaded.
46 In some systems loading it twice is suicidal. */
47 #ifndef makedev
48 #include <sys/types.h>
49 #endif
51 #include "dispextern.h"
53 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
55 /******************************************************************/
56 /* Definitions copied from lwlib.h */
58 typedef void * XtPointer;
59 typedef char Boolean;
61 enum button_type
63 BUTTON_TYPE_NONE,
64 BUTTON_TYPE_TOGGLE,
65 BUTTON_TYPE_RADIO
68 /* This structure is based on the one in ../lwlib/lwlib.h, modified
69 for Windows. */
70 typedef struct _widget_value
72 /* name of widget */
73 Lisp_Object lname;
74 char* name;
75 /* value (meaning depend on widget type) */
76 char* value;
77 /* keyboard equivalent. no implications for XtTranslations */
78 Lisp_Object lkey;
79 char* key;
80 /* Help string or nil if none.
81 GC finds this string through the frame's menu_bar_vector
82 or through menu_items. */
83 Lisp_Object help;
84 /* true if enabled */
85 Boolean enabled;
86 /* true if selected */
87 Boolean selected;
88 /* The type of a button. */
89 enum button_type button_type;
90 /* true if menu title */
91 Boolean title;
92 #if 0
93 /* true if was edited (maintained by get_value) */
94 Boolean edited;
95 /* true if has changed (maintained by lw library) */
96 change_type change;
97 /* true if this widget itself has changed,
98 but not counting the other widgets found in the `next' field. */
99 change_type this_one_change;
100 #endif
101 /* Contents of the sub-widgets, also selected slot for checkbox */
102 struct _widget_value* contents;
103 /* data passed to callback */
104 XtPointer call_data;
105 /* next one in the list */
106 struct _widget_value* next;
107 #if 0
108 /* slot for the toolkit dependent part. Always initialize to NULL. */
109 void* toolkit_data;
110 /* tell us if we should free the toolkit data slot when freeing the
111 widget_value itself. */
112 Boolean free_toolkit_data;
114 /* we resource the widget_value structures; this points to the next
115 one on the free list if this one has been deallocated.
117 struct _widget_value *free_list;
118 #endif
119 } widget_value;
121 /* Local memory management */
122 #define local_heap (GetProcessHeap ())
123 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
124 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
126 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
127 #define free_widget_value(wv) (local_free ((wv)))
129 /******************************************************************/
131 #ifndef TRUE
132 #define TRUE 1
133 #define FALSE 0
134 #endif /* no TRUE */
136 HMENU current_popup_menu;
138 void syms_of_w32menu ();
139 void globals_of_w32menu ();
141 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
142 IN HMENU,
143 IN UINT,
144 IN BOOL,
145 IN OUT LPMENUITEMINFOA);
146 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
147 IN HMENU,
148 IN UINT,
149 IN BOOL,
150 IN LPCMENUITEMINFOA);
152 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
153 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
154 AppendMenuW_Proc unicode_append_menu = NULL;
156 Lisp_Object Qdebug_on_next_call;
158 extern Lisp_Object Vmenu_updating_frame;
160 extern Lisp_Object Qmenu_bar;
162 extern Lisp_Object QCtoggle, QCradio;
164 extern Lisp_Object Voverriding_local_map;
165 extern Lisp_Object Voverriding_local_map_menu_flag;
167 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
169 extern Lisp_Object Qmenu_bar_update_hook;
171 void set_frame_menubar ();
173 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
174 Lisp_Object, Lisp_Object, Lisp_Object,
175 Lisp_Object, Lisp_Object));
176 #ifdef HAVE_DIALOGS
177 static Lisp_Object w32_dialog_show ();
178 #endif
179 static Lisp_Object w32_menu_show ();
181 static void keymap_panes ();
182 static void single_keymap_panes ();
183 static void single_menu_item ();
184 static void list_of_panes ();
185 static void list_of_items ();
186 void w32_free_menu_strings (HWND);
188 /* This holds a Lisp vector that holds the results of decoding
189 the keymaps or alist-of-alists that specify a menu.
191 It describes the panes and items within the panes.
193 Each pane is described by 3 elements in the vector:
194 t, the pane name, the pane's prefix key.
195 Then follow the pane's items, with 5 elements per item:
196 the item string, the enable flag, the item's value,
197 the definition, and the equivalent keyboard key's description string.
199 In some cases, multiple levels of menus may be described.
200 A single vector slot containing nil indicates the start of a submenu.
201 A single vector slot containing lambda indicates the end of a submenu.
202 The submenu follows a menu item which is the way to reach the submenu.
204 A single vector slot containing quote indicates that the
205 following items should appear on the right of a dialog box.
207 Using a Lisp vector to hold this information while we decode it
208 takes care of protecting all the data from GC. */
210 #define MENU_ITEMS_PANE_NAME 1
211 #define MENU_ITEMS_PANE_PREFIX 2
212 #define MENU_ITEMS_PANE_LENGTH 3
214 enum menu_item_idx
216 MENU_ITEMS_ITEM_NAME = 0,
217 MENU_ITEMS_ITEM_ENABLE,
218 MENU_ITEMS_ITEM_VALUE,
219 MENU_ITEMS_ITEM_EQUIV_KEY,
220 MENU_ITEMS_ITEM_DEFINITION,
221 MENU_ITEMS_ITEM_TYPE,
222 MENU_ITEMS_ITEM_SELECTED,
223 MENU_ITEMS_ITEM_HELP,
224 MENU_ITEMS_ITEM_LENGTH
227 static Lisp_Object menu_items;
229 /* Number of slots currently allocated in menu_items. */
230 static int menu_items_allocated;
232 /* This is the index in menu_items of the first empty slot. */
233 static int menu_items_used;
235 /* The number of panes currently recorded in menu_items,
236 excluding those within submenus. */
237 static int menu_items_n_panes;
239 /* Current depth within submenus. */
240 static int menu_items_submenu_depth;
242 static int next_menubar_widget_id;
244 /* This is set nonzero after the user activates the menu bar, and set
245 to zero again after the menu bars are redisplayed by prepare_menu_bar.
246 While it is nonzero, all calls to set_frame_menubar go deep.
248 I don't understand why this is needed, but it does seem to be
249 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
251 int pending_menu_activation;
254 /* Return the frame whose ->output_data.w32->menubar_widget equals
255 ID, or 0 if none. */
257 static struct frame *
258 menubar_id_to_frame (id)
259 HMENU id;
261 Lisp_Object tail, frame;
262 FRAME_PTR f;
264 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
266 frame = XCAR (tail);
267 if (!FRAMEP (frame))
268 continue;
269 f = XFRAME (frame);
270 if (!FRAME_WINDOW_P (f))
271 continue;
272 if (f->output_data.w32->menubar_widget == id)
273 return f;
275 return 0;
278 /* Initialize the menu_items structure if we haven't already done so.
279 Also mark it as currently empty. */
281 static void
282 init_menu_items ()
284 if (NILP (menu_items))
286 menu_items_allocated = 60;
287 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
290 menu_items_used = 0;
291 menu_items_n_panes = 0;
292 menu_items_submenu_depth = 0;
295 /* Call at the end of generating the data in menu_items.
296 This fills in the number of items in the last pane. */
298 static void
299 finish_menu_items ()
303 /* Call when finished using the data for the current menu
304 in menu_items. */
306 static void
307 discard_menu_items ()
309 /* Free the structure if it is especially large.
310 Otherwise, hold on to it, to save time. */
311 if (menu_items_allocated > 200)
313 menu_items = Qnil;
314 menu_items_allocated = 0;
318 /* Make the menu_items vector twice as large. */
320 static void
321 grow_menu_items ()
323 menu_items_allocated *= 2;
324 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
327 /* Begin a submenu. */
329 static void
330 push_submenu_start ()
332 if (menu_items_used + 1 > menu_items_allocated)
333 grow_menu_items ();
335 ASET (menu_items, menu_items_used++, Qnil);
336 menu_items_submenu_depth++;
339 /* End a submenu. */
341 static void
342 push_submenu_end ()
344 if (menu_items_used + 1 > menu_items_allocated)
345 grow_menu_items ();
347 ASET (menu_items, menu_items_used++, Qlambda);
348 menu_items_submenu_depth--;
351 /* Indicate boundary between left and right. */
353 static void
354 push_left_right_boundary ()
356 if (menu_items_used + 1 > menu_items_allocated)
357 grow_menu_items ();
359 ASET (menu_items, menu_items_used++, Qquote);
362 /* Start a new menu pane in menu_items.
363 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
365 static void
366 push_menu_pane (name, prefix_vec)
367 Lisp_Object name, prefix_vec;
369 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
370 grow_menu_items ();
372 if (menu_items_submenu_depth == 0)
373 menu_items_n_panes++;
374 ASET (menu_items, menu_items_used++, Qt);
375 ASET (menu_items, menu_items_used++, name);
376 ASET (menu_items, menu_items_used++, prefix_vec);
379 /* Push one menu item into the current pane. NAME is the string to
380 display. ENABLE if non-nil means this item can be selected. KEY
381 is the key generated by choosing this item, or nil if this item
382 doesn't really have a definition. DEF is the definition of this
383 item. EQUIV is the textual description of the keyboard equivalent
384 for this item (or nil if none). TYPE is the type of this menu
385 item, one of nil, `toggle' or `radio'. */
387 static void
388 push_menu_item (name, enable, key, def, equiv, type, selected, help)
389 Lisp_Object name, enable, key, def, equiv, type, selected, help;
391 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
392 grow_menu_items ();
394 ASET (menu_items, menu_items_used++, name);
395 ASET (menu_items, menu_items_used++, enable);
396 ASET (menu_items, menu_items_used++, key);
397 ASET (menu_items, menu_items_used++, equiv);
398 ASET (menu_items, menu_items_used++, def);
399 ASET (menu_items, menu_items_used++, type);
400 ASET (menu_items, menu_items_used++, selected);
401 ASET (menu_items, menu_items_used++, help);
404 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
405 and generate menu panes for them in menu_items.
406 If NOTREAL is nonzero,
407 don't bother really computing whether an item is enabled. */
409 static void
410 keymap_panes (keymaps, nmaps, notreal)
411 Lisp_Object *keymaps;
412 int nmaps;
413 int notreal;
415 int mapno;
417 init_menu_items ();
419 /* Loop over the given keymaps, making a pane for each map.
420 But don't make a pane that is empty--ignore that map instead.
421 P is the number of panes we have made so far. */
422 for (mapno = 0; mapno < nmaps; mapno++)
423 single_keymap_panes (keymaps[mapno],
424 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
426 finish_menu_items ();
429 /* This is a recursive subroutine of keymap_panes.
430 It handles one keymap, KEYMAP.
431 The other arguments are passed along
432 or point to local variables of the previous function.
433 If NOTREAL is nonzero, only check for equivalent key bindings, don't
434 evaluate expressions in menu items and don't make any menu.
436 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
438 static void
439 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
440 Lisp_Object keymap;
441 Lisp_Object pane_name;
442 Lisp_Object prefix;
443 int notreal;
444 int maxdepth;
446 Lisp_Object pending_maps = Qnil;
447 Lisp_Object tail, item;
448 struct gcpro gcpro1, gcpro2;
450 if (maxdepth <= 0)
451 return;
453 push_menu_pane (pane_name, prefix);
455 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
457 GCPRO2 (keymap, pending_maps);
458 /* Look at each key binding, and if it is a menu item add it
459 to this menu. */
460 item = XCAR (tail);
461 if (CONSP (item))
462 single_menu_item (XCAR (item), XCDR (item),
463 &pending_maps, notreal, maxdepth);
464 else if (VECTORP (item))
466 /* Loop over the char values represented in the vector. */
467 int len = ASIZE (item);
468 int c;
469 for (c = 0; c < len; c++)
471 Lisp_Object character;
472 XSETFASTINT (character, c);
473 single_menu_item (character, AREF (item, c),
474 &pending_maps, notreal, maxdepth);
477 UNGCPRO;
480 /* Process now any submenus which want to be panes at this level. */
481 while (!NILP (pending_maps))
483 Lisp_Object elt, eltcdr, string;
484 elt = Fcar (pending_maps);
485 eltcdr = XCDR (elt);
486 string = XCAR (eltcdr);
487 /* We no longer discard the @ from the beginning of the string here.
488 Instead, we do this in w32_menu_show. */
489 single_keymap_panes (Fcar (elt), string,
490 XCDR (eltcdr), notreal, maxdepth - 1);
491 pending_maps = Fcdr (pending_maps);
495 /* This is a subroutine of single_keymap_panes that handles one
496 keymap entry.
497 KEY is a key in a keymap and ITEM is its binding.
498 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
499 separate panes.
500 If NOTREAL is nonzero, only check for equivalent key bindings, don't
501 evaluate expressions in menu items and don't make any menu.
502 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
504 static void
505 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
506 Lisp_Object key, item;
507 Lisp_Object *pending_maps_ptr;
508 int maxdepth, notreal;
510 Lisp_Object map, item_string, enabled;
511 struct gcpro gcpro1, gcpro2;
512 int res;
514 /* Parse the menu item and leave the result in item_properties. */
515 GCPRO2 (key, item);
516 res = parse_menu_item (item, notreal, 0);
517 UNGCPRO;
518 if (!res)
519 return; /* Not a menu item. */
521 map = AREF (item_properties, ITEM_PROPERTY_MAP);
523 if (notreal)
525 /* We don't want to make a menu, just traverse the keymaps to
526 precompute equivalent key bindings. */
527 if (!NILP (map))
528 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
529 return;
532 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
533 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
535 if (!NILP (map) && SREF (item_string, 0) == '@')
537 if (!NILP (enabled))
538 /* An enabled separate pane. Remember this to handle it later. */
539 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
540 *pending_maps_ptr);
541 return;
544 push_menu_item (item_string, enabled, key,
545 AREF (item_properties, ITEM_PROPERTY_DEF),
546 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
547 AREF (item_properties, ITEM_PROPERTY_TYPE),
548 AREF (item_properties, ITEM_PROPERTY_SELECTED),
549 AREF (item_properties, ITEM_PROPERTY_HELP));
551 /* Display a submenu using the toolkit. */
552 if (! (NILP (map) || NILP (enabled)))
554 push_submenu_start ();
555 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
556 push_submenu_end ();
560 /* Push all the panes and items of a menu described by the
561 alist-of-alists MENU.
562 This handles old-fashioned calls to x-popup-menu. */
564 static void
565 list_of_panes (menu)
566 Lisp_Object menu;
568 Lisp_Object tail;
570 init_menu_items ();
572 for (tail = menu; CONSP (tail); tail = XCDR (tail))
574 Lisp_Object elt, pane_name, pane_data;
575 elt = XCAR (tail);
576 pane_name = Fcar (elt);
577 CHECK_STRING (pane_name);
578 push_menu_pane (pane_name, Qnil);
579 pane_data = Fcdr (elt);
580 CHECK_CONS (pane_data);
581 list_of_items (pane_data);
584 finish_menu_items ();
587 /* Push the items in a single pane defined by the alist PANE. */
589 static void
590 list_of_items (pane)
591 Lisp_Object pane;
593 Lisp_Object tail, item, item1;
595 for (tail = pane; CONSP (tail); tail = XCDR (tail))
597 item = XCAR (tail);
598 if (STRINGP (item))
599 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
600 else if (NILP (item))
601 push_left_right_boundary ();
602 else
604 CHECK_CONS (item);
605 item1 = Fcar (item);
606 CHECK_STRING (item1);
607 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
612 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
613 doc: /* Pop up a deck-of-cards menu and return user's selection.
614 POSITION is a position specification. This is either a mouse button
615 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
616 are positions in pixels from the top left corner of WINDOW's frame
617 \(WINDOW may be a frame object instead of a window). This controls the
618 position of the center of the first line in the first pane of the
619 menu, not the top left of the menu as a whole. If POSITION is t, it
620 means to use the current mouse position.
622 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
623 The menu items come from key bindings that have a menu string as well as
624 a definition; actually, the \"definition\" in such a key binding looks like
625 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
626 the keymap as a top-level element.
628 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
629 Otherwise, REAL-DEFINITION should be a valid key binding definition.
631 You can also use a list of keymaps as MENU. Then each keymap makes a
632 separate pane. When MENU is a keymap or a list of keymaps, the return
633 value is a list of events.
635 Alternatively, you can specify a menu of multiple panes with a list of
636 the form (TITLE PANE1 PANE2...), where each pane is a list of
637 form (TITLE ITEM1 ITEM2...).
638 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
639 appear as an item--that makes a nonselectable line in the menu.
640 With this form of menu, the return value is VALUE from the chosen item.
642 If POSITION is nil, don't display the menu at all, just precalculate the
643 cached information about equivalent key sequences. */)
644 (position, menu)
645 Lisp_Object position, menu;
647 Lisp_Object keymap, tem;
648 int xpos = 0, ypos = 0;
649 Lisp_Object title;
650 char *error_name;
651 Lisp_Object selection;
652 FRAME_PTR f = NULL;
653 Lisp_Object x, y, window;
654 int keymaps = 0;
655 int for_click = 0;
656 struct gcpro gcpro1;
658 #ifdef HAVE_MENUS
659 if (! NILP (position))
661 check_w32 ();
663 /* Decode the first argument: find the window and the coordinates. */
664 if (EQ (position, Qt)
665 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
666 || EQ (XCAR (position), Qtool_bar))))
668 /* Use the mouse's current position. */
669 FRAME_PTR new_f = SELECTED_FRAME ();
670 Lisp_Object bar_window;
671 enum scroll_bar_part part;
672 unsigned long time;
674 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
675 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
676 &part, &x, &y, &time);
677 if (new_f != 0)
678 XSETFRAME (window, new_f);
679 else
681 window = selected_window;
682 XSETFASTINT (x, 0);
683 XSETFASTINT (y, 0);
686 else
688 tem = Fcar (position);
689 if (CONSP (tem))
691 window = Fcar (Fcdr (position));
692 x = Fcar (tem);
693 y = Fcar (Fcdr (tem));
695 else
697 for_click = 1;
698 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
699 window = Fcar (tem); /* POSN_WINDOW (tem) */
700 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
701 x = Fcar (tem);
702 y = Fcdr (tem);
706 CHECK_NUMBER (x);
707 CHECK_NUMBER (y);
709 /* Decode where to put the menu. */
711 if (FRAMEP (window))
713 f = XFRAME (window);
714 xpos = 0;
715 ypos = 0;
717 else if (WINDOWP (window))
719 CHECK_LIVE_WINDOW (window);
720 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
722 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
723 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
725 else
726 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
727 but I don't want to make one now. */
728 CHECK_WINDOW (window);
730 xpos += XINT (x);
731 ypos += XINT (y);
733 XSETFRAME (Vmenu_updating_frame, f);
735 else
736 Vmenu_updating_frame = Qnil;
737 #endif /* HAVE_MENUS */
739 title = Qnil;
740 GCPRO1 (title);
742 /* Decode the menu items from what was specified. */
744 keymap = get_keymap (menu, 0, 0);
745 if (CONSP (keymap))
747 /* We were given a keymap. Extract menu info from the keymap. */
748 Lisp_Object prompt;
750 /* Extract the detailed info to make one pane. */
751 keymap_panes (&menu, 1, NILP (position));
753 /* Search for a string appearing directly as an element of the keymap.
754 That string is the title of the menu. */
755 prompt = Fkeymap_prompt (keymap);
756 if (NILP (title) && !NILP (prompt))
757 title = prompt;
759 /* Make that be the pane title of the first pane. */
760 if (!NILP (prompt) && menu_items_n_panes >= 0)
761 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
763 keymaps = 1;
765 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
767 /* We were given a list of keymaps. */
768 int nmaps = XFASTINT (Flength (menu));
769 Lisp_Object *maps
770 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
771 int i;
773 title = Qnil;
775 /* The first keymap that has a prompt string
776 supplies the menu title. */
777 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
779 Lisp_Object prompt;
781 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
783 prompt = Fkeymap_prompt (keymap);
784 if (NILP (title) && !NILP (prompt))
785 title = prompt;
788 /* Extract the detailed info to make one pane. */
789 keymap_panes (maps, nmaps, NILP (position));
791 /* Make the title be the pane title of the first pane. */
792 if (!NILP (title) && menu_items_n_panes >= 0)
793 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
795 keymaps = 1;
797 else
799 /* We were given an old-fashioned menu. */
800 title = Fcar (menu);
801 CHECK_STRING (title);
803 list_of_panes (Fcdr (menu));
805 keymaps = 0;
808 if (NILP (position))
810 discard_menu_items ();
811 UNGCPRO;
812 return Qnil;
815 #ifdef HAVE_MENUS
816 /* If resources from a previous popup menu still exist, does nothing
817 until the `menu_free_timer' has freed them (see w32fns.c). This
818 can occur if you press ESC or click outside a menu without selecting
819 a menu item.
821 if (current_popup_menu)
823 discard_menu_items ();
824 UNGCPRO;
825 return Qnil;
828 /* Display them in a menu. */
829 BLOCK_INPUT;
831 selection = w32_menu_show (f, xpos, ypos, for_click,
832 keymaps, title, &error_name);
833 UNBLOCK_INPUT;
835 discard_menu_items ();
837 #endif /* HAVE_MENUS */
839 UNGCPRO;
841 if (error_name) error (error_name);
842 return selection;
845 #ifdef HAVE_MENUS
847 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
848 doc: /* Pop up a dialog box and return user's selection.
849 POSITION specifies which frame to use.
850 This is normally a mouse button event or a window or frame.
851 If POSITION is t, it means to use the frame the mouse is on.
852 The dialog box appears in the middle of the specified frame.
854 CONTENTS specifies the alternatives to display in the dialog box.
855 It is a list of the form (TITLE ITEM1 ITEM2...).
856 Each ITEM is a cons cell (STRING . VALUE).
857 The return value is VALUE from the chosen item.
859 An ITEM may also be just a string--that makes a nonselectable item.
860 An ITEM may also be nil--that means to put all preceding items
861 on the left of the dialog box and all following items on the right.
862 \(By default, approximately half appear on each side.)
864 If HEADER is non-nil, the frame title for the box is "Information",
865 otherwise it is "Question". */)
866 (position, contents, header)
867 Lisp_Object position, contents, header;
869 FRAME_PTR f = NULL;
870 Lisp_Object window;
872 check_w32 ();
874 /* Decode the first argument: find the window or frame to use. */
875 if (EQ (position, Qt)
876 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
877 || EQ (XCAR (position), Qtool_bar))))
879 #if 0 /* Using the frame the mouse is on may not be right. */
880 /* Use the mouse's current position. */
881 FRAME_PTR new_f = SELECTED_FRAME ();
882 Lisp_Object bar_window;
883 enum scroll_bar_part part;
884 unsigned long time;
885 Lisp_Object x, y;
887 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
889 if (new_f != 0)
890 XSETFRAME (window, new_f);
891 else
892 window = selected_window;
893 #endif
894 window = selected_window;
896 else if (CONSP (position))
898 Lisp_Object tem;
899 tem = Fcar (position);
900 if (CONSP (tem))
901 window = Fcar (Fcdr (position));
902 else
904 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
905 window = Fcar (tem); /* POSN_WINDOW (tem) */
908 else if (WINDOWP (position) || FRAMEP (position))
909 window = position;
910 else
911 window = Qnil;
913 /* Decode where to put the menu. */
915 if (FRAMEP (window))
916 f = XFRAME (window);
917 else if (WINDOWP (window))
919 CHECK_LIVE_WINDOW (window);
920 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
922 else
923 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
924 but I don't want to make one now. */
925 CHECK_WINDOW (window);
927 #ifndef HAVE_DIALOGS
928 /* Display a menu with these alternatives
929 in the middle of frame F. */
931 Lisp_Object x, y, frame, newpos;
932 XSETFRAME (frame, f);
933 XSETINT (x, x_pixel_width (f) / 2);
934 XSETINT (y, x_pixel_height (f) / 2);
935 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
937 return Fx_popup_menu (newpos,
938 Fcons (Fcar (contents), Fcons (contents, Qnil)));
940 #else /* HAVE_DIALOGS */
942 Lisp_Object title;
943 char *error_name;
944 Lisp_Object selection;
946 /* Decode the dialog items from what was specified. */
947 title = Fcar (contents);
948 CHECK_STRING (title);
950 list_of_panes (Fcons (contents, Qnil));
952 /* Display them in a dialog box. */
953 BLOCK_INPUT;
954 selection = w32_dialog_show (f, 0, title, header, &error_name);
955 UNBLOCK_INPUT;
957 discard_menu_items ();
959 if (error_name) error (error_name);
960 return selection;
962 #endif /* HAVE_DIALOGS */
965 /* Activate the menu bar of frame F.
966 This is called from keyboard.c when it gets the
967 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
969 To activate the menu bar, we signal to the input thread that it can
970 return from the WM_INITMENU message, allowing the normal Windows
971 processing of the menus.
973 But first we recompute the menu bar contents (the whole tree).
975 This way we can safely execute Lisp code. */
977 void
978 x_activate_menubar (f)
979 FRAME_PTR f;
981 set_frame_menubar (f, 0, 1);
983 /* Lock out further menubar changes while active. */
984 f->output_data.w32->menubar_active = 1;
986 /* Signal input thread to return from WM_INITMENU. */
987 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
990 /* This callback is called from the menu bar pulldown menu
991 when the user makes a selection.
992 Figure out what the user chose
993 and put the appropriate events into the keyboard buffer. */
995 void
996 menubar_selection_callback (FRAME_PTR f, void * client_data)
998 Lisp_Object prefix, entry;
999 Lisp_Object vector;
1000 Lisp_Object *subprefix_stack;
1001 int submenu_depth = 0;
1002 int i;
1004 if (!f)
1005 return;
1006 entry = Qnil;
1007 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1008 vector = f->menu_bar_vector;
1009 prefix = Qnil;
1010 i = 0;
1011 while (i < f->menu_bar_items_used)
1013 if (EQ (AREF (vector, i), Qnil))
1015 subprefix_stack[submenu_depth++] = prefix;
1016 prefix = entry;
1017 i++;
1019 else if (EQ (AREF (vector, i), Qlambda))
1021 prefix = subprefix_stack[--submenu_depth];
1022 i++;
1024 else if (EQ (AREF (vector, i), Qt))
1026 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1027 i += MENU_ITEMS_PANE_LENGTH;
1029 else
1031 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1032 /* The EMACS_INT cast avoids a warning. There's no problem
1033 as long as pointers have enough bits to hold small integers. */
1034 if ((int) (EMACS_INT) client_data == i)
1036 int j;
1037 struct input_event buf;
1038 Lisp_Object frame;
1039 EVENT_INIT (buf);
1041 XSETFRAME (frame, f);
1042 buf.kind = MENU_BAR_EVENT;
1043 buf.frame_or_window = frame;
1044 buf.arg = frame;
1045 kbd_buffer_store_event (&buf);
1047 for (j = 0; j < submenu_depth; j++)
1048 if (!NILP (subprefix_stack[j]))
1050 buf.kind = MENU_BAR_EVENT;
1051 buf.frame_or_window = frame;
1052 buf.arg = subprefix_stack[j];
1053 kbd_buffer_store_event (&buf);
1056 if (!NILP (prefix))
1058 buf.kind = MENU_BAR_EVENT;
1059 buf.frame_or_window = frame;
1060 buf.arg = prefix;
1061 kbd_buffer_store_event (&buf);
1064 buf.kind = MENU_BAR_EVENT;
1065 buf.frame_or_window = frame;
1066 buf.arg = entry;
1067 /* Free memory used by owner-drawn and help-echo strings. */
1068 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1069 kbd_buffer_store_event (&buf);
1071 f->output_data.w32->menubar_active = 0;
1072 return;
1074 i += MENU_ITEMS_ITEM_LENGTH;
1077 /* Free memory used by owner-drawn and help-echo strings. */
1078 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1079 f->output_data.w32->menubar_active = 0;
1082 /* Allocate a widget_value, blocking input. */
1084 widget_value *
1085 xmalloc_widget_value ()
1087 widget_value *value;
1089 BLOCK_INPUT;
1090 value = malloc_widget_value ();
1091 UNBLOCK_INPUT;
1093 return value;
1096 /* This recursively calls free_widget_value on the tree of widgets.
1097 It must free all data that was malloc'ed for these widget_values.
1098 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1099 must be left alone. */
1101 void
1102 free_menubar_widget_value_tree (wv)
1103 widget_value *wv;
1105 if (! wv) return;
1107 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1109 if (wv->contents && (wv->contents != (widget_value*)1))
1111 free_menubar_widget_value_tree (wv->contents);
1112 wv->contents = (widget_value *) 0xDEADBEEF;
1114 if (wv->next)
1116 free_menubar_widget_value_tree (wv->next);
1117 wv->next = (widget_value *) 0xDEADBEEF;
1119 BLOCK_INPUT;
1120 free_widget_value (wv);
1121 UNBLOCK_INPUT;
1124 /* Set up data i menu_items for a menu bar item
1125 whose event type is ITEM_KEY (with string ITEM_NAME)
1126 and whose contents come from the list of keymaps MAPS. */
1128 static int
1129 parse_single_submenu (item_key, item_name, maps)
1130 Lisp_Object item_key, item_name, maps;
1132 Lisp_Object length;
1133 int len;
1134 Lisp_Object *mapvec;
1135 int i;
1136 int top_level_items = 0;
1138 length = Flength (maps);
1139 len = XINT (length);
1141 /* Convert the list MAPS into a vector MAPVEC. */
1142 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1143 for (i = 0; i < len; i++)
1145 mapvec[i] = Fcar (maps);
1146 maps = Fcdr (maps);
1149 /* Loop over the given keymaps, making a pane for each map.
1150 But don't make a pane that is empty--ignore that map instead. */
1151 for (i = 0; i < len; i++)
1153 if (SYMBOLP (mapvec[i])
1154 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1156 /* Here we have a command at top level in the menu bar
1157 as opposed to a submenu. */
1158 top_level_items = 1;
1159 push_menu_pane (Qnil, Qnil);
1160 push_menu_item (item_name, Qt, item_key, mapvec[i],
1161 Qnil, Qnil, Qnil, Qnil);
1163 else
1165 Lisp_Object prompt;
1166 prompt = Fkeymap_prompt (mapvec[i]);
1167 single_keymap_panes (mapvec[i],
1168 !NILP (prompt) ? prompt : item_name,
1169 item_key, 0, 10);
1173 return top_level_items;
1177 /* Create a tree of widget_value objects
1178 representing the panes and items
1179 in menu_items starting at index START, up to index END. */
1181 static widget_value *
1182 digest_single_submenu (start, end, top_level_items)
1183 int start, end, top_level_items;
1185 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1186 int i;
1187 int submenu_depth = 0;
1188 widget_value **submenu_stack;
1190 submenu_stack
1191 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1192 wv = xmalloc_widget_value ();
1193 wv->name = "menu";
1194 wv->value = 0;
1195 wv->enabled = 1;
1196 wv->button_type = BUTTON_TYPE_NONE;
1197 wv->help = Qnil;
1198 first_wv = wv;
1199 save_wv = 0;
1200 prev_wv = 0;
1202 /* Loop over all panes and items made by the preceding call
1203 to parse_single_submenu and construct a tree of widget_value objects.
1204 Ignore the panes and items used by previous calls to
1205 digest_single_submenu, even though those are also in menu_items. */
1206 i = start;
1207 while (i < end)
1209 if (EQ (AREF (menu_items, i), Qnil))
1211 submenu_stack[submenu_depth++] = save_wv;
1212 save_wv = prev_wv;
1213 prev_wv = 0;
1214 i++;
1216 else if (EQ (AREF (menu_items, i), Qlambda))
1218 prev_wv = save_wv;
1219 save_wv = submenu_stack[--submenu_depth];
1220 i++;
1222 else if (EQ (AREF (menu_items, i), Qt)
1223 && submenu_depth != 0)
1224 i += MENU_ITEMS_PANE_LENGTH;
1225 /* Ignore a nil in the item list.
1226 It's meaningful only for dialog boxes. */
1227 else if (EQ (AREF (menu_items, i), Qquote))
1228 i += 1;
1229 else if (EQ (AREF (menu_items, i), Qt))
1231 /* Create a new pane. */
1232 Lisp_Object pane_name, prefix;
1233 char *pane_string;
1235 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1236 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1238 if (STRINGP (pane_name))
1240 if (unicode_append_menu)
1241 /* Encode as UTF-8 for now. */
1242 pane_name = ENCODE_UTF_8 (pane_name);
1243 else if (STRING_MULTIBYTE (pane_name))
1244 pane_name = ENCODE_SYSTEM (pane_name);
1246 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1249 pane_string = (NILP (pane_name)
1250 ? "" : (char *) SDATA (pane_name));
1251 /* If there is just one top-level pane, put all its items directly
1252 under the top-level menu. */
1253 if (menu_items_n_panes == 1)
1254 pane_string = "";
1256 /* If the pane has a meaningful name,
1257 make the pane a top-level menu item
1258 with its items as a submenu beneath it. */
1259 if (strcmp (pane_string, ""))
1261 wv = xmalloc_widget_value ();
1262 if (save_wv)
1263 save_wv->next = wv;
1264 else
1265 first_wv->contents = wv;
1266 wv->lname = pane_name;
1267 /* Set value to 1 so update_submenu_strings can handle '@' */
1268 wv->value = (char *) 1;
1269 wv->enabled = 1;
1270 wv->button_type = BUTTON_TYPE_NONE;
1271 wv->help = Qnil;
1273 save_wv = wv;
1274 prev_wv = 0;
1275 i += MENU_ITEMS_PANE_LENGTH;
1277 else
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name, enable, descrip, def, type, selected;
1281 Lisp_Object help;
1283 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1284 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1285 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1286 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1287 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1288 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1289 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1291 if (STRINGP (item_name))
1293 if (unicode_append_menu)
1294 item_name = ENCODE_UTF_8 (item_name);
1295 else if (STRING_MULTIBYTE (item_name))
1296 item_name = ENCODE_SYSTEM (item_name);
1298 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1301 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1303 descrip = ENCODE_SYSTEM (descrip);
1304 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1307 wv = xmalloc_widget_value ();
1308 if (prev_wv)
1309 prev_wv->next = wv;
1310 else
1311 save_wv->contents = wv;
1313 wv->lname = item_name;
1314 if (!NILP (descrip))
1315 wv->lkey = descrip;
1316 wv->value = 0;
1317 /* The EMACS_INT cast avoids a warning. There's no problem
1318 as long as pointers have enough bits to hold small integers. */
1319 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1320 wv->enabled = !NILP (enable);
1322 if (NILP (type))
1323 wv->button_type = BUTTON_TYPE_NONE;
1324 else if (EQ (type, QCradio))
1325 wv->button_type = BUTTON_TYPE_RADIO;
1326 else if (EQ (type, QCtoggle))
1327 wv->button_type = BUTTON_TYPE_TOGGLE;
1328 else
1329 abort ();
1331 wv->selected = !NILP (selected);
1332 if (!STRINGP (help))
1333 help = Qnil;
1335 wv->help = help;
1337 prev_wv = wv;
1339 i += MENU_ITEMS_ITEM_LENGTH;
1343 /* If we have just one "menu item"
1344 that was originally a button, return it by itself. */
1345 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1347 wv = first_wv->contents;
1348 free_widget_value (first_wv);
1349 return wv;
1352 return first_wv;
1356 /* Walk through the widget_value tree starting at FIRST_WV and update
1357 the char * pointers from the corresponding lisp values.
1358 We do this after building the whole tree, since GC may happen while the
1359 tree is constructed, and small strings are relocated. So we must wait
1360 until no GC can happen before storing pointers into lisp values. */
1361 static void
1362 update_submenu_strings (first_wv)
1363 widget_value *first_wv;
1365 widget_value *wv;
1367 for (wv = first_wv; wv; wv = wv->next)
1369 if (wv->lname && ! NILP (wv->lname))
1371 wv->name = SDATA (wv->lname);
1373 /* Ignore the @ that means "separate pane".
1374 This is a kludge, but this isn't worth more time. */
1375 if (wv->value == (char *)1)
1377 if (wv->name[0] == '@')
1378 wv->name++;
1379 wv->value = 0;
1383 if (wv->lkey && ! NILP (wv->lkey))
1384 wv->key = SDATA (wv->lkey);
1386 if (wv->contents)
1387 update_submenu_strings (wv->contents);
1392 /* Set the contents of the menubar widgets of frame F.
1393 The argument FIRST_TIME is currently ignored;
1394 it is set the first time this is called, from initialize_frame_menubar. */
1396 void
1397 set_frame_menubar (f, first_time, deep_p)
1398 FRAME_PTR f;
1399 int first_time;
1400 int deep_p;
1402 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1403 Lisp_Object items;
1404 widget_value *wv, *first_wv, *prev_wv = 0;
1405 int i, last_i;
1406 int *submenu_start, *submenu_end;
1407 int *submenu_top_level_items, *submenu_n_panes;
1409 /* We must not change the menubar when actually in use. */
1410 if (f->output_data.w32->menubar_active)
1411 return;
1413 XSETFRAME (Vmenu_updating_frame, f);
1415 if (! menubar_widget)
1416 deep_p = 1;
1417 else if (pending_menu_activation && !deep_p)
1418 deep_p = 1;
1420 if (deep_p)
1422 /* Make a widget-value tree representing the entire menu trees. */
1424 struct buffer *prev = current_buffer;
1425 Lisp_Object buffer;
1426 int specpdl_count = SPECPDL_INDEX ();
1427 int previous_menu_items_used = f->menu_bar_items_used;
1428 Lisp_Object *previous_items
1429 = (Lisp_Object *) alloca (previous_menu_items_used
1430 * sizeof (Lisp_Object));
1432 /* If we are making a new widget, its contents are empty,
1433 do always reinitialize them. */
1434 if (! menubar_widget)
1435 previous_menu_items_used = 0;
1437 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1438 specbind (Qinhibit_quit, Qt);
1439 /* Don't let the debugger step into this code
1440 because it is not reentrant. */
1441 specbind (Qdebug_on_next_call, Qnil);
1443 record_unwind_save_match_data ();
1445 if (NILP (Voverriding_local_map_menu_flag))
1447 specbind (Qoverriding_terminal_local_map, Qnil);
1448 specbind (Qoverriding_local_map, Qnil);
1451 set_buffer_internal_1 (XBUFFER (buffer));
1453 /* Run the Lucid hook. */
1454 safe_run_hooks (Qactivate_menubar_hook);
1455 /* If it has changed current-menubar from previous value,
1456 really recompute the menubar from the value. */
1457 if (! NILP (Vlucid_menu_bar_dirty_flag))
1458 call0 (Qrecompute_lucid_menubar);
1459 safe_run_hooks (Qmenu_bar_update_hook);
1460 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1462 items = FRAME_MENU_BAR_ITEMS (f);
1464 /* Save the frame's previous menu bar contents data. */
1465 if (previous_menu_items_used)
1466 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1467 previous_menu_items_used * sizeof (Lisp_Object));
1469 /* Fill in menu_items with the current menu bar contents.
1470 This can evaluate Lisp code. */
1471 menu_items = f->menu_bar_vector;
1472 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1473 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1474 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1475 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1476 submenu_top_level_items
1477 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1478 init_menu_items ();
1479 for (i = 0; i < ASIZE (items); i += 4)
1481 Lisp_Object key, string, maps;
1483 last_i = i;
1485 key = AREF (items, i);
1486 string = AREF (items, i + 1);
1487 maps = AREF (items, i + 2);
1488 if (NILP (string))
1489 break;
1491 submenu_start[i] = menu_items_used;
1493 menu_items_n_panes = 0;
1494 submenu_top_level_items[i]
1495 = parse_single_submenu (key, string, maps);
1496 submenu_n_panes[i] = menu_items_n_panes;
1498 submenu_end[i] = menu_items_used;
1501 finish_menu_items ();
1503 /* Convert menu_items into widget_value trees
1504 to display the menu. This cannot evaluate Lisp code. */
1506 wv = xmalloc_widget_value ();
1507 wv->name = "menubar";
1508 wv->value = 0;
1509 wv->enabled = 1;
1510 wv->button_type = BUTTON_TYPE_NONE;
1511 wv->help = Qnil;
1512 first_wv = wv;
1514 for (i = 0; i < last_i; i += 4)
1516 menu_items_n_panes = submenu_n_panes[i];
1517 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1518 submenu_top_level_items[i]);
1519 if (prev_wv)
1520 prev_wv->next = wv;
1521 else
1522 first_wv->contents = wv;
1523 /* Don't set wv->name here; GC during the loop might relocate it. */
1524 wv->enabled = 1;
1525 wv->button_type = BUTTON_TYPE_NONE;
1526 prev_wv = wv;
1529 set_buffer_internal_1 (prev);
1530 unbind_to (specpdl_count, Qnil);
1532 /* If there has been no change in the Lisp-level contents
1533 of the menu bar, skip redisplaying it. Just exit. */
1535 for (i = 0; i < previous_menu_items_used; i++)
1536 if (menu_items_used == i
1537 || (!EQ (previous_items[i], AREF (menu_items, i))))
1538 break;
1539 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1541 free_menubar_widget_value_tree (first_wv);
1542 menu_items = Qnil;
1544 return;
1547 /* Now GC cannot happen during the lifetime of the widget_value,
1548 so it's safe to store data from a Lisp_String, as long as
1549 local copies are made when the actual menu is created.
1550 Windows takes care of this for normal string items, but
1551 not for owner-drawn items or additional item-info. */
1552 wv = first_wv->contents;
1553 for (i = 0; i < ASIZE (items); i += 4)
1555 Lisp_Object string;
1556 string = AREF (items, i + 1);
1557 if (NILP (string))
1558 break;
1559 wv->name = (char *) SDATA (string);
1560 update_submenu_strings (wv->contents);
1561 wv = wv->next;
1564 f->menu_bar_vector = menu_items;
1565 f->menu_bar_items_used = menu_items_used;
1566 menu_items = Qnil;
1568 else
1570 /* Make a widget-value tree containing
1571 just the top level menu bar strings. */
1573 wv = xmalloc_widget_value ();
1574 wv->name = "menubar";
1575 wv->value = 0;
1576 wv->enabled = 1;
1577 wv->button_type = BUTTON_TYPE_NONE;
1578 wv->help = Qnil;
1579 first_wv = wv;
1581 items = FRAME_MENU_BAR_ITEMS (f);
1582 for (i = 0; i < ASIZE (items); i += 4)
1584 Lisp_Object string;
1586 string = AREF (items, i + 1);
1587 if (NILP (string))
1588 break;
1590 wv = xmalloc_widget_value ();
1591 wv->name = (char *) SDATA (string);
1592 wv->value = 0;
1593 wv->enabled = 1;
1594 wv->button_type = BUTTON_TYPE_NONE;
1595 wv->help = Qnil;
1596 /* This prevents lwlib from assuming this
1597 menu item is really supposed to be empty. */
1598 /* The EMACS_INT cast avoids a warning.
1599 This value just has to be different from small integers. */
1600 wv->call_data = (void *) (EMACS_INT) (-1);
1602 if (prev_wv)
1603 prev_wv->next = wv;
1604 else
1605 first_wv->contents = wv;
1606 prev_wv = wv;
1609 /* Forget what we thought we knew about what is in the
1610 detailed contents of the menu bar menus.
1611 Changing the top level always destroys the contents. */
1612 f->menu_bar_items_used = 0;
1615 /* Create or update the menu bar widget. */
1617 BLOCK_INPUT;
1619 if (menubar_widget)
1621 /* Empty current menubar, rather than creating a fresh one. */
1622 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1625 else
1627 menubar_widget = CreateMenu ();
1629 fill_in_menu (menubar_widget, first_wv->contents);
1631 free_menubar_widget_value_tree (first_wv);
1634 HMENU old_widget = f->output_data.w32->menubar_widget;
1636 f->output_data.w32->menubar_widget = menubar_widget;
1637 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1638 /* Causes flicker when menu bar is updated
1639 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1641 /* Force the window size to be recomputed so that the frame's text
1642 area remains the same, if menubar has just been created. */
1643 if (old_widget == NULL)
1644 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1647 UNBLOCK_INPUT;
1650 /* Called from Fx_create_frame to create the initial menubar of a frame
1651 before it is mapped, so that the window is mapped with the menubar already
1652 there instead of us tacking it on later and thrashing the window after it
1653 is visible. */
1655 void
1656 initialize_frame_menubar (f)
1657 FRAME_PTR f;
1659 /* This function is called before the first chance to redisplay
1660 the frame. It has to be, so the frame will have the right size. */
1661 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1662 set_frame_menubar (f, 1, 1);
1665 /* Get rid of the menu bar of frame F, and free its storage.
1666 This is used when deleting a frame, and when turning off the menu bar. */
1668 void
1669 free_frame_menubar (f)
1670 FRAME_PTR f;
1672 BLOCK_INPUT;
1675 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1676 SetMenu (FRAME_W32_WINDOW (f), NULL);
1677 f->output_data.w32->menubar_widget = NULL;
1678 DestroyMenu (old);
1681 UNBLOCK_INPUT;
1685 /* w32_menu_show actually displays a menu using the panes and items in
1686 menu_items and returns the value selected from it; we assume input
1687 is blocked by the caller. */
1689 /* F is the frame the menu is for.
1690 X and Y are the frame-relative specified position,
1691 relative to the inside upper left corner of the frame F.
1692 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1693 KEYMAPS is 1 if this menu was specified with keymaps;
1694 in that case, we return a list containing the chosen item's value
1695 and perhaps also the pane's prefix.
1696 TITLE is the specified menu title.
1697 ERROR is a place to store an error message string in case of failure.
1698 (We return nil on failure, but the value doesn't actually matter.) */
1700 static Lisp_Object
1701 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1702 FRAME_PTR f;
1703 int x;
1704 int y;
1705 int for_click;
1706 int keymaps;
1707 Lisp_Object title;
1708 char **error;
1710 int i;
1711 int menu_item_selection;
1712 HMENU menu;
1713 POINT pos;
1714 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1715 widget_value **submenu_stack
1716 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1717 Lisp_Object *subprefix_stack
1718 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1719 int submenu_depth = 0;
1720 int first_pane;
1722 *error = NULL;
1724 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1726 *error = "Empty menu";
1727 return Qnil;
1730 /* Create a tree of widget_value objects
1731 representing the panes and their items. */
1732 wv = xmalloc_widget_value ();
1733 wv->name = "menu";
1734 wv->value = 0;
1735 wv->enabled = 1;
1736 wv->button_type = BUTTON_TYPE_NONE;
1737 wv->help = Qnil;
1738 first_wv = wv;
1739 first_pane = 1;
1741 /* Loop over all panes and items, filling in the tree. */
1742 i = 0;
1743 while (i < menu_items_used)
1745 if (EQ (AREF (menu_items, i), Qnil))
1747 submenu_stack[submenu_depth++] = save_wv;
1748 save_wv = prev_wv;
1749 prev_wv = 0;
1750 first_pane = 1;
1751 i++;
1753 else if (EQ (AREF (menu_items, i), Qlambda))
1755 prev_wv = save_wv;
1756 save_wv = submenu_stack[--submenu_depth];
1757 first_pane = 0;
1758 i++;
1760 else if (EQ (AREF (menu_items, i), Qt)
1761 && submenu_depth != 0)
1762 i += MENU_ITEMS_PANE_LENGTH;
1763 /* Ignore a nil in the item list.
1764 It's meaningful only for dialog boxes. */
1765 else if (EQ (AREF (menu_items, i), Qquote))
1766 i += 1;
1767 else if (EQ (AREF (menu_items, i), Qt))
1769 /* Create a new pane. */
1770 Lisp_Object pane_name, prefix;
1771 char *pane_string;
1772 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1773 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1775 if (STRINGP (pane_name))
1777 if (unicode_append_menu)
1778 pane_name = ENCODE_UTF_8 (pane_name);
1779 else if (STRING_MULTIBYTE (pane_name))
1780 pane_name = ENCODE_SYSTEM (pane_name);
1782 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1785 pane_string = (NILP (pane_name)
1786 ? "" : (char *) SDATA (pane_name));
1787 /* If there is just one top-level pane, put all its items directly
1788 under the top-level menu. */
1789 if (menu_items_n_panes == 1)
1790 pane_string = "";
1792 /* If the pane has a meaningful name,
1793 make the pane a top-level menu item
1794 with its items as a submenu beneath it. */
1795 if (!keymaps && strcmp (pane_string, ""))
1797 wv = xmalloc_widget_value ();
1798 if (save_wv)
1799 save_wv->next = wv;
1800 else
1801 first_wv->contents = wv;
1802 wv->name = pane_string;
1803 if (keymaps && !NILP (prefix))
1804 wv->name++;
1805 wv->value = 0;
1806 wv->enabled = 1;
1807 wv->button_type = BUTTON_TYPE_NONE;
1808 wv->help = Qnil;
1809 save_wv = wv;
1810 prev_wv = 0;
1812 else if (first_pane)
1814 save_wv = wv;
1815 prev_wv = 0;
1817 first_pane = 0;
1818 i += MENU_ITEMS_PANE_LENGTH;
1820 else
1822 /* Create a new item within current pane. */
1823 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1825 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1826 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1827 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1828 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1829 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1830 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1831 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1833 if (STRINGP (item_name))
1835 if (unicode_append_menu)
1836 item_name = ENCODE_UTF_8 (item_name);
1837 else if (STRING_MULTIBYTE (item_name))
1838 item_name = ENCODE_SYSTEM (item_name);
1840 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1843 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1845 descrip = ENCODE_SYSTEM (descrip);
1846 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1849 wv = xmalloc_widget_value ();
1850 if (prev_wv)
1851 prev_wv->next = wv;
1852 else
1853 save_wv->contents = wv;
1854 wv->name = (char *) SDATA (item_name);
1855 if (!NILP (descrip))
1856 wv->key = (char *) SDATA (descrip);
1857 wv->value = 0;
1858 /* Use the contents index as call_data, since we are
1859 restricted to 16-bits. */
1860 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1861 wv->enabled = !NILP (enable);
1863 if (NILP (type))
1864 wv->button_type = BUTTON_TYPE_NONE;
1865 else if (EQ (type, QCtoggle))
1866 wv->button_type = BUTTON_TYPE_TOGGLE;
1867 else if (EQ (type, QCradio))
1868 wv->button_type = BUTTON_TYPE_RADIO;
1869 else
1870 abort ();
1872 wv->selected = !NILP (selected);
1873 if (!STRINGP (help))
1874 help = Qnil;
1876 wv->help = help;
1878 prev_wv = wv;
1880 i += MENU_ITEMS_ITEM_LENGTH;
1884 /* Deal with the title, if it is non-nil. */
1885 if (!NILP (title))
1887 widget_value *wv_title = xmalloc_widget_value ();
1888 widget_value *wv_sep = xmalloc_widget_value ();
1890 /* Maybe replace this separator with a bitmap or owner-draw item
1891 so that it looks better. Having two separators looks odd. */
1892 wv_sep->name = "--";
1893 wv_sep->next = first_wv->contents;
1894 wv_sep->help = Qnil;
1896 if (unicode_append_menu)
1897 title = ENCODE_UTF_8 (title);
1898 else if (STRING_MULTIBYTE (title))
1899 title = ENCODE_SYSTEM (title);
1901 wv_title->name = (char *) SDATA (title);
1902 wv_title->enabled = TRUE;
1903 wv_title->title = TRUE;
1904 wv_title->button_type = BUTTON_TYPE_NONE;
1905 wv_title->help = Qnil;
1906 wv_title->next = wv_sep;
1907 first_wv->contents = wv_title;
1910 /* Actually create the menu. */
1911 current_popup_menu = menu = CreatePopupMenu ();
1912 fill_in_menu (menu, first_wv->contents);
1914 /* Adjust coordinates to be root-window-relative. */
1915 pos.x = x;
1916 pos.y = y;
1917 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1919 /* No selection has been chosen yet. */
1920 menu_item_selection = 0;
1922 /* Display the menu. */
1923 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1924 WM_EMACS_TRACKPOPUPMENU,
1925 (WPARAM)menu, (LPARAM)&pos);
1927 /* Clean up extraneous mouse events which might have been generated
1928 during the call. */
1929 discard_mouse_events ();
1931 /* Free the widget_value objects we used to specify the contents. */
1932 free_menubar_widget_value_tree (first_wv);
1934 DestroyMenu (menu);
1936 /* Free the owner-drawn and help-echo menu strings. */
1937 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1938 f->output_data.w32->menubar_active = 0;
1940 /* Find the selected item, and its pane, to return
1941 the proper value. */
1942 if (menu_item_selection != 0)
1944 Lisp_Object prefix, entry;
1946 prefix = entry = Qnil;
1947 i = 0;
1948 while (i < menu_items_used)
1950 if (EQ (AREF (menu_items, i), Qnil))
1952 subprefix_stack[submenu_depth++] = prefix;
1953 prefix = entry;
1954 i++;
1956 else if (EQ (AREF (menu_items, i), Qlambda))
1958 prefix = subprefix_stack[--submenu_depth];
1959 i++;
1961 else if (EQ (AREF (menu_items, i), Qt))
1963 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1964 i += MENU_ITEMS_PANE_LENGTH;
1966 /* Ignore a nil in the item list.
1967 It's meaningful only for dialog boxes. */
1968 else if (EQ (AREF (menu_items, i), Qquote))
1969 i += 1;
1970 else
1972 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1973 if (menu_item_selection == i)
1975 if (keymaps != 0)
1977 int j;
1979 entry = Fcons (entry, Qnil);
1980 if (!NILP (prefix))
1981 entry = Fcons (prefix, entry);
1982 for (j = submenu_depth - 1; j >= 0; j--)
1983 if (!NILP (subprefix_stack[j]))
1984 entry = Fcons (subprefix_stack[j], entry);
1986 return entry;
1988 i += MENU_ITEMS_ITEM_LENGTH;
1992 else if (!for_click)
1993 /* Make "Cancel" equivalent to C-g. */
1994 Fsignal (Qquit, Qnil);
1996 return Qnil;
2000 #ifdef HAVE_DIALOGS
2001 static char * button_names [] = {
2002 "button1", "button2", "button3", "button4", "button5",
2003 "button6", "button7", "button8", "button9", "button10" };
2005 static Lisp_Object
2006 w32_dialog_show (f, keymaps, title, header, error)
2007 FRAME_PTR f;
2008 int keymaps;
2009 Lisp_Object title, header;
2010 char **error;
2012 int i, nb_buttons=0;
2013 char dialog_name[6];
2014 int menu_item_selection;
2016 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2018 /* Number of elements seen so far, before boundary. */
2019 int left_count = 0;
2020 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2021 int boundary_seen = 0;
2023 *error = NULL;
2025 if (menu_items_n_panes > 1)
2027 *error = "Multiple panes in dialog box";
2028 return Qnil;
2031 /* Create a tree of widget_value objects
2032 representing the text label and buttons. */
2034 Lisp_Object pane_name, prefix;
2035 char *pane_string;
2036 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2037 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2038 pane_string = (NILP (pane_name)
2039 ? "" : (char *) SDATA (pane_name));
2040 prev_wv = xmalloc_widget_value ();
2041 prev_wv->value = pane_string;
2042 if (keymaps && !NILP (prefix))
2043 prev_wv->name++;
2044 prev_wv->enabled = 1;
2045 prev_wv->name = "message";
2046 prev_wv->help = Qnil;
2047 first_wv = prev_wv;
2049 /* Loop over all panes and items, filling in the tree. */
2050 i = MENU_ITEMS_PANE_LENGTH;
2051 while (i < menu_items_used)
2054 /* Create a new item within current pane. */
2055 Lisp_Object item_name, enable, descrip, help;
2057 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2058 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2059 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2060 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2062 if (NILP (item_name))
2064 free_menubar_widget_value_tree (first_wv);
2065 *error = "Submenu in dialog items";
2066 return Qnil;
2068 if (EQ (item_name, Qquote))
2070 /* This is the boundary between left-side elts
2071 and right-side elts. Stop incrementing right_count. */
2072 boundary_seen = 1;
2073 i++;
2074 continue;
2076 if (nb_buttons >= 9)
2078 free_menubar_widget_value_tree (first_wv);
2079 *error = "Too many dialog items";
2080 return Qnil;
2083 wv = xmalloc_widget_value ();
2084 prev_wv->next = wv;
2085 wv->name = (char *) button_names[nb_buttons];
2086 if (!NILP (descrip))
2087 wv->key = (char *) SDATA (descrip);
2088 wv->value = (char *) SDATA (item_name);
2089 wv->call_data = (void *) &AREF (menu_items, i);
2090 wv->enabled = !NILP (enable);
2091 wv->help = Qnil;
2092 prev_wv = wv;
2094 if (! boundary_seen)
2095 left_count++;
2097 nb_buttons++;
2098 i += MENU_ITEMS_ITEM_LENGTH;
2101 /* If the boundary was not specified,
2102 by default put half on the left and half on the right. */
2103 if (! boundary_seen)
2104 left_count = nb_buttons - nb_buttons / 2;
2106 wv = xmalloc_widget_value ();
2107 wv->name = dialog_name;
2108 wv->help = Qnil;
2110 /* Frame title: 'Q' = Question, 'I' = Information.
2111 Can also have 'E' = Error if, one day, we want
2112 a popup for errors. */
2113 if (NILP(header))
2114 dialog_name[0] = 'Q';
2115 else
2116 dialog_name[0] = 'I';
2118 /* Dialog boxes use a really stupid name encoding
2119 which specifies how many buttons to use
2120 and how many buttons are on the right. */
2121 dialog_name[1] = '0' + nb_buttons;
2122 dialog_name[2] = 'B';
2123 dialog_name[3] = 'R';
2124 /* Number of buttons to put on the right. */
2125 dialog_name[4] = '0' + nb_buttons - left_count;
2126 dialog_name[5] = 0;
2127 wv->contents = first_wv;
2128 first_wv = wv;
2131 /* Actually create the dialog. */
2132 dialog_id = widget_id_tick++;
2133 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2134 f->output_data.w32->widget, 1, 0,
2135 dialog_selection_callback, 0);
2136 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2138 /* Free the widget_value objects we used to specify the contents. */
2139 free_menubar_widget_value_tree (first_wv);
2141 /* No selection has been chosen yet. */
2142 menu_item_selection = 0;
2144 /* Display the menu. */
2145 lw_pop_up_all_widgets (dialog_id);
2147 /* Process events that apply to the menu. */
2148 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2150 lw_destroy_all_widgets (dialog_id);
2152 /* Find the selected item, and its pane, to return
2153 the proper value. */
2154 if (menu_item_selection != 0)
2156 Lisp_Object prefix;
2158 prefix = Qnil;
2159 i = 0;
2160 while (i < menu_items_used)
2162 Lisp_Object entry;
2164 if (EQ (AREF (menu_items, i), Qt))
2166 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2167 i += MENU_ITEMS_PANE_LENGTH;
2169 else
2171 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2172 if (menu_item_selection == i)
2174 if (keymaps != 0)
2176 entry = Fcons (entry, Qnil);
2177 if (!NILP (prefix))
2178 entry = Fcons (prefix, entry);
2180 return entry;
2182 i += MENU_ITEMS_ITEM_LENGTH;
2186 else
2187 /* Make "Cancel" equivalent to C-g. */
2188 Fsignal (Qquit, Qnil);
2190 return Qnil;
2192 #endif /* HAVE_DIALOGS */
2195 /* Is this item a separator? */
2196 static int
2197 name_is_separator (name)
2198 char *name;
2200 char *start = name;
2202 /* Check if name string consists of only dashes ('-'). */
2203 while (*name == '-') name++;
2204 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2205 or "--deep-shadow". We don't implement them yet, se we just treat
2206 them like normal separators. */
2207 return (*name == '\0' || start + 2 == name);
2211 /* Indicate boundary between left and right. */
2212 static int
2213 add_left_right_boundary (HMENU menu)
2215 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2218 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2219 static void
2220 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2222 while (len > 0)
2224 int utf16;
2225 if (*src < 0x80)
2227 *dest = (WCHAR) *src;
2228 dest++; src++; len--;
2230 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2231 else if (*src < 0xC0)
2233 src++; len--;
2235 /* 2 char UTF-8 sequence. */
2236 else if (*src < 0xE0)
2238 *dest = (WCHAR) (((*src & 0x1f) << 6)
2239 | (*(src + 1) & 0x3f));
2240 src += 2; len -= 2; dest++;
2242 else if (*src < 0xF0)
2244 *dest = (WCHAR) (((*src & 0x0f) << 12)
2245 | ((*(src + 1) & 0x3f) << 6)
2246 | (*(src + 2) & 0x3f));
2247 src += 3; len -= 3; dest++;
2249 else /* Not encodable. Insert Unicode Substitution char. */
2251 *dest = (WCHAR) 0xfffd;
2252 src++; len--; dest++;
2255 *dest = 0;
2258 static int
2259 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2261 UINT fuFlags;
2262 char *out_string, *p, *q;
2263 int return_value;
2264 size_t nlen, orig_len;
2266 if (name_is_separator (wv->name))
2268 fuFlags = MF_SEPARATOR;
2269 out_string = NULL;
2271 else
2273 if (wv->enabled)
2274 fuFlags = MF_STRING;
2275 else
2276 fuFlags = MF_STRING | MF_GRAYED;
2278 if (wv->key != NULL)
2280 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2281 strcpy (out_string, wv->name);
2282 strcat (out_string, "\t");
2283 strcat (out_string, wv->key);
2285 else
2286 out_string = wv->name;
2288 /* Quote any special characters within the menu item's text and
2289 key binding. */
2290 nlen = orig_len = strlen (out_string);
2291 if (unicode_append_menu)
2293 /* With UTF-8, & cannot be part of a multibyte character. */
2294 for (p = out_string; *p; p++)
2296 if (*p == '&')
2297 nlen++;
2300 else
2302 /* If encoded with the system codepage, use multibyte string
2303 functions in case of multibyte characters that contain '&'. */
2304 for (p = out_string; *p; p = _mbsinc (p))
2306 if (_mbsnextc (p) == '&')
2307 nlen++;
2311 if (nlen > orig_len)
2313 p = out_string;
2314 out_string = alloca (nlen + 1);
2315 q = out_string;
2316 while (*p)
2318 if (unicode_append_menu)
2320 if (*p == '&')
2321 *q++ = *p;
2322 *q++ = *p++;
2324 else
2326 if (_mbsnextc (p) == '&')
2328 _mbsncpy (q, p, 1);
2329 q = _mbsinc (q);
2331 _mbsncpy (q, p, 1);
2332 p = _mbsinc (p);
2333 q = _mbsinc (q);
2336 *q = '\0';
2339 if (item != NULL)
2340 fuFlags = MF_POPUP;
2341 else if (wv->title || wv->call_data == 0)
2343 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2344 we can't deallocate the memory otherwise. */
2345 if (get_menu_item_info)
2347 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2348 strcpy (out_string, wv->name);
2349 #ifdef MENU_DEBUG
2350 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2351 #endif
2352 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2354 else
2355 fuFlags = MF_DISABLED;
2358 /* Draw radio buttons and tickboxes. */
2359 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2360 wv->button_type == BUTTON_TYPE_RADIO))
2361 fuFlags |= MF_CHECKED;
2362 else
2363 fuFlags |= MF_UNCHECKED;
2366 if (unicode_append_menu && out_string)
2368 /* Convert out_string from UTF-8 to UTF-16-LE. */
2369 int utf8_len = strlen (out_string);
2370 WCHAR * utf16_string;
2371 if (fuFlags & MF_OWNERDRAW)
2372 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2373 else
2374 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2376 utf8to16 (out_string, utf8_len, utf16_string);
2377 return_value = unicode_append_menu (menu, fuFlags,
2378 item != NULL ? (UINT) item
2379 : (UINT) wv->call_data,
2380 utf16_string);
2381 if (!return_value)
2383 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2384 apparently does exist at least in some cases and appears to be
2385 stubbed out to do nothing. out_string is UTF-8, but since
2386 our standard menus are in English and this is only going to
2387 happen the first time a menu is used, the encoding is
2388 of minor importance compared with menus not working at all. */
2389 return_value =
2390 AppendMenu (menu, fuFlags,
2391 item != NULL ? (UINT) item: (UINT) wv->call_data,
2392 out_string);
2393 /* Don't use unicode menus in future. */
2394 unicode_append_menu = NULL;
2397 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2398 local_free (out_string);
2400 else
2402 return_value =
2403 AppendMenu (menu,
2404 fuFlags,
2405 item != NULL ? (UINT) item : (UINT) wv->call_data,
2406 out_string );
2409 /* This must be done after the menu item is created. */
2410 if (!wv->title && wv->call_data != 0)
2412 if (set_menu_item_info)
2414 MENUITEMINFO info;
2415 bzero (&info, sizeof (info));
2416 info.cbSize = sizeof (info);
2417 info.fMask = MIIM_DATA;
2419 /* Set help string for menu item. Leave it as a Lisp_Object
2420 until it is ready to be displayed, since GC can happen while
2421 menus are active. */
2422 if (!NILP (wv->help))
2423 #ifdef USE_LISP_UNION_TYPE
2424 info.dwItemData = (DWORD) (wv->help).i;
2425 #else
2426 info.dwItemData = (DWORD) (wv->help);
2427 #endif
2428 if (wv->button_type == BUTTON_TYPE_RADIO)
2430 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2431 RADIO items, but is not available on NT 3.51 and earlier. */
2432 info.fMask |= MIIM_TYPE | MIIM_STATE;
2433 info.fType = MFT_RADIOCHECK | MFT_STRING;
2434 info.dwTypeData = out_string;
2435 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2438 set_menu_item_info (menu,
2439 item != NULL ? (UINT) item : (UINT) wv->call_data,
2440 FALSE, &info);
2443 return return_value;
2446 /* Construct native Windows menu(bar) based on widget_value tree. */
2448 fill_in_menu (HMENU menu, widget_value *wv)
2450 int items_added = 0;
2452 for ( ; wv != NULL; wv = wv->next)
2454 if (wv->contents)
2456 HMENU sub_menu = CreatePopupMenu ();
2458 if (sub_menu == NULL)
2459 return 0;
2461 if (!fill_in_menu (sub_menu, wv->contents) ||
2462 !add_menu_item (menu, wv, sub_menu))
2464 DestroyMenu (sub_menu);
2465 return 0;
2468 else
2470 if (!add_menu_item (menu, wv, NULL))
2471 return 0;
2474 return 1;
2477 /* Display help string for currently pointed to menu item. Not
2478 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2479 available. */
2480 void
2481 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2483 if (get_menu_item_info)
2485 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2486 Lisp_Object frame, help;
2488 /* No help echo on owner-draw menu items, or when the keyboard is used
2489 to navigate the menus, since tooltips are distracting if they pop
2490 up elsewhere. */
2491 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2492 || !(flags & MF_MOUSESELECT))
2493 help = Qnil;
2494 else
2496 MENUITEMINFO info;
2498 bzero (&info, sizeof (info));
2499 info.cbSize = sizeof (info);
2500 info.fMask = MIIM_DATA;
2501 get_menu_item_info (menu, item, FALSE, &info);
2503 #ifdef USE_LISP_UNION_TYPE
2504 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2505 : Qnil;
2506 #else
2507 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2508 #endif
2511 /* Store the help echo in the keyboard buffer as the X toolkit
2512 version does, rather than directly showing it. This seems to
2513 solve the GC problems that were present when we based the
2514 Windows code on the non-toolkit version. */
2515 if (f)
2517 XSETFRAME (frame, f);
2518 kbd_buffer_store_help_event (frame, help);
2520 else
2521 /* X version has a loop through frames here, which doesn't
2522 appear to do anything, unless it has some side effect. */
2523 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2527 /* Free memory used by owner-drawn strings. */
2528 static void
2529 w32_free_submenu_strings (menu)
2530 HMENU menu;
2532 int i, num = GetMenuItemCount (menu);
2533 for (i = 0; i < num; i++)
2535 MENUITEMINFO info;
2536 bzero (&info, sizeof (info));
2537 info.cbSize = sizeof (info);
2538 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2540 get_menu_item_info (menu, i, TRUE, &info);
2542 /* Owner-drawn names are held in dwItemData. */
2543 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2545 #ifdef MENU_DEBUG
2546 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2547 #endif
2548 local_free (info.dwItemData);
2551 /* Recurse down submenus. */
2552 if (info.hSubMenu)
2553 w32_free_submenu_strings (info.hSubMenu);
2557 void
2558 w32_free_menu_strings (hwnd)
2559 HWND hwnd;
2561 HMENU menu = current_popup_menu;
2563 if (get_menu_item_info)
2565 /* If there is no popup menu active, free the strings from the frame's
2566 menubar. */
2567 if (!menu)
2568 menu = GetMenu (hwnd);
2570 if (menu)
2571 w32_free_submenu_strings (menu);
2574 current_popup_menu = NULL;
2577 #endif /* HAVE_MENUS */
2579 /* The following is used by delayed window autoselection. */
2581 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2582 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2585 #ifdef HAVE_MENUS
2586 FRAME_PTR f;
2587 f = SELECTED_FRAME ();
2588 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2589 #else
2590 return Qnil;
2591 #endif /* HAVE_MENUS */
2594 void syms_of_w32menu ()
2596 globals_of_w32menu ();
2597 staticpro (&menu_items);
2598 menu_items = Qnil;
2600 current_popup_menu = NULL;
2602 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
2604 defsubr (&Sx_popup_menu);
2605 defsubr (&Smenu_or_popup_active_p);
2606 #ifdef HAVE_MENUS
2607 defsubr (&Sx_popup_dialog);
2608 #endif
2612 globals_of_w32menu is used to initialize those global variables that
2613 must always be initialized on startup even when the global variable
2614 initialized is non zero (see the function main in emacs.c).
2615 globals_of_w32menu is called from syms_of_w32menu when the global
2616 variable initialized is 0 and directly from main when initialized
2617 is non zero.
2619 void globals_of_w32menu ()
2621 /* See if Get/SetMenuItemInfo functions are available. */
2622 HMODULE user32 = GetModuleHandle ("user32.dll");
2623 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2624 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2625 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2628 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2629 (do not change this comment) */