Add arch tagline
[emacs.git] / src / w32menu.c
blobf0d582d388a71eb2f0345725e2b1ec3d90093509
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>
23 #include <signal.h>
25 #include <stdio.h>
26 #include <mbstring.h>
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "blockinput.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "coding.h"
38 /* This may include sys/types.h, and that somehow loses
39 if this is not done before the other system files. */
40 #include "w32term.h"
42 /* Load sys/types.h if not already loaded.
43 In some systems loading it twice is suicidal. */
44 #ifndef makedev
45 #include <sys/types.h>
46 #endif
48 #include "dispextern.h"
50 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
52 /******************************************************************/
53 /* Definitions copied from lwlib.h */
55 typedef void * XtPointer;
56 typedef char Boolean;
58 enum button_type
60 BUTTON_TYPE_NONE,
61 BUTTON_TYPE_TOGGLE,
62 BUTTON_TYPE_RADIO
65 /* This structure is based on the one in ../lwlib/lwlib.h, modified
66 for Windows. */
67 typedef struct _widget_value
69 /* name of widget */
70 Lisp_Object lname;
71 char* name;
72 /* value (meaning depend on widget type) */
73 char* value;
74 /* keyboard equivalent. no implications for XtTranslations */
75 Lisp_Object lkey;
76 char* key;
77 /* Help string or nil if none.
78 GC finds this string through the frame's menu_bar_vector
79 or through menu_items. */
80 Lisp_Object help;
81 /* true if enabled */
82 Boolean enabled;
83 /* true if selected */
84 Boolean selected;
85 /* The type of a button. */
86 enum button_type button_type;
87 /* true if menu title */
88 Boolean title;
89 #if 0
90 /* true if was edited (maintained by get_value) */
91 Boolean edited;
92 /* true if has changed (maintained by lw library) */
93 change_type change;
94 /* true if this widget itself has changed,
95 but not counting the other widgets found in the `next' field. */
96 change_type this_one_change;
97 #endif
98 /* Contents of the sub-widgets, also selected slot for checkbox */
99 struct _widget_value* contents;
100 /* data passed to callback */
101 XtPointer call_data;
102 /* next one in the list */
103 struct _widget_value* next;
104 #if 0
105 /* slot for the toolkit dependent part. Always initialize to NULL. */
106 void* toolkit_data;
107 /* tell us if we should free the toolkit data slot when freeing the
108 widget_value itself. */
109 Boolean free_toolkit_data;
111 /* we resource the widget_value structures; this points to the next
112 one on the free list if this one has been deallocated.
114 struct _widget_value *free_list;
115 #endif
116 } widget_value;
118 /* Local memory management */
119 #define local_heap (GetProcessHeap ())
120 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
121 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
123 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
124 #define free_widget_value(wv) (local_free ((wv)))
126 /******************************************************************/
128 #ifndef TRUE
129 #define TRUE 1
130 #define FALSE 0
131 #endif /* no TRUE */
133 HMENU current_popup_menu;
135 void syms_of_w32menu ();
136 void globals_of_w32menu ();
138 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
139 IN HMENU,
140 IN UINT,
141 IN BOOL,
142 IN OUT LPMENUITEMINFOA);
143 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
144 IN HMENU,
145 IN UINT,
146 IN BOOL,
147 IN LPCMENUITEMINFOA);
149 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
150 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
151 AppendMenuW_Proc unicode_append_menu = NULL;
153 Lisp_Object Qdebug_on_next_call;
155 extern Lisp_Object Vmenu_updating_frame;
157 extern Lisp_Object Qmenu_bar;
159 extern Lisp_Object QCtoggle, QCradio;
161 extern Lisp_Object Voverriding_local_map;
162 extern Lisp_Object Voverriding_local_map_menu_flag;
164 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
166 extern Lisp_Object Qmenu_bar_update_hook;
168 void set_frame_menubar ();
170 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
171 Lisp_Object, Lisp_Object, Lisp_Object,
172 Lisp_Object, Lisp_Object));
173 #ifdef HAVE_DIALOGS
174 static Lisp_Object w32_dialog_show ();
175 #endif
176 static Lisp_Object w32_menu_show ();
178 static void keymap_panes ();
179 static void single_keymap_panes ();
180 static void single_menu_item ();
181 static void list_of_panes ();
182 static void list_of_items ();
183 void w32_free_menu_strings (HWND);
185 /* This holds a Lisp vector that holds the results of decoding
186 the keymaps or alist-of-alists that specify a menu.
188 It describes the panes and items within the panes.
190 Each pane is described by 3 elements in the vector:
191 t, the pane name, the pane's prefix key.
192 Then follow the pane's items, with 5 elements per item:
193 the item string, the enable flag, the item's value,
194 the definition, and the equivalent keyboard key's description string.
196 In some cases, multiple levels of menus may be described.
197 A single vector slot containing nil indicates the start of a submenu.
198 A single vector slot containing lambda indicates the end of a submenu.
199 The submenu follows a menu item which is the way to reach the submenu.
201 A single vector slot containing quote indicates that the
202 following items should appear on the right of a dialog box.
204 Using a Lisp vector to hold this information while we decode it
205 takes care of protecting all the data from GC. */
207 #define MENU_ITEMS_PANE_NAME 1
208 #define MENU_ITEMS_PANE_PREFIX 2
209 #define MENU_ITEMS_PANE_LENGTH 3
211 enum menu_item_idx
213 MENU_ITEMS_ITEM_NAME = 0,
214 MENU_ITEMS_ITEM_ENABLE,
215 MENU_ITEMS_ITEM_VALUE,
216 MENU_ITEMS_ITEM_EQUIV_KEY,
217 MENU_ITEMS_ITEM_DEFINITION,
218 MENU_ITEMS_ITEM_TYPE,
219 MENU_ITEMS_ITEM_SELECTED,
220 MENU_ITEMS_ITEM_HELP,
221 MENU_ITEMS_ITEM_LENGTH
224 static Lisp_Object menu_items;
226 /* Number of slots currently allocated in menu_items. */
227 static int menu_items_allocated;
229 /* This is the index in menu_items of the first empty slot. */
230 static int menu_items_used;
232 /* The number of panes currently recorded in menu_items,
233 excluding those within submenus. */
234 static int menu_items_n_panes;
236 /* Current depth within submenus. */
237 static int menu_items_submenu_depth;
239 static int next_menubar_widget_id;
241 /* This is set nonzero after the user activates the menu bar, and set
242 to zero again after the menu bars are redisplayed by prepare_menu_bar.
243 While it is nonzero, all calls to set_frame_menubar go deep.
245 I don't understand why this is needed, but it does seem to be
246 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
248 int pending_menu_activation;
251 /* Return the frame whose ->output_data.w32->menubar_widget equals
252 ID, or 0 if none. */
254 static struct frame *
255 menubar_id_to_frame (id)
256 HMENU id;
258 Lisp_Object tail, frame;
259 FRAME_PTR f;
261 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
263 frame = XCAR (tail);
264 if (!GC_FRAMEP (frame))
265 continue;
266 f = XFRAME (frame);
267 if (!FRAME_WINDOW_P (f))
268 continue;
269 if (f->output_data.w32->menubar_widget == id)
270 return f;
272 return 0;
275 /* Initialize the menu_items structure if we haven't already done so.
276 Also mark it as currently empty. */
278 static void
279 init_menu_items ()
281 if (NILP (menu_items))
283 menu_items_allocated = 60;
284 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
287 menu_items_used = 0;
288 menu_items_n_panes = 0;
289 menu_items_submenu_depth = 0;
292 /* Call at the end of generating the data in menu_items.
293 This fills in the number of items in the last pane. */
295 static void
296 finish_menu_items ()
300 /* Call when finished using the data for the current menu
301 in menu_items. */
303 static void
304 discard_menu_items ()
306 /* Free the structure if it is especially large.
307 Otherwise, hold on to it, to save time. */
308 if (menu_items_allocated > 200)
310 menu_items = Qnil;
311 menu_items_allocated = 0;
315 /* Make the menu_items vector twice as large. */
317 static void
318 grow_menu_items ()
320 Lisp_Object old;
321 int old_size = menu_items_allocated;
322 old = menu_items;
324 menu_items_allocated *= 2;
325 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
326 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
327 old_size * sizeof (Lisp_Object));
330 /* Begin a submenu. */
332 static void
333 push_submenu_start ()
335 if (menu_items_used + 1 > menu_items_allocated)
336 grow_menu_items ();
338 ASET (menu_items, menu_items_used++, Qnil);
339 menu_items_submenu_depth++;
342 /* End a submenu. */
344 static void
345 push_submenu_end ()
347 if (menu_items_used + 1 > menu_items_allocated)
348 grow_menu_items ();
350 ASET (menu_items, menu_items_used++, Qlambda);
351 menu_items_submenu_depth--;
354 /* Indicate boundary between left and right. */
356 static void
357 push_left_right_boundary ()
359 if (menu_items_used + 1 > menu_items_allocated)
360 grow_menu_items ();
362 ASET (menu_items, menu_items_used++, Qquote);
365 /* Start a new menu pane in menu_items.
366 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
368 static void
369 push_menu_pane (name, prefix_vec)
370 Lisp_Object name, prefix_vec;
372 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
373 grow_menu_items ();
375 if (menu_items_submenu_depth == 0)
376 menu_items_n_panes++;
377 ASET (menu_items, menu_items_used++, Qt);
378 ASET (menu_items, menu_items_used++, name);
379 ASET (menu_items, menu_items_used++, prefix_vec);
382 /* Push one menu item into the current pane. NAME is the string to
383 display. ENABLE if non-nil means this item can be selected. KEY
384 is the key generated by choosing this item, or nil if this item
385 doesn't really have a definition. DEF is the definition of this
386 item. EQUIV is the textual description of the keyboard equivalent
387 for this item (or nil if none). TYPE is the type of this menu
388 item, one of nil, `toggle' or `radio'. */
390 static void
391 push_menu_item (name, enable, key, def, equiv, type, selected, help)
392 Lisp_Object name, enable, key, def, equiv, type, selected, help;
394 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
395 grow_menu_items ();
397 ASET (menu_items, menu_items_used++, name);
398 ASET (menu_items, menu_items_used++, enable);
399 ASET (menu_items, menu_items_used++, key);
400 ASET (menu_items, menu_items_used++, equiv);
401 ASET (menu_items, menu_items_used++, def);
402 ASET (menu_items, menu_items_used++, type);
403 ASET (menu_items, menu_items_used++, selected);
404 ASET (menu_items, menu_items_used++, help);
407 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
408 and generate menu panes for them in menu_items.
409 If NOTREAL is nonzero,
410 don't bother really computing whether an item is enabled. */
412 static void
413 keymap_panes (keymaps, nmaps, notreal)
414 Lisp_Object *keymaps;
415 int nmaps;
416 int notreal;
418 int mapno;
420 init_menu_items ();
422 /* Loop over the given keymaps, making a pane for each map.
423 But don't make a pane that is empty--ignore that map instead.
424 P is the number of panes we have made so far. */
425 for (mapno = 0; mapno < nmaps; mapno++)
426 single_keymap_panes (keymaps[mapno],
427 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
429 finish_menu_items ();
432 /* This is a recursive subroutine of keymap_panes.
433 It handles one keymap, KEYMAP.
434 The other arguments are passed along
435 or point to local variables of the previous function.
436 If NOTREAL is nonzero, only check for equivalent key bindings, don't
437 evaluate expressions in menu items and don't make any menu.
439 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
441 static void
442 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
443 Lisp_Object keymap;
444 Lisp_Object pane_name;
445 Lisp_Object prefix;
446 int notreal;
447 int maxdepth;
449 Lisp_Object pending_maps = Qnil;
450 Lisp_Object tail, item;
451 struct gcpro gcpro1, gcpro2;
453 if (maxdepth <= 0)
454 return;
456 push_menu_pane (pane_name, prefix);
458 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
460 GCPRO2 (keymap, pending_maps);
461 /* Look at each key binding, and if it is a menu item add it
462 to this menu. */
463 item = XCAR (tail);
464 if (CONSP (item))
465 single_menu_item (XCAR (item), XCDR (item),
466 &pending_maps, notreal, maxdepth);
467 else if (VECTORP (item))
469 /* Loop over the char values represented in the vector. */
470 int len = ASIZE (item);
471 int c;
472 for (c = 0; c < len; c++)
474 Lisp_Object character;
475 XSETFASTINT (character, c);
476 single_menu_item (character, AREF (item, c),
477 &pending_maps, notreal, maxdepth);
480 UNGCPRO;
483 /* Process now any submenus which want to be panes at this level. */
484 while (!NILP (pending_maps))
486 Lisp_Object elt, eltcdr, string;
487 elt = Fcar (pending_maps);
488 eltcdr = XCDR (elt);
489 string = XCAR (eltcdr);
490 /* We no longer discard the @ from the beginning of the string here.
491 Instead, we do this in w32_menu_show. */
492 single_keymap_panes (Fcar (elt), string,
493 XCDR (eltcdr), notreal, maxdepth - 1);
494 pending_maps = Fcdr (pending_maps);
498 /* This is a subroutine of single_keymap_panes that handles one
499 keymap entry.
500 KEY is a key in a keymap and ITEM is its binding.
501 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
502 separate panes.
503 If NOTREAL is nonzero, only check for equivalent key bindings, don't
504 evaluate expressions in menu items and don't make any menu.
505 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
507 static void
508 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
509 Lisp_Object key, item;
510 Lisp_Object *pending_maps_ptr;
511 int maxdepth, notreal;
513 Lisp_Object map, item_string, enabled;
514 struct gcpro gcpro1, gcpro2;
515 int res;
517 /* Parse the menu item and leave the result in item_properties. */
518 GCPRO2 (key, item);
519 res = parse_menu_item (item, notreal, 0);
520 UNGCPRO;
521 if (!res)
522 return; /* Not a menu item. */
524 map = AREF (item_properties, ITEM_PROPERTY_MAP);
526 if (notreal)
528 /* We don't want to make a menu, just traverse the keymaps to
529 precompute equivalent key bindings. */
530 if (!NILP (map))
531 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
532 return;
535 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
536 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
538 if (!NILP (map) && SREF (item_string, 0) == '@')
540 if (!NILP (enabled))
541 /* An enabled separate pane. Remember this to handle it later. */
542 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
543 *pending_maps_ptr);
544 return;
547 push_menu_item (item_string, enabled, key,
548 AREF (item_properties, ITEM_PROPERTY_DEF),
549 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
550 AREF (item_properties, ITEM_PROPERTY_TYPE),
551 AREF (item_properties, ITEM_PROPERTY_SELECTED),
552 AREF (item_properties, ITEM_PROPERTY_HELP));
554 /* Display a submenu using the toolkit. */
555 if (! (NILP (map) || NILP (enabled)))
557 push_submenu_start ();
558 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
559 push_submenu_end ();
563 /* Push all the panes and items of a menu described by the
564 alist-of-alists MENU.
565 This handles old-fashioned calls to x-popup-menu. */
567 static void
568 list_of_panes (menu)
569 Lisp_Object menu;
571 Lisp_Object tail;
573 init_menu_items ();
575 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
577 Lisp_Object elt, pane_name, pane_data;
578 elt = Fcar (tail);
579 pane_name = Fcar (elt);
580 CHECK_STRING (pane_name);
581 push_menu_pane (pane_name, Qnil);
582 pane_data = Fcdr (elt);
583 CHECK_CONS (pane_data);
584 list_of_items (pane_data);
587 finish_menu_items ();
590 /* Push the items in a single pane defined by the alist PANE. */
592 static void
593 list_of_items (pane)
594 Lisp_Object pane;
596 Lisp_Object tail, item, item1;
598 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
600 item = Fcar (tail);
601 if (STRINGP (item))
602 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
603 else if (NILP (item))
604 push_left_right_boundary ();
605 else
607 CHECK_CONS (item);
608 item1 = Fcar (item);
609 CHECK_STRING (item1);
610 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
615 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
616 doc: /* Pop up a deck-of-cards menu and return user's selection.
617 POSITION is a position specification. This is either a mouse button
618 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
619 are positions in pixels from the top left corner of WINDOW's frame
620 \(WINDOW may be a frame object instead of a window). This controls the
621 position of the center of the first line in the first pane of the
622 menu, not the top left of the menu as a whole. If POSITION is t, it
623 means to use the current mouse position.
625 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
626 The menu items come from key bindings that have a menu string as well as
627 a definition; actually, the \"definition\" in such a key binding looks like
628 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
629 the keymap as a top-level element.
631 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
632 Otherwise, REAL-DEFINITION should be a valid key binding definition.
634 You can also use a list of keymaps as MENU. Then each keymap makes a
635 separate pane. When MENU is a keymap or a list of keymaps, the return
636 value is a list of events.
638 Alternatively, you can specify a menu of multiple panes with a list of
639 the form (TITLE PANE1 PANE2...), where each pane is a list of
640 form (TITLE ITEM1 ITEM2...).
641 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
642 appear as an item--that makes a nonselectable line in the menu.
643 With this form of menu, the return value is VALUE from the chosen item.
645 If POSITION is nil, don't display the menu at all, just precalculate the
646 cached information about equivalent key sequences. */)
647 (position, menu)
648 Lisp_Object position, menu;
650 Lisp_Object keymap, tem;
651 int xpos = 0, ypos = 0;
652 Lisp_Object title;
653 char *error_name;
654 Lisp_Object selection;
655 FRAME_PTR f = NULL;
656 Lisp_Object x, y, window;
657 int keymaps = 0;
658 int for_click = 0;
659 struct gcpro gcpro1;
661 #ifdef HAVE_MENUS
662 if (! NILP (position))
664 check_w32 ();
666 /* Decode the first argument: find the window and the coordinates. */
667 if (EQ (position, Qt)
668 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
669 || EQ (XCAR (position), Qtool_bar))))
671 /* Use the mouse's current position. */
672 FRAME_PTR new_f = SELECTED_FRAME ();
673 Lisp_Object bar_window;
674 enum scroll_bar_part part;
675 unsigned long time;
677 if (mouse_position_hook)
678 (*mouse_position_hook) (&new_f, 1, &bar_window,
679 &part, &x, &y, &time);
680 if (new_f != 0)
681 XSETFRAME (window, new_f);
682 else
684 window = selected_window;
685 XSETFASTINT (x, 0);
686 XSETFASTINT (y, 0);
689 else
691 tem = Fcar (position);
692 if (CONSP (tem))
694 window = Fcar (Fcdr (position));
695 x = Fcar (tem);
696 y = Fcar (Fcdr (tem));
698 else
700 for_click = 1;
701 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
702 window = Fcar (tem); /* POSN_WINDOW (tem) */
703 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
704 x = Fcar (tem);
705 y = Fcdr (tem);
709 CHECK_NUMBER (x);
710 CHECK_NUMBER (y);
712 /* Decode where to put the menu. */
714 if (FRAMEP (window))
716 f = XFRAME (window);
717 xpos = 0;
718 ypos = 0;
720 else if (WINDOWP (window))
722 CHECK_LIVE_WINDOW (window);
723 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
725 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
726 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
728 else
729 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
730 but I don't want to make one now. */
731 CHECK_WINDOW (window);
733 xpos += XINT (x);
734 ypos += XINT (y);
736 XSETFRAME (Vmenu_updating_frame, f);
738 else
739 Vmenu_updating_frame = Qnil;
740 #endif /* HAVE_MENUS */
742 title = Qnil;
743 GCPRO1 (title);
745 /* Decode the menu items from what was specified. */
747 keymap = get_keymap (menu, 0, 0);
748 if (CONSP (keymap))
750 /* We were given a keymap. Extract menu info from the keymap. */
751 Lisp_Object prompt;
753 /* Extract the detailed info to make one pane. */
754 keymap_panes (&menu, 1, NILP (position));
756 /* Search for a string appearing directly as an element of the keymap.
757 That string is the title of the menu. */
758 prompt = Fkeymap_prompt (keymap);
759 if (NILP (title) && !NILP (prompt))
760 title = prompt;
762 /* Make that be the pane title of the first pane. */
763 if (!NILP (prompt) && menu_items_n_panes >= 0)
764 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
766 keymaps = 1;
768 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
770 /* We were given a list of keymaps. */
771 int nmaps = XFASTINT (Flength (menu));
772 Lisp_Object *maps
773 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
774 int i;
776 title = Qnil;
778 /* The first keymap that has a prompt string
779 supplies the menu title. */
780 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
782 Lisp_Object prompt;
784 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
786 prompt = Fkeymap_prompt (keymap);
787 if (NILP (title) && !NILP (prompt))
788 title = prompt;
791 /* Extract the detailed info to make one pane. */
792 keymap_panes (maps, nmaps, NILP (position));
794 /* Make the title be the pane title of the first pane. */
795 if (!NILP (title) && menu_items_n_panes >= 0)
796 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
798 keymaps = 1;
800 else
802 /* We were given an old-fashioned menu. */
803 title = Fcar (menu);
804 CHECK_STRING (title);
806 list_of_panes (Fcdr (menu));
808 keymaps = 0;
811 if (NILP (position))
813 discard_menu_items ();
814 UNGCPRO;
815 return Qnil;
818 #ifdef HAVE_MENUS
819 /* If resources from a previous popup menu still exist, does nothing
820 until the `menu_free_timer' has freed them (see w32fns.c). This
821 can occur if you press ESC or click outside a menu without selecting
822 a menu item.
824 if (current_popup_menu)
826 discard_menu_items ();
827 UNGCPRO;
828 return Qnil;
831 /* Display them in a menu. */
832 BLOCK_INPUT;
834 selection = w32_menu_show (f, xpos, ypos, for_click,
835 keymaps, title, &error_name);
836 UNBLOCK_INPUT;
838 discard_menu_items ();
840 #endif /* HAVE_MENUS */
842 UNGCPRO;
844 if (error_name) error (error_name);
845 return selection;
848 #ifdef HAVE_MENUS
850 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
851 doc: /* Pop up a dialog box and return user's selection.
852 POSITION specifies which frame to use.
853 This is normally a mouse button event or a window or frame.
854 If POSITION is t, it means to use the frame the mouse is on.
855 The dialog box appears in the middle of the specified frame.
857 CONTENTS specifies the alternatives to display in the dialog box.
858 It is a list of the form (TITLE ITEM1 ITEM2...).
859 Each ITEM is a cons cell (STRING . VALUE).
860 The return value is VALUE from the chosen item.
862 An ITEM may also be just a string--that makes a nonselectable item.
863 An ITEM may also be nil--that means to put all preceding items
864 on the left of the dialog box and all following items on the right.
865 \(By default, approximately half appear on each side.)
867 If HEADER is non-nil, the frame title for the box is "Information",
868 otherwise it is "Question". */)
869 (position, contents, header)
870 Lisp_Object position, contents, header;
872 FRAME_PTR f = NULL;
873 Lisp_Object window;
875 check_w32 ();
877 /* Decode the first argument: find the window or frame to use. */
878 if (EQ (position, Qt)
879 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
880 || EQ (XCAR (position), Qtool_bar))))
882 #if 0 /* Using the frame the mouse is on may not be right. */
883 /* Use the mouse's current position. */
884 FRAME_PTR new_f = SELECTED_FRAME ();
885 Lisp_Object bar_window;
886 enum scroll_bar_part part;
887 unsigned long time;
888 Lisp_Object x, y;
890 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
892 if (new_f != 0)
893 XSETFRAME (window, new_f);
894 else
895 window = selected_window;
896 #endif
897 window = selected_window;
899 else if (CONSP (position))
901 Lisp_Object tem;
902 tem = Fcar (position);
903 if (CONSP (tem))
904 window = Fcar (Fcdr (position));
905 else
907 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
908 window = Fcar (tem); /* POSN_WINDOW (tem) */
911 else if (WINDOWP (position) || FRAMEP (position))
912 window = position;
913 else
914 window = Qnil;
916 /* Decode where to put the menu. */
918 if (FRAMEP (window))
919 f = XFRAME (window);
920 else if (WINDOWP (window))
922 CHECK_LIVE_WINDOW (window);
923 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
925 else
926 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
927 but I don't want to make one now. */
928 CHECK_WINDOW (window);
930 #ifndef HAVE_DIALOGS
931 /* Display a menu with these alternatives
932 in the middle of frame F. */
934 Lisp_Object x, y, frame, newpos;
935 XSETFRAME (frame, f);
936 XSETINT (x, x_pixel_width (f) / 2);
937 XSETINT (y, x_pixel_height (f) / 2);
938 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
940 return Fx_popup_menu (newpos,
941 Fcons (Fcar (contents), Fcons (contents, Qnil)));
943 #else /* HAVE_DIALOGS */
945 Lisp_Object title;
946 char *error_name;
947 Lisp_Object selection;
949 /* Decode the dialog items from what was specified. */
950 title = Fcar (contents);
951 CHECK_STRING (title);
953 list_of_panes (Fcons (contents, Qnil));
955 /* Display them in a dialog box. */
956 BLOCK_INPUT;
957 selection = w32_dialog_show (f, 0, title, header, &error_name);
958 UNBLOCK_INPUT;
960 discard_menu_items ();
962 if (error_name) error (error_name);
963 return selection;
965 #endif /* HAVE_DIALOGS */
968 /* Activate the menu bar of frame F.
969 This is called from keyboard.c when it gets the
970 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
972 To activate the menu bar, we signal to the input thread that it can
973 return from the WM_INITMENU message, allowing the normal Windows
974 processing of the menus.
976 But first we recompute the menu bar contents (the whole tree).
978 This way we can safely execute Lisp code. */
980 void
981 x_activate_menubar (f)
982 FRAME_PTR f;
984 set_frame_menubar (f, 0, 1);
986 /* Lock out further menubar changes while active. */
987 f->output_data.w32->menubar_active = 1;
989 /* Signal input thread to return from WM_INITMENU. */
990 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
993 /* This callback is called from the menu bar pulldown menu
994 when the user makes a selection.
995 Figure out what the user chose
996 and put the appropriate events into the keyboard buffer. */
998 void
999 menubar_selection_callback (FRAME_PTR f, void * client_data)
1001 Lisp_Object prefix, entry;
1002 Lisp_Object vector;
1003 Lisp_Object *subprefix_stack;
1004 int submenu_depth = 0;
1005 int i;
1007 if (!f)
1008 return;
1009 entry = Qnil;
1010 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1011 vector = f->menu_bar_vector;
1012 prefix = Qnil;
1013 i = 0;
1014 while (i < f->menu_bar_items_used)
1016 if (EQ (AREF (vector, i), Qnil))
1018 subprefix_stack[submenu_depth++] = prefix;
1019 prefix = entry;
1020 i++;
1022 else if (EQ (AREF (vector, i), Qlambda))
1024 prefix = subprefix_stack[--submenu_depth];
1025 i++;
1027 else if (EQ (AREF (vector, i), Qt))
1029 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1030 i += MENU_ITEMS_PANE_LENGTH;
1032 else
1034 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1035 /* The EMACS_INT cast avoids a warning. There's no problem
1036 as long as pointers have enough bits to hold small integers. */
1037 if ((int) (EMACS_INT) client_data == i)
1039 int j;
1040 struct input_event buf;
1041 Lisp_Object frame;
1042 EVENT_INIT (buf);
1044 XSETFRAME (frame, f);
1045 buf.kind = MENU_BAR_EVENT;
1046 buf.frame_or_window = frame;
1047 buf.arg = frame;
1048 kbd_buffer_store_event (&buf);
1050 for (j = 0; j < submenu_depth; j++)
1051 if (!NILP (subprefix_stack[j]))
1053 buf.kind = MENU_BAR_EVENT;
1054 buf.frame_or_window = frame;
1055 buf.arg = subprefix_stack[j];
1056 kbd_buffer_store_event (&buf);
1059 if (!NILP (prefix))
1061 buf.kind = MENU_BAR_EVENT;
1062 buf.frame_or_window = frame;
1063 buf.arg = prefix;
1064 kbd_buffer_store_event (&buf);
1067 buf.kind = MENU_BAR_EVENT;
1068 buf.frame_or_window = frame;
1069 buf.arg = entry;
1070 /* Free memory used by owner-drawn and help-echo strings. */
1071 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1072 kbd_buffer_store_event (&buf);
1074 f->output_data.w32->menubar_active = 0;
1075 return;
1077 i += MENU_ITEMS_ITEM_LENGTH;
1080 /* Free memory used by owner-drawn and help-echo strings. */
1081 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1082 f->output_data.w32->menubar_active = 0;
1085 /* Allocate a widget_value, blocking input. */
1087 widget_value *
1088 xmalloc_widget_value ()
1090 widget_value *value;
1092 BLOCK_INPUT;
1093 value = malloc_widget_value ();
1094 UNBLOCK_INPUT;
1096 return value;
1099 /* This recursively calls free_widget_value on the tree of widgets.
1100 It must free all data that was malloc'ed for these widget_values.
1101 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1102 must be left alone. */
1104 void
1105 free_menubar_widget_value_tree (wv)
1106 widget_value *wv;
1108 if (! wv) return;
1110 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1112 if (wv->contents && (wv->contents != (widget_value*)1))
1114 free_menubar_widget_value_tree (wv->contents);
1115 wv->contents = (widget_value *) 0xDEADBEEF;
1117 if (wv->next)
1119 free_menubar_widget_value_tree (wv->next);
1120 wv->next = (widget_value *) 0xDEADBEEF;
1122 BLOCK_INPUT;
1123 free_widget_value (wv);
1124 UNBLOCK_INPUT;
1127 /* Set up data i menu_items for a menu bar item
1128 whose event type is ITEM_KEY (with string ITEM_NAME)
1129 and whose contents come from the list of keymaps MAPS. */
1131 static int
1132 parse_single_submenu (item_key, item_name, maps)
1133 Lisp_Object item_key, item_name, maps;
1135 Lisp_Object length;
1136 int len;
1137 Lisp_Object *mapvec;
1138 int i;
1139 int top_level_items = 0;
1141 length = Flength (maps);
1142 len = XINT (length);
1144 /* Convert the list MAPS into a vector MAPVEC. */
1145 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1146 for (i = 0; i < len; i++)
1148 mapvec[i] = Fcar (maps);
1149 maps = Fcdr (maps);
1152 /* Loop over the given keymaps, making a pane for each map.
1153 But don't make a pane that is empty--ignore that map instead. */
1154 for (i = 0; i < len; i++)
1156 if (SYMBOLP (mapvec[i])
1157 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1159 /* Here we have a command at top level in the menu bar
1160 as opposed to a submenu. */
1161 top_level_items = 1;
1162 push_menu_pane (Qnil, Qnil);
1163 push_menu_item (item_name, Qt, item_key, mapvec[i],
1164 Qnil, Qnil, Qnil, Qnil);
1166 else
1168 Lisp_Object prompt;
1169 prompt = Fkeymap_prompt (mapvec[i]);
1170 single_keymap_panes (mapvec[i],
1171 !NILP (prompt) ? prompt : item_name,
1172 item_key, 0, 10);
1176 return top_level_items;
1180 /* Create a tree of widget_value objects
1181 representing the panes and items
1182 in menu_items starting at index START, up to index END. */
1184 static widget_value *
1185 digest_single_submenu (start, end, top_level_items)
1186 int start, end, top_level_items;
1188 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1189 int i;
1190 int submenu_depth = 0;
1191 widget_value **submenu_stack;
1193 submenu_stack
1194 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1195 wv = xmalloc_widget_value ();
1196 wv->name = "menu";
1197 wv->value = 0;
1198 wv->enabled = 1;
1199 wv->button_type = BUTTON_TYPE_NONE;
1200 wv->help = Qnil;
1201 first_wv = wv;
1202 save_wv = 0;
1203 prev_wv = 0;
1205 /* Loop over all panes and items made by the preceding call
1206 to parse_single_submenu and construct a tree of widget_value objects.
1207 Ignore the panes and items used by previous calls to
1208 digest_single_submenu, even though those are also in menu_items. */
1209 i = start;
1210 while (i < end)
1212 if (EQ (AREF (menu_items, i), Qnil))
1214 submenu_stack[submenu_depth++] = save_wv;
1215 save_wv = prev_wv;
1216 prev_wv = 0;
1217 i++;
1219 else if (EQ (AREF (menu_items, i), Qlambda))
1221 prev_wv = save_wv;
1222 save_wv = submenu_stack[--submenu_depth];
1223 i++;
1225 else if (EQ (AREF (menu_items, i), Qt)
1226 && submenu_depth != 0)
1227 i += MENU_ITEMS_PANE_LENGTH;
1228 /* Ignore a nil in the item list.
1229 It's meaningful only for dialog boxes. */
1230 else if (EQ (AREF (menu_items, i), Qquote))
1231 i += 1;
1232 else if (EQ (AREF (menu_items, i), Qt))
1234 /* Create a new pane. */
1235 Lisp_Object pane_name, prefix;
1236 char *pane_string;
1238 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1239 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1241 if (STRINGP (pane_name))
1243 if (unicode_append_menu)
1244 /* Encode as UTF-8 for now. */
1245 pane_name = ENCODE_UTF_8 (pane_name);
1246 else if (STRING_MULTIBYTE (pane_name))
1247 pane_name = ENCODE_SYSTEM (pane_name);
1249 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1252 pane_string = (NILP (pane_name)
1253 ? "" : (char *) SDATA (pane_name));
1254 /* If there is just one top-level pane, put all its items directly
1255 under the top-level menu. */
1256 if (menu_items_n_panes == 1)
1257 pane_string = "";
1259 /* If the pane has a meaningful name,
1260 make the pane a top-level menu item
1261 with its items as a submenu beneath it. */
1262 if (strcmp (pane_string, ""))
1264 wv = xmalloc_widget_value ();
1265 if (save_wv)
1266 save_wv->next = wv;
1267 else
1268 first_wv->contents = wv;
1269 wv->lname = pane_name;
1270 /* Set value to 1 so update_submenu_strings can handle '@' */
1271 wv->value = (char *) 1;
1272 wv->enabled = 1;
1273 wv->button_type = BUTTON_TYPE_NONE;
1274 wv->help = Qnil;
1276 save_wv = wv;
1277 prev_wv = 0;
1278 i += MENU_ITEMS_PANE_LENGTH;
1280 else
1282 /* Create a new item within current pane. */
1283 Lisp_Object item_name, enable, descrip, def, type, selected;
1284 Lisp_Object help;
1286 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1287 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1288 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1289 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1290 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1291 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1292 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1294 if (STRINGP (item_name))
1296 if (unicode_append_menu)
1297 item_name = ENCODE_UTF_8 (item_name);
1298 else if (STRING_MULTIBYTE (item_name))
1299 item_name = ENCODE_SYSTEM (item_name);
1301 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1304 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1306 descrip = ENCODE_SYSTEM (descrip);
1307 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1310 wv = xmalloc_widget_value ();
1311 if (prev_wv)
1312 prev_wv->next = wv;
1313 else
1314 save_wv->contents = wv;
1316 wv->lname = item_name;
1317 if (!NILP (descrip))
1318 wv->lkey = descrip;
1319 wv->value = 0;
1320 /* The EMACS_INT cast avoids a warning. There's no problem
1321 as long as pointers have enough bits to hold small integers. */
1322 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1323 wv->enabled = !NILP (enable);
1325 if (NILP (type))
1326 wv->button_type = BUTTON_TYPE_NONE;
1327 else if (EQ (type, QCradio))
1328 wv->button_type = BUTTON_TYPE_RADIO;
1329 else if (EQ (type, QCtoggle))
1330 wv->button_type = BUTTON_TYPE_TOGGLE;
1331 else
1332 abort ();
1334 wv->selected = !NILP (selected);
1335 if (!STRINGP (help))
1336 help = Qnil;
1338 wv->help = help;
1340 prev_wv = wv;
1342 i += MENU_ITEMS_ITEM_LENGTH;
1346 /* If we have just one "menu item"
1347 that was originally a button, return it by itself. */
1348 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1350 wv = first_wv->contents;
1351 free_widget_value (first_wv);
1352 return wv;
1355 return first_wv;
1359 /* Walk through the widget_value tree starting at FIRST_WV and update
1360 the char * pointers from the corresponding lisp values.
1361 We do this after building the whole tree, since GC may happen while the
1362 tree is constructed, and small strings are relocated. So we must wait
1363 until no GC can happen before storing pointers into lisp values. */
1364 static void
1365 update_submenu_strings (first_wv)
1366 widget_value *first_wv;
1368 widget_value *wv;
1370 for (wv = first_wv; wv; wv = wv->next)
1372 if (wv->lname && ! NILP (wv->lname))
1374 wv->name = SDATA (wv->lname);
1376 /* Ignore the @ that means "separate pane".
1377 This is a kludge, but this isn't worth more time. */
1378 if (wv->value == (char *)1)
1380 if (wv->name[0] == '@')
1381 wv->name++;
1382 wv->value = 0;
1386 if (wv->lkey && ! NILP (wv->lkey))
1387 wv->key = SDATA (wv->lkey);
1389 if (wv->contents)
1390 update_submenu_strings (wv->contents);
1395 /* Set the contents of the menubar widgets of frame F.
1396 The argument FIRST_TIME is currently ignored;
1397 it is set the first time this is called, from initialize_frame_menubar. */
1399 void
1400 set_frame_menubar (f, first_time, deep_p)
1401 FRAME_PTR f;
1402 int first_time;
1403 int deep_p;
1405 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1406 Lisp_Object items;
1407 widget_value *wv, *first_wv, *prev_wv = 0;
1408 int i, last_i;
1409 int *submenu_start, *submenu_end;
1410 int *submenu_top_level_items, *submenu_n_panes;
1412 /* We must not change the menubar when actually in use. */
1413 if (f->output_data.w32->menubar_active)
1414 return;
1416 XSETFRAME (Vmenu_updating_frame, f);
1418 if (! menubar_widget)
1419 deep_p = 1;
1420 else if (pending_menu_activation && !deep_p)
1421 deep_p = 1;
1423 if (deep_p)
1425 /* Make a widget-value tree representing the entire menu trees. */
1427 struct buffer *prev = current_buffer;
1428 Lisp_Object buffer;
1429 int specpdl_count = SPECPDL_INDEX ();
1430 int previous_menu_items_used = f->menu_bar_items_used;
1431 Lisp_Object *previous_items
1432 = (Lisp_Object *) alloca (previous_menu_items_used
1433 * sizeof (Lisp_Object));
1435 /* If we are making a new widget, its contents are empty,
1436 do always reinitialize them. */
1437 if (! menubar_widget)
1438 previous_menu_items_used = 0;
1440 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1441 specbind (Qinhibit_quit, Qt);
1442 /* Don't let the debugger step into this code
1443 because it is not reentrant. */
1444 specbind (Qdebug_on_next_call, Qnil);
1446 record_unwind_save_match_data ();
1448 if (NILP (Voverriding_local_map_menu_flag))
1450 specbind (Qoverriding_terminal_local_map, Qnil);
1451 specbind (Qoverriding_local_map, Qnil);
1454 set_buffer_internal_1 (XBUFFER (buffer));
1456 /* Run the Lucid hook. */
1457 safe_run_hooks (Qactivate_menubar_hook);
1458 /* If it has changed current-menubar from previous value,
1459 really recompute the menubar from the value. */
1460 if (! NILP (Vlucid_menu_bar_dirty_flag))
1461 call0 (Qrecompute_lucid_menubar);
1462 safe_run_hooks (Qmenu_bar_update_hook);
1463 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1465 items = FRAME_MENU_BAR_ITEMS (f);
1467 /* Save the frame's previous menu bar contents data. */
1468 if (previous_menu_items_used)
1469 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1470 previous_menu_items_used * sizeof (Lisp_Object));
1472 /* Fill in menu_items with the current menu bar contents.
1473 This can evaluate Lisp code. */
1474 menu_items = f->menu_bar_vector;
1475 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1476 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1477 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1478 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1479 submenu_top_level_items
1480 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1481 init_menu_items ();
1482 for (i = 0; i < ASIZE (items); i += 4)
1484 Lisp_Object key, string, maps;
1486 last_i = i;
1488 key = AREF (items, i);
1489 string = AREF (items, i + 1);
1490 maps = AREF (items, i + 2);
1491 if (NILP (string))
1492 break;
1494 submenu_start[i] = menu_items_used;
1496 menu_items_n_panes = 0;
1497 submenu_top_level_items[i]
1498 = parse_single_submenu (key, string, maps);
1499 submenu_n_panes[i] = menu_items_n_panes;
1501 submenu_end[i] = menu_items_used;
1504 finish_menu_items ();
1506 /* Convert menu_items into widget_value trees
1507 to display the menu. This cannot evaluate Lisp code. */
1509 wv = xmalloc_widget_value ();
1510 wv->name = "menubar";
1511 wv->value = 0;
1512 wv->enabled = 1;
1513 wv->button_type = BUTTON_TYPE_NONE;
1514 wv->help = Qnil;
1515 first_wv = wv;
1517 for (i = 0; i < last_i; i += 4)
1519 menu_items_n_panes = submenu_n_panes[i];
1520 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1521 submenu_top_level_items[i]);
1522 if (prev_wv)
1523 prev_wv->next = wv;
1524 else
1525 first_wv->contents = wv;
1526 /* Don't set wv->name here; GC during the loop might relocate it. */
1527 wv->enabled = 1;
1528 wv->button_type = BUTTON_TYPE_NONE;
1529 prev_wv = wv;
1532 set_buffer_internal_1 (prev);
1533 unbind_to (specpdl_count, Qnil);
1535 /* If there has been no change in the Lisp-level contents
1536 of the menu bar, skip redisplaying it. Just exit. */
1538 for (i = 0; i < previous_menu_items_used; i++)
1539 if (menu_items_used == i
1540 || (!EQ (previous_items[i], AREF (menu_items, i))))
1541 break;
1542 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1544 free_menubar_widget_value_tree (first_wv);
1545 menu_items = Qnil;
1547 return;
1550 /* Now GC cannot happen during the lifetime of the widget_value,
1551 so it's safe to store data from a Lisp_String, as long as
1552 local copies are made when the actual menu is created.
1553 Windows takes care of this for normal string items, but
1554 not for owner-drawn items or additional item-info. */
1555 wv = first_wv->contents;
1556 for (i = 0; i < ASIZE (items); i += 4)
1558 Lisp_Object string;
1559 string = AREF (items, i + 1);
1560 if (NILP (string))
1561 break;
1562 wv->name = (char *) SDATA (string);
1563 update_submenu_strings (wv->contents);
1564 wv = wv->next;
1567 f->menu_bar_vector = menu_items;
1568 f->menu_bar_items_used = menu_items_used;
1569 menu_items = Qnil;
1571 else
1573 /* Make a widget-value tree containing
1574 just the top level menu bar strings. */
1576 wv = xmalloc_widget_value ();
1577 wv->name = "menubar";
1578 wv->value = 0;
1579 wv->enabled = 1;
1580 wv->button_type = BUTTON_TYPE_NONE;
1581 wv->help = Qnil;
1582 first_wv = wv;
1584 items = FRAME_MENU_BAR_ITEMS (f);
1585 for (i = 0; i < ASIZE (items); i += 4)
1587 Lisp_Object string;
1589 string = AREF (items, i + 1);
1590 if (NILP (string))
1591 break;
1593 wv = xmalloc_widget_value ();
1594 wv->name = (char *) SDATA (string);
1595 wv->value = 0;
1596 wv->enabled = 1;
1597 wv->button_type = BUTTON_TYPE_NONE;
1598 wv->help = Qnil;
1599 /* This prevents lwlib from assuming this
1600 menu item is really supposed to be empty. */
1601 /* The EMACS_INT cast avoids a warning.
1602 This value just has to be different from small integers. */
1603 wv->call_data = (void *) (EMACS_INT) (-1);
1605 if (prev_wv)
1606 prev_wv->next = wv;
1607 else
1608 first_wv->contents = wv;
1609 prev_wv = wv;
1612 /* Forget what we thought we knew about what is in the
1613 detailed contents of the menu bar menus.
1614 Changing the top level always destroys the contents. */
1615 f->menu_bar_items_used = 0;
1618 /* Create or update the menu bar widget. */
1620 BLOCK_INPUT;
1622 if (menubar_widget)
1624 /* Empty current menubar, rather than creating a fresh one. */
1625 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1628 else
1630 menubar_widget = CreateMenu ();
1632 fill_in_menu (menubar_widget, first_wv->contents);
1634 free_menubar_widget_value_tree (first_wv);
1637 HMENU old_widget = f->output_data.w32->menubar_widget;
1639 f->output_data.w32->menubar_widget = menubar_widget;
1640 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1641 /* Causes flicker when menu bar is updated
1642 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1644 /* Force the window size to be recomputed so that the frame's text
1645 area remains the same, if menubar has just been created. */
1646 if (old_widget == NULL)
1647 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1650 UNBLOCK_INPUT;
1653 /* Called from Fx_create_frame to create the initial menubar of a frame
1654 before it is mapped, so that the window is mapped with the menubar already
1655 there instead of us tacking it on later and thrashing the window after it
1656 is visible. */
1658 void
1659 initialize_frame_menubar (f)
1660 FRAME_PTR f;
1662 /* This function is called before the first chance to redisplay
1663 the frame. It has to be, so the frame will have the right size. */
1664 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1665 set_frame_menubar (f, 1, 1);
1668 /* Get rid of the menu bar of frame F, and free its storage.
1669 This is used when deleting a frame, and when turning off the menu bar. */
1671 void
1672 free_frame_menubar (f)
1673 FRAME_PTR f;
1675 BLOCK_INPUT;
1678 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1679 SetMenu (FRAME_W32_WINDOW (f), NULL);
1680 f->output_data.w32->menubar_widget = NULL;
1681 DestroyMenu (old);
1684 UNBLOCK_INPUT;
1688 /* w32_menu_show actually displays a menu using the panes and items in
1689 menu_items and returns the value selected from it; we assume input
1690 is blocked by the caller. */
1692 /* F is the frame the menu is for.
1693 X and Y are the frame-relative specified position,
1694 relative to the inside upper left corner of the frame F.
1695 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1696 KEYMAPS is 1 if this menu was specified with keymaps;
1697 in that case, we return a list containing the chosen item's value
1698 and perhaps also the pane's prefix.
1699 TITLE is the specified menu title.
1700 ERROR is a place to store an error message string in case of failure.
1701 (We return nil on failure, but the value doesn't actually matter.) */
1703 static Lisp_Object
1704 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1705 FRAME_PTR f;
1706 int x;
1707 int y;
1708 int for_click;
1709 int keymaps;
1710 Lisp_Object title;
1711 char **error;
1713 int i;
1714 int menu_item_selection;
1715 HMENU menu;
1716 POINT pos;
1717 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1718 widget_value **submenu_stack
1719 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1720 Lisp_Object *subprefix_stack
1721 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1722 int submenu_depth = 0;
1723 int first_pane;
1725 *error = NULL;
1727 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1729 *error = "Empty menu";
1730 return Qnil;
1733 /* Create a tree of widget_value objects
1734 representing the panes and their items. */
1735 wv = xmalloc_widget_value ();
1736 wv->name = "menu";
1737 wv->value = 0;
1738 wv->enabled = 1;
1739 wv->button_type = BUTTON_TYPE_NONE;
1740 wv->help = Qnil;
1741 first_wv = wv;
1742 first_pane = 1;
1744 /* Loop over all panes and items, filling in the tree. */
1745 i = 0;
1746 while (i < menu_items_used)
1748 if (EQ (AREF (menu_items, i), Qnil))
1750 submenu_stack[submenu_depth++] = save_wv;
1751 save_wv = prev_wv;
1752 prev_wv = 0;
1753 first_pane = 1;
1754 i++;
1756 else if (EQ (AREF (menu_items, i), Qlambda))
1758 prev_wv = save_wv;
1759 save_wv = submenu_stack[--submenu_depth];
1760 first_pane = 0;
1761 i++;
1763 else if (EQ (AREF (menu_items, i), Qt)
1764 && submenu_depth != 0)
1765 i += MENU_ITEMS_PANE_LENGTH;
1766 /* Ignore a nil in the item list.
1767 It's meaningful only for dialog boxes. */
1768 else if (EQ (AREF (menu_items, i), Qquote))
1769 i += 1;
1770 else if (EQ (AREF (menu_items, i), Qt))
1772 /* Create a new pane. */
1773 Lisp_Object pane_name, prefix;
1774 char *pane_string;
1775 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1776 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1778 if (STRINGP (pane_name))
1780 if (unicode_append_menu)
1781 pane_name = ENCODE_UTF_8 (pane_name);
1782 else if (STRING_MULTIBYTE (pane_name))
1783 pane_name = ENCODE_SYSTEM (pane_name);
1785 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1788 pane_string = (NILP (pane_name)
1789 ? "" : (char *) SDATA (pane_name));
1790 /* If there is just one top-level pane, put all its items directly
1791 under the top-level menu. */
1792 if (menu_items_n_panes == 1)
1793 pane_string = "";
1795 /* If the pane has a meaningful name,
1796 make the pane a top-level menu item
1797 with its items as a submenu beneath it. */
1798 if (!keymaps && strcmp (pane_string, ""))
1800 wv = xmalloc_widget_value ();
1801 if (save_wv)
1802 save_wv->next = wv;
1803 else
1804 first_wv->contents = wv;
1805 wv->name = pane_string;
1806 if (keymaps && !NILP (prefix))
1807 wv->name++;
1808 wv->value = 0;
1809 wv->enabled = 1;
1810 wv->button_type = BUTTON_TYPE_NONE;
1811 wv->help = Qnil;
1812 save_wv = wv;
1813 prev_wv = 0;
1815 else if (first_pane)
1817 save_wv = wv;
1818 prev_wv = 0;
1820 first_pane = 0;
1821 i += MENU_ITEMS_PANE_LENGTH;
1823 else
1825 /* Create a new item within current pane. */
1826 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1828 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1829 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1830 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1831 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1832 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1833 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1834 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1836 if (STRINGP (item_name))
1838 if (unicode_append_menu)
1839 item_name = ENCODE_UTF_8 (item_name);
1840 else if (STRING_MULTIBYTE (item_name))
1841 item_name = ENCODE_SYSTEM (item_name);
1843 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1846 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1848 descrip = ENCODE_SYSTEM (descrip);
1849 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1852 wv = xmalloc_widget_value ();
1853 if (prev_wv)
1854 prev_wv->next = wv;
1855 else
1856 save_wv->contents = wv;
1857 wv->name = (char *) SDATA (item_name);
1858 if (!NILP (descrip))
1859 wv->key = (char *) SDATA (descrip);
1860 wv->value = 0;
1861 /* Use the contents index as call_data, since we are
1862 restricted to 16-bits. */
1863 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1864 wv->enabled = !NILP (enable);
1866 if (NILP (type))
1867 wv->button_type = BUTTON_TYPE_NONE;
1868 else if (EQ (type, QCtoggle))
1869 wv->button_type = BUTTON_TYPE_TOGGLE;
1870 else if (EQ (type, QCradio))
1871 wv->button_type = BUTTON_TYPE_RADIO;
1872 else
1873 abort ();
1875 wv->selected = !NILP (selected);
1876 if (!STRINGP (help))
1877 help = Qnil;
1879 wv->help = help;
1881 prev_wv = wv;
1883 i += MENU_ITEMS_ITEM_LENGTH;
1887 /* Deal with the title, if it is non-nil. */
1888 if (!NILP (title))
1890 widget_value *wv_title = xmalloc_widget_value ();
1891 widget_value *wv_sep = xmalloc_widget_value ();
1893 /* Maybe replace this separator with a bitmap or owner-draw item
1894 so that it looks better. Having two separators looks odd. */
1895 wv_sep->name = "--";
1896 wv_sep->next = first_wv->contents;
1897 wv_sep->help = Qnil;
1899 if (unicode_append_menu)
1900 title = ENCODE_UTF_8 (title);
1901 else if (STRING_MULTIBYTE (title))
1902 title = ENCODE_SYSTEM (title);
1904 wv_title->name = (char *) SDATA (title);
1905 wv_title->enabled = TRUE;
1906 wv_title->title = TRUE;
1907 wv_title->button_type = BUTTON_TYPE_NONE;
1908 wv_title->help = Qnil;
1909 wv_title->next = wv_sep;
1910 first_wv->contents = wv_title;
1913 /* Actually create the menu. */
1914 current_popup_menu = menu = CreatePopupMenu ();
1915 fill_in_menu (menu, first_wv->contents);
1917 /* Adjust coordinates to be root-window-relative. */
1918 pos.x = x;
1919 pos.y = y;
1920 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1922 /* No selection has been chosen yet. */
1923 menu_item_selection = 0;
1925 /* Display the menu. */
1926 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1927 WM_EMACS_TRACKPOPUPMENU,
1928 (WPARAM)menu, (LPARAM)&pos);
1930 /* Clean up extraneous mouse events which might have been generated
1931 during the call. */
1932 discard_mouse_events ();
1934 /* Free the widget_value objects we used to specify the contents. */
1935 free_menubar_widget_value_tree (first_wv);
1937 DestroyMenu (menu);
1939 /* Free the owner-drawn and help-echo menu strings. */
1940 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1941 f->output_data.w32->menubar_active = 0;
1943 /* Find the selected item, and its pane, to return
1944 the proper value. */
1945 if (menu_item_selection != 0)
1947 Lisp_Object prefix, entry;
1949 prefix = entry = Qnil;
1950 i = 0;
1951 while (i < menu_items_used)
1953 if (EQ (AREF (menu_items, i), Qnil))
1955 subprefix_stack[submenu_depth++] = prefix;
1956 prefix = entry;
1957 i++;
1959 else if (EQ (AREF (menu_items, i), Qlambda))
1961 prefix = subprefix_stack[--submenu_depth];
1962 i++;
1964 else if (EQ (AREF (menu_items, i), Qt))
1966 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1967 i += MENU_ITEMS_PANE_LENGTH;
1969 /* Ignore a nil in the item list.
1970 It's meaningful only for dialog boxes. */
1971 else if (EQ (AREF (menu_items, i), Qquote))
1972 i += 1;
1973 else
1975 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1976 if (menu_item_selection == i)
1978 if (keymaps != 0)
1980 int j;
1982 entry = Fcons (entry, Qnil);
1983 if (!NILP (prefix))
1984 entry = Fcons (prefix, entry);
1985 for (j = submenu_depth - 1; j >= 0; j--)
1986 if (!NILP (subprefix_stack[j]))
1987 entry = Fcons (subprefix_stack[j], entry);
1989 return entry;
1991 i += MENU_ITEMS_ITEM_LENGTH;
1995 else if (!for_click)
1996 /* Make "Cancel" equivalent to C-g. */
1997 Fsignal (Qquit, Qnil);
1999 return Qnil;
2003 #ifdef HAVE_DIALOGS
2004 static char * button_names [] = {
2005 "button1", "button2", "button3", "button4", "button5",
2006 "button6", "button7", "button8", "button9", "button10" };
2008 static Lisp_Object
2009 w32_dialog_show (f, keymaps, title, header, error)
2010 FRAME_PTR f;
2011 int keymaps;
2012 Lisp_Object title, header;
2013 char **error;
2015 int i, nb_buttons=0;
2016 char dialog_name[6];
2017 int menu_item_selection;
2019 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2021 /* Number of elements seen so far, before boundary. */
2022 int left_count = 0;
2023 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2024 int boundary_seen = 0;
2026 *error = NULL;
2028 if (menu_items_n_panes > 1)
2030 *error = "Multiple panes in dialog box";
2031 return Qnil;
2034 /* Create a tree of widget_value objects
2035 representing the text label and buttons. */
2037 Lisp_Object pane_name, prefix;
2038 char *pane_string;
2039 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2040 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2041 pane_string = (NILP (pane_name)
2042 ? "" : (char *) SDATA (pane_name));
2043 prev_wv = xmalloc_widget_value ();
2044 prev_wv->value = pane_string;
2045 if (keymaps && !NILP (prefix))
2046 prev_wv->name++;
2047 prev_wv->enabled = 1;
2048 prev_wv->name = "message";
2049 prev_wv->help = Qnil;
2050 first_wv = prev_wv;
2052 /* Loop over all panes and items, filling in the tree. */
2053 i = MENU_ITEMS_PANE_LENGTH;
2054 while (i < menu_items_used)
2057 /* Create a new item within current pane. */
2058 Lisp_Object item_name, enable, descrip, help;
2060 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2061 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2062 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2063 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2065 if (NILP (item_name))
2067 free_menubar_widget_value_tree (first_wv);
2068 *error = "Submenu in dialog items";
2069 return Qnil;
2071 if (EQ (item_name, Qquote))
2073 /* This is the boundary between left-side elts
2074 and right-side elts. Stop incrementing right_count. */
2075 boundary_seen = 1;
2076 i++;
2077 continue;
2079 if (nb_buttons >= 9)
2081 free_menubar_widget_value_tree (first_wv);
2082 *error = "Too many dialog items";
2083 return Qnil;
2086 wv = xmalloc_widget_value ();
2087 prev_wv->next = wv;
2088 wv->name = (char *) button_names[nb_buttons];
2089 if (!NILP (descrip))
2090 wv->key = (char *) SDATA (descrip);
2091 wv->value = (char *) SDATA (item_name);
2092 wv->call_data = (void *) &AREF (menu_items, i);
2093 wv->enabled = !NILP (enable);
2094 wv->help = Qnil;
2095 prev_wv = wv;
2097 if (! boundary_seen)
2098 left_count++;
2100 nb_buttons++;
2101 i += MENU_ITEMS_ITEM_LENGTH;
2104 /* If the boundary was not specified,
2105 by default put half on the left and half on the right. */
2106 if (! boundary_seen)
2107 left_count = nb_buttons - nb_buttons / 2;
2109 wv = xmalloc_widget_value ();
2110 wv->name = dialog_name;
2111 wv->help = Qnil;
2113 /* Frame title: 'Q' = Question, 'I' = Information.
2114 Can also have 'E' = Error if, one day, we want
2115 a popup for errors. */
2116 if (NILP(header))
2117 dialog_name[0] = 'Q';
2118 else
2119 dialog_name[0] = 'I';
2121 /* Dialog boxes use a really stupid name encoding
2122 which specifies how many buttons to use
2123 and how many buttons are on the right. */
2124 dialog_name[1] = '0' + nb_buttons;
2125 dialog_name[2] = 'B';
2126 dialog_name[3] = 'R';
2127 /* Number of buttons to put on the right. */
2128 dialog_name[4] = '0' + nb_buttons - left_count;
2129 dialog_name[5] = 0;
2130 wv->contents = first_wv;
2131 first_wv = wv;
2134 /* Actually create the dialog. */
2135 dialog_id = widget_id_tick++;
2136 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2137 f->output_data.w32->widget, 1, 0,
2138 dialog_selection_callback, 0);
2139 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2141 /* Free the widget_value objects we used to specify the contents. */
2142 free_menubar_widget_value_tree (first_wv);
2144 /* No selection has been chosen yet. */
2145 menu_item_selection = 0;
2147 /* Display the menu. */
2148 lw_pop_up_all_widgets (dialog_id);
2150 /* Process events that apply to the menu. */
2151 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2153 lw_destroy_all_widgets (dialog_id);
2155 /* Find the selected item, and its pane, to return
2156 the proper value. */
2157 if (menu_item_selection != 0)
2159 Lisp_Object prefix;
2161 prefix = Qnil;
2162 i = 0;
2163 while (i < menu_items_used)
2165 Lisp_Object entry;
2167 if (EQ (AREF (menu_items, i), Qt))
2169 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2170 i += MENU_ITEMS_PANE_LENGTH;
2172 else
2174 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2175 if (menu_item_selection == i)
2177 if (keymaps != 0)
2179 entry = Fcons (entry, Qnil);
2180 if (!NILP (prefix))
2181 entry = Fcons (prefix, entry);
2183 return entry;
2185 i += MENU_ITEMS_ITEM_LENGTH;
2189 else
2190 /* Make "Cancel" equivalent to C-g. */
2191 Fsignal (Qquit, Qnil);
2193 return Qnil;
2195 #endif /* HAVE_DIALOGS */
2198 /* Is this item a separator? */
2199 static int
2200 name_is_separator (name)
2201 char *name;
2203 char *start = name;
2205 /* Check if name string consists of only dashes ('-'). */
2206 while (*name == '-') name++;
2207 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2208 or "--deep-shadow". We don't implement them yet, se we just treat
2209 them like normal separators. */
2210 return (*name == '\0' || start + 2 == name);
2214 /* Indicate boundary between left and right. */
2215 static int
2216 add_left_right_boundary (HMENU menu)
2218 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2221 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2222 static void
2223 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2225 while (len > 0)
2227 int utf16;
2228 if (*src < 0x80)
2230 *dest = (WCHAR) *src;
2231 dest++; src++; len--;
2233 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2234 else if (*src < 0xC0)
2236 src++; len--;
2238 /* 2 char UTF-8 sequence. */
2239 else if (*src < 0xE0)
2241 *dest = (WCHAR) (((*src & 0x1f) << 6)
2242 | (*(src + 1) & 0x3f));
2243 src += 2; len -= 2; dest++;
2245 else if (*src < 0xF0)
2247 *dest = (WCHAR) (((*src & 0x0f) << 12)
2248 | ((*(src + 1) & 0x3f) << 6)
2249 | (*(src + 2) & 0x3f));
2250 src += 3; len -= 3; dest++;
2252 else /* Not encodable. Insert Unicode Substitution char. */
2254 *dest = (WCHAR) 0xfffd;
2255 src++; len--; dest++;
2258 *dest = 0;
2261 static int
2262 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2264 UINT fuFlags;
2265 char *out_string, *p, *q;
2266 int return_value;
2267 size_t nlen, orig_len;
2269 if (name_is_separator (wv->name))
2271 fuFlags = MF_SEPARATOR;
2272 out_string = NULL;
2274 else
2276 if (wv->enabled)
2277 fuFlags = MF_STRING;
2278 else
2279 fuFlags = MF_STRING | MF_GRAYED;
2281 if (wv->key != NULL)
2283 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2284 strcpy (out_string, wv->name);
2285 strcat (out_string, "\t");
2286 strcat (out_string, wv->key);
2288 else
2289 out_string = wv->name;
2291 /* Quote any special characters within the menu item's text and
2292 key binding. */
2293 nlen = orig_len = strlen (out_string);
2294 if (unicode_append_menu)
2296 /* With UTF-8, & cannot be part of a multibyte character. */
2297 for (p = out_string; *p; p++)
2299 if (*p == '&')
2300 nlen++;
2303 else
2305 /* If encoded with the system codepage, use multibyte string
2306 functions in case of multibyte characters that contain '&'. */
2307 for (p = out_string; *p; p = _mbsinc (p))
2309 if (_mbsnextc (p) == '&')
2310 nlen++;
2314 if (nlen > orig_len)
2316 p = out_string;
2317 out_string = alloca (nlen + 1);
2318 q = out_string;
2319 while (*p)
2321 if (unicode_append_menu)
2323 if (*p == '&')
2324 *q++ = *p;
2325 *q++ = *p++;
2327 else
2329 if (_mbsnextc (p) == '&')
2331 _mbsncpy (q, p, 1);
2332 q = _mbsinc (q);
2334 _mbsncpy (q, p, 1);
2335 p = _mbsinc (p);
2336 q = _mbsinc (q);
2339 *q = '\0';
2342 if (item != NULL)
2343 fuFlags = MF_POPUP;
2344 else if (wv->title || wv->call_data == 0)
2346 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2347 we can't deallocate the memory otherwise. */
2348 if (get_menu_item_info)
2350 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2351 strcpy (out_string, wv->name);
2352 #ifdef MENU_DEBUG
2353 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2354 #endif
2355 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2357 else
2358 fuFlags = MF_DISABLED;
2361 /* Draw radio buttons and tickboxes. */
2362 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2363 wv->button_type == BUTTON_TYPE_RADIO))
2364 fuFlags |= MF_CHECKED;
2365 else
2366 fuFlags |= MF_UNCHECKED;
2369 if (unicode_append_menu && out_string)
2371 /* Convert out_string from UTF-8 to UTF-16-LE. */
2372 int utf8_len = strlen (out_string);
2373 WCHAR * utf16_string;
2374 if (fuFlags & MF_OWNERDRAW)
2375 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2376 else
2377 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2379 utf8to16 (out_string, utf8_len, utf16_string);
2380 return_value = unicode_append_menu (menu, fuFlags,
2381 item != NULL ? (UINT) item
2382 : (UINT) wv->call_data,
2383 utf16_string);
2384 if (!return_value)
2386 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2387 apparently does exist at least in some cases and appears to be
2388 stubbed out to do nothing. out_string is UTF-8, but since
2389 our standard menus are in English and this is only going to
2390 happen the first time a menu is used, the encoding is
2391 of minor importance compared with menus not working at all. */
2392 return_value =
2393 AppendMenu (menu, fuFlags,
2394 item != NULL ? (UINT) item: (UINT) wv->call_data,
2395 out_string);
2396 /* Don't use unicode menus in future. */
2397 unicode_append_menu = NULL;
2400 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2401 local_free (out_string);
2403 else
2405 return_value =
2406 AppendMenu (menu,
2407 fuFlags,
2408 item != NULL ? (UINT) item : (UINT) wv->call_data,
2409 out_string );
2412 /* This must be done after the menu item is created. */
2413 if (!wv->title && wv->call_data != 0)
2415 if (set_menu_item_info)
2417 MENUITEMINFO info;
2418 bzero (&info, sizeof (info));
2419 info.cbSize = sizeof (info);
2420 info.fMask = MIIM_DATA;
2422 /* Set help string for menu item. Leave it as a Lisp_Object
2423 until it is ready to be displayed, since GC can happen while
2424 menus are active. */
2425 if (!NILP (wv->help))
2426 #ifdef USE_LISP_UNION_TYPE
2427 info.dwItemData = (DWORD) (wv->help).i;
2428 #else
2429 info.dwItemData = (DWORD) (wv->help);
2430 #endif
2431 if (wv->button_type == BUTTON_TYPE_RADIO)
2433 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2434 RADIO items, but is not available on NT 3.51 and earlier. */
2435 info.fMask |= MIIM_TYPE | MIIM_STATE;
2436 info.fType = MFT_RADIOCHECK | MFT_STRING;
2437 info.dwTypeData = out_string;
2438 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2441 set_menu_item_info (menu,
2442 item != NULL ? (UINT) item : (UINT) wv->call_data,
2443 FALSE, &info);
2446 return return_value;
2449 /* Construct native Windows menu(bar) based on widget_value tree. */
2451 fill_in_menu (HMENU menu, widget_value *wv)
2453 int items_added = 0;
2455 for ( ; wv != NULL; wv = wv->next)
2457 if (wv->contents)
2459 HMENU sub_menu = CreatePopupMenu ();
2461 if (sub_menu == NULL)
2462 return 0;
2464 if (!fill_in_menu (sub_menu, wv->contents) ||
2465 !add_menu_item (menu, wv, sub_menu))
2467 DestroyMenu (sub_menu);
2468 return 0;
2471 else
2473 if (!add_menu_item (menu, wv, NULL))
2474 return 0;
2477 return 1;
2480 /* Display help string for currently pointed to menu item. Not
2481 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2482 available. */
2483 void
2484 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2486 if (get_menu_item_info)
2488 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2489 Lisp_Object frame, help;
2491 /* No help echo on owner-draw menu items, or when the keyboard is used
2492 to navigate the menus, since tooltips are distracting if they pop
2493 up elsewhere. */
2494 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2495 || !(flags & MF_MOUSESELECT))
2496 help = Qnil;
2497 else
2499 MENUITEMINFO info;
2501 bzero (&info, sizeof (info));
2502 info.cbSize = sizeof (info);
2503 info.fMask = MIIM_DATA;
2504 get_menu_item_info (menu, item, FALSE, &info);
2506 #ifdef USE_LISP_UNION_TYPE
2507 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2508 : Qnil;
2509 #else
2510 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2511 #endif
2514 /* Store the help echo in the keyboard buffer as the X toolkit
2515 version does, rather than directly showing it. This seems to
2516 solve the GC problems that were present when we based the
2517 Windows code on the non-toolkit version. */
2518 if (f)
2520 XSETFRAME (frame, f);
2521 kbd_buffer_store_help_event (frame, help);
2523 else
2524 /* X version has a loop through frames here, which doesn't
2525 appear to do anything, unless it has some side effect. */
2526 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2530 /* Free memory used by owner-drawn strings. */
2531 static void
2532 w32_free_submenu_strings (menu)
2533 HMENU menu;
2535 int i, num = GetMenuItemCount (menu);
2536 for (i = 0; i < num; i++)
2538 MENUITEMINFO info;
2539 bzero (&info, sizeof (info));
2540 info.cbSize = sizeof (info);
2541 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2543 get_menu_item_info (menu, i, TRUE, &info);
2545 /* Owner-drawn names are held in dwItemData. */
2546 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2548 #ifdef MENU_DEBUG
2549 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2550 #endif
2551 local_free (info.dwItemData);
2554 /* Recurse down submenus. */
2555 if (info.hSubMenu)
2556 w32_free_submenu_strings (info.hSubMenu);
2560 void
2561 w32_free_menu_strings (hwnd)
2562 HWND hwnd;
2564 HMENU menu = current_popup_menu;
2566 if (get_menu_item_info)
2568 /* If there is no popup menu active, free the strings from the frame's
2569 menubar. */
2570 if (!menu)
2571 menu = GetMenu (hwnd);
2573 if (menu)
2574 w32_free_submenu_strings (menu);
2577 current_popup_menu = NULL;
2580 #endif /* HAVE_MENUS */
2582 /* The following is used by delayed window autoselection. */
2584 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2585 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2588 #ifdef HAVE_MENUS
2589 FRAME_PTR f;
2590 f = SELECTED_FRAME ();
2591 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2592 #else
2593 return Qnil;
2594 #endif /* HAVE_MENUS */
2597 void syms_of_w32menu ()
2599 globals_of_w32menu ();
2600 staticpro (&menu_items);
2601 menu_items = Qnil;
2603 current_popup_menu = NULL;
2605 Qdebug_on_next_call = intern ("debug-on-next-call");
2606 staticpro (&Qdebug_on_next_call);
2608 defsubr (&Sx_popup_menu);
2609 defsubr (&Smenu_or_popup_active_p);
2610 #ifdef HAVE_MENUS
2611 defsubr (&Sx_popup_dialog);
2612 #endif
2616 globals_of_w32menu is used to initialize those global variables that
2617 must always be initialized on startup even when the global variable
2618 initialized is non zero (see the function main in emacs.c).
2619 globals_of_w32menu is called from syms_of_w32menu when the global
2620 variable initialized is 0 and directly from main when initialized
2621 is non zero.
2623 void globals_of_w32menu ()
2625 /* See if Get/SetMenuItemInfo functions are available. */
2626 HMODULE user32 = GetModuleHandle ("user32.dll");
2627 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2628 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2629 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2632 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2633 (do not change this comment) */