[USE_ATSUI] (mac_draw_image_string_atsui) [MAC_OS_X]: Fix coordinate flipping.
[emacs.git] / src / w32menu.c
blobbe3668017e0d50a1aa72c19754c62a404e9e1945
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>
24 #include <signal.h>
26 #include <stdio.h>
27 #include <mbstring.h>
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.h"
37 #include "coding.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
41 #include "w32term.h"
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
45 #ifndef makedev
46 #include <sys/types.h>
47 #endif
49 #include "dispextern.h"
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
53 /******************************************************************/
54 /* Definitions copied from lwlib.h */
56 typedef void * XtPointer;
57 typedef char Boolean;
59 enum button_type
61 BUTTON_TYPE_NONE,
62 BUTTON_TYPE_TOGGLE,
63 BUTTON_TYPE_RADIO
66 /* This structure is based on the one in ../lwlib/lwlib.h, modified
67 for Windows. */
68 typedef struct _widget_value
70 /* name of widget */
71 Lisp_Object lname;
72 char* name;
73 /* value (meaning depend on widget type) */
74 char* value;
75 /* keyboard equivalent. no implications for XtTranslations */
76 Lisp_Object lkey;
77 char* key;
78 /* Help string or nil if none.
79 GC finds this string through the frame's menu_bar_vector
80 or through menu_items. */
81 Lisp_Object help;
82 /* true if enabled */
83 Boolean enabled;
84 /* true if selected */
85 Boolean selected;
86 /* The type of a button. */
87 enum button_type button_type;
88 /* true if menu title */
89 Boolean title;
90 #if 0
91 /* true if was edited (maintained by get_value) */
92 Boolean edited;
93 /* true if has changed (maintained by lw library) */
94 change_type change;
95 /* true if this widget itself has changed,
96 but not counting the other widgets found in the `next' field. */
97 change_type this_one_change;
98 #endif
99 /* Contents of the sub-widgets, also selected slot for checkbox */
100 struct _widget_value* contents;
101 /* data passed to callback */
102 XtPointer call_data;
103 /* next one in the list */
104 struct _widget_value* next;
105 #if 0
106 /* slot for the toolkit dependent part. Always initialize to NULL. */
107 void* toolkit_data;
108 /* tell us if we should free the toolkit data slot when freeing the
109 widget_value itself. */
110 Boolean free_toolkit_data;
112 /* we resource the widget_value structures; this points to the next
113 one on the free list if this one has been deallocated.
115 struct _widget_value *free_list;
116 #endif
117 } widget_value;
119 /* Local memory management */
120 #define local_heap (GetProcessHeap ())
121 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
122 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
124 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
125 #define free_widget_value(wv) (local_free ((wv)))
127 /******************************************************************/
129 #ifndef TRUE
130 #define TRUE 1
131 #define FALSE 0
132 #endif /* no TRUE */
134 HMENU current_popup_menu;
136 void syms_of_w32menu ();
137 void globals_of_w32menu ();
139 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
140 IN HMENU,
141 IN UINT,
142 IN BOOL,
143 IN OUT LPMENUITEMINFOA);
144 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
145 IN HMENU,
146 IN UINT,
147 IN BOOL,
148 IN LPCMENUITEMINFOA);
150 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
151 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
152 AppendMenuW_Proc unicode_append_menu = NULL;
154 Lisp_Object Qdebug_on_next_call;
156 extern Lisp_Object Vmenu_updating_frame;
158 extern Lisp_Object Qmenu_bar;
160 extern Lisp_Object QCtoggle, QCradio;
162 extern Lisp_Object Voverriding_local_map;
163 extern Lisp_Object Voverriding_local_map_menu_flag;
165 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
167 extern Lisp_Object Qmenu_bar_update_hook;
169 void set_frame_menubar ();
171 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
172 Lisp_Object, Lisp_Object, Lisp_Object,
173 Lisp_Object, Lisp_Object));
174 #ifdef HAVE_DIALOGS
175 static Lisp_Object w32_dialog_show ();
176 #endif
177 static Lisp_Object w32_menu_show ();
179 static void keymap_panes ();
180 static void single_keymap_panes ();
181 static void single_menu_item ();
182 static void list_of_panes ();
183 static void list_of_items ();
184 void w32_free_menu_strings (HWND);
186 /* This holds a Lisp vector that holds the results of decoding
187 the keymaps or alist-of-alists that specify a menu.
189 It describes the panes and items within the panes.
191 Each pane is described by 3 elements in the vector:
192 t, the pane name, the pane's prefix key.
193 Then follow the pane's items, with 5 elements per item:
194 the item string, the enable flag, the item's value,
195 the definition, and the equivalent keyboard key's description string.
197 In some cases, multiple levels of menus may be described.
198 A single vector slot containing nil indicates the start of a submenu.
199 A single vector slot containing lambda indicates the end of a submenu.
200 The submenu follows a menu item which is the way to reach the submenu.
202 A single vector slot containing quote indicates that the
203 following items should appear on the right of a dialog box.
205 Using a Lisp vector to hold this information while we decode it
206 takes care of protecting all the data from GC. */
208 #define MENU_ITEMS_PANE_NAME 1
209 #define MENU_ITEMS_PANE_PREFIX 2
210 #define MENU_ITEMS_PANE_LENGTH 3
212 enum menu_item_idx
214 MENU_ITEMS_ITEM_NAME = 0,
215 MENU_ITEMS_ITEM_ENABLE,
216 MENU_ITEMS_ITEM_VALUE,
217 MENU_ITEMS_ITEM_EQUIV_KEY,
218 MENU_ITEMS_ITEM_DEFINITION,
219 MENU_ITEMS_ITEM_TYPE,
220 MENU_ITEMS_ITEM_SELECTED,
221 MENU_ITEMS_ITEM_HELP,
222 MENU_ITEMS_ITEM_LENGTH
225 static Lisp_Object menu_items;
227 /* Number of slots currently allocated in menu_items. */
228 static int menu_items_allocated;
230 /* This is the index in menu_items of the first empty slot. */
231 static int menu_items_used;
233 /* The number of panes currently recorded in menu_items,
234 excluding those within submenus. */
235 static int menu_items_n_panes;
237 /* Current depth within submenus. */
238 static int menu_items_submenu_depth;
240 static int next_menubar_widget_id;
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
249 int pending_menu_activation;
252 /* Return the frame whose ->output_data.w32->menubar_widget equals
253 ID, or 0 if none. */
255 static struct frame *
256 menubar_id_to_frame (id)
257 HMENU id;
259 Lisp_Object tail, frame;
260 FRAME_PTR f;
262 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
264 frame = XCAR (tail);
265 if (!GC_FRAMEP (frame))
266 continue;
267 f = XFRAME (frame);
268 if (!FRAME_WINDOW_P (f))
269 continue;
270 if (f->output_data.w32->menubar_widget == id)
271 return f;
273 return 0;
276 /* Initialize the menu_items structure if we haven't already done so.
277 Also mark it as currently empty. */
279 static void
280 init_menu_items ()
282 if (NILP (menu_items))
284 menu_items_allocated = 60;
285 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
288 menu_items_used = 0;
289 menu_items_n_panes = 0;
290 menu_items_submenu_depth = 0;
293 /* Call at the end of generating the data in menu_items.
294 This fills in the number of items in the last pane. */
296 static void
297 finish_menu_items ()
301 /* Call when finished using the data for the current menu
302 in menu_items. */
304 static void
305 discard_menu_items ()
307 /* Free the structure if it is especially large.
308 Otherwise, hold on to it, to save time. */
309 if (menu_items_allocated > 200)
311 menu_items = Qnil;
312 menu_items_allocated = 0;
316 /* Make the menu_items vector twice as large. */
318 static void
319 grow_menu_items ()
321 Lisp_Object old;
322 int old_size = menu_items_allocated;
323 old = menu_items;
325 menu_items_allocated *= 2;
326 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
327 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
328 old_size * sizeof (Lisp_Object));
331 /* Begin a submenu. */
333 static void
334 push_submenu_start ()
336 if (menu_items_used + 1 > menu_items_allocated)
337 grow_menu_items ();
339 ASET (menu_items, menu_items_used++, Qnil);
340 menu_items_submenu_depth++;
343 /* End a submenu. */
345 static void
346 push_submenu_end ()
348 if (menu_items_used + 1 > menu_items_allocated)
349 grow_menu_items ();
351 ASET (menu_items, menu_items_used++, Qlambda);
352 menu_items_submenu_depth--;
355 /* Indicate boundary between left and right. */
357 static void
358 push_left_right_boundary ()
360 if (menu_items_used + 1 > menu_items_allocated)
361 grow_menu_items ();
363 ASET (menu_items, menu_items_used++, Qquote);
366 /* Start a new menu pane in menu_items.
367 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
369 static void
370 push_menu_pane (name, prefix_vec)
371 Lisp_Object name, prefix_vec;
373 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
374 grow_menu_items ();
376 if (menu_items_submenu_depth == 0)
377 menu_items_n_panes++;
378 ASET (menu_items, menu_items_used++, Qt);
379 ASET (menu_items, menu_items_used++, name);
380 ASET (menu_items, menu_items_used++, prefix_vec);
383 /* Push one menu item into the current pane. NAME is the string to
384 display. ENABLE if non-nil means this item can be selected. KEY
385 is the key generated by choosing this item, or nil if this item
386 doesn't really have a definition. DEF is the definition of this
387 item. EQUIV is the textual description of the keyboard equivalent
388 for this item (or nil if none). TYPE is the type of this menu
389 item, one of nil, `toggle' or `radio'. */
391 static void
392 push_menu_item (name, enable, key, def, equiv, type, selected, help)
393 Lisp_Object name, enable, key, def, equiv, type, selected, help;
395 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
396 grow_menu_items ();
398 ASET (menu_items, menu_items_used++, name);
399 ASET (menu_items, menu_items_used++, enable);
400 ASET (menu_items, menu_items_used++, key);
401 ASET (menu_items, menu_items_used++, equiv);
402 ASET (menu_items, menu_items_used++, def);
403 ASET (menu_items, menu_items_used++, type);
404 ASET (menu_items, menu_items_used++, selected);
405 ASET (menu_items, menu_items_used++, help);
408 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
409 and generate menu panes for them in menu_items.
410 If NOTREAL is nonzero,
411 don't bother really computing whether an item is enabled. */
413 static void
414 keymap_panes (keymaps, nmaps, notreal)
415 Lisp_Object *keymaps;
416 int nmaps;
417 int notreal;
419 int mapno;
421 init_menu_items ();
423 /* Loop over the given keymaps, making a pane for each map.
424 But don't make a pane that is empty--ignore that map instead.
425 P is the number of panes we have made so far. */
426 for (mapno = 0; mapno < nmaps; mapno++)
427 single_keymap_panes (keymaps[mapno],
428 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
430 finish_menu_items ();
433 /* This is a recursive subroutine of keymap_panes.
434 It handles one keymap, KEYMAP.
435 The other arguments are passed along
436 or point to local variables of the previous function.
437 If NOTREAL is nonzero, only check for equivalent key bindings, don't
438 evaluate expressions in menu items and don't make any menu.
440 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
442 static void
443 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
444 Lisp_Object keymap;
445 Lisp_Object pane_name;
446 Lisp_Object prefix;
447 int notreal;
448 int maxdepth;
450 Lisp_Object pending_maps = Qnil;
451 Lisp_Object tail, item;
452 struct gcpro gcpro1, gcpro2;
454 if (maxdepth <= 0)
455 return;
457 push_menu_pane (pane_name, prefix);
459 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
461 GCPRO2 (keymap, pending_maps);
462 /* Look at each key binding, and if it is a menu item add it
463 to this menu. */
464 item = XCAR (tail);
465 if (CONSP (item))
466 single_menu_item (XCAR (item), XCDR (item),
467 &pending_maps, notreal, maxdepth);
468 else if (VECTORP (item))
470 /* Loop over the char values represented in the vector. */
471 int len = ASIZE (item);
472 int c;
473 for (c = 0; c < len; c++)
475 Lisp_Object character;
476 XSETFASTINT (character, c);
477 single_menu_item (character, AREF (item, c),
478 &pending_maps, notreal, maxdepth);
481 UNGCPRO;
484 /* Process now any submenus which want to be panes at this level. */
485 while (!NILP (pending_maps))
487 Lisp_Object elt, eltcdr, string;
488 elt = Fcar (pending_maps);
489 eltcdr = XCDR (elt);
490 string = XCAR (eltcdr);
491 /* We no longer discard the @ from the beginning of the string here.
492 Instead, we do this in w32_menu_show. */
493 single_keymap_panes (Fcar (elt), string,
494 XCDR (eltcdr), notreal, maxdepth - 1);
495 pending_maps = Fcdr (pending_maps);
499 /* This is a subroutine of single_keymap_panes that handles one
500 keymap entry.
501 KEY is a key in a keymap and ITEM is its binding.
502 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
503 separate panes.
504 If NOTREAL is nonzero, only check for equivalent key bindings, don't
505 evaluate expressions in menu items and don't make any menu.
506 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
508 static void
509 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
510 Lisp_Object key, item;
511 Lisp_Object *pending_maps_ptr;
512 int maxdepth, notreal;
514 Lisp_Object map, item_string, enabled;
515 struct gcpro gcpro1, gcpro2;
516 int res;
518 /* Parse the menu item and leave the result in item_properties. */
519 GCPRO2 (key, item);
520 res = parse_menu_item (item, notreal, 0);
521 UNGCPRO;
522 if (!res)
523 return; /* Not a menu item. */
525 map = AREF (item_properties, ITEM_PROPERTY_MAP);
527 if (notreal)
529 /* We don't want to make a menu, just traverse the keymaps to
530 precompute equivalent key bindings. */
531 if (!NILP (map))
532 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
533 return;
536 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
537 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
539 if (!NILP (map) && SREF (item_string, 0) == '@')
541 if (!NILP (enabled))
542 /* An enabled separate pane. Remember this to handle it later. */
543 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
544 *pending_maps_ptr);
545 return;
548 push_menu_item (item_string, enabled, key,
549 AREF (item_properties, ITEM_PROPERTY_DEF),
550 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
551 AREF (item_properties, ITEM_PROPERTY_TYPE),
552 AREF (item_properties, ITEM_PROPERTY_SELECTED),
553 AREF (item_properties, ITEM_PROPERTY_HELP));
555 /* Display a submenu using the toolkit. */
556 if (! (NILP (map) || NILP (enabled)))
558 push_submenu_start ();
559 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
560 push_submenu_end ();
564 /* Push all the panes and items of a menu described by the
565 alist-of-alists MENU.
566 This handles old-fashioned calls to x-popup-menu. */
568 static void
569 list_of_panes (menu)
570 Lisp_Object menu;
572 Lisp_Object tail;
574 init_menu_items ();
576 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
578 Lisp_Object elt, pane_name, pane_data;
579 elt = Fcar (tail);
580 pane_name = Fcar (elt);
581 CHECK_STRING (pane_name);
582 push_menu_pane (pane_name, Qnil);
583 pane_data = Fcdr (elt);
584 CHECK_CONS (pane_data);
585 list_of_items (pane_data);
588 finish_menu_items ();
591 /* Push the items in a single pane defined by the alist PANE. */
593 static void
594 list_of_items (pane)
595 Lisp_Object pane;
597 Lisp_Object tail, item, item1;
599 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
601 item = Fcar (tail);
602 if (STRINGP (item))
603 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
604 else if (NILP (item))
605 push_left_right_boundary ();
606 else
608 CHECK_CONS (item);
609 item1 = Fcar (item);
610 CHECK_STRING (item1);
611 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
616 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
617 doc: /* Pop up a deck-of-cards menu and return user's selection.
618 POSITION is a position specification. This is either a mouse button
619 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
620 are positions in pixels from the top left corner of WINDOW's frame
621 \(WINDOW may be a frame object instead of a window). This controls the
622 position of the center of the first line in the first pane of the
623 menu, not the top left of the menu as a whole. If POSITION is t, it
624 means to use the current mouse position.
626 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
627 The menu items come from key bindings that have a menu string as well as
628 a definition; actually, the \"definition\" in such a key binding looks like
629 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
630 the keymap as a top-level element.
632 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
633 Otherwise, REAL-DEFINITION should be a valid key binding definition.
635 You can also use a list of keymaps as MENU. Then each keymap makes a
636 separate pane. When MENU is a keymap or a list of keymaps, the return
637 value is a list of events.
639 Alternatively, you can specify a menu of multiple panes with a list of
640 the form (TITLE PANE1 PANE2...), where each pane is a list of
641 form (TITLE ITEM1 ITEM2...).
642 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
643 appear as an item--that makes a nonselectable line in the menu.
644 With this form of menu, the return value is VALUE from the chosen item.
646 If POSITION is nil, don't display the menu at all, just precalculate the
647 cached information about equivalent key sequences. */)
648 (position, menu)
649 Lisp_Object position, menu;
651 Lisp_Object keymap, tem;
652 int xpos = 0, ypos = 0;
653 Lisp_Object title;
654 char *error_name;
655 Lisp_Object selection;
656 FRAME_PTR f = NULL;
657 Lisp_Object x, y, window;
658 int keymaps = 0;
659 int for_click = 0;
660 struct gcpro gcpro1;
662 #ifdef HAVE_MENUS
663 if (! NILP (position))
665 check_w32 ();
667 /* Decode the first argument: find the window and the coordinates. */
668 if (EQ (position, Qt)
669 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
670 || EQ (XCAR (position), Qtool_bar))))
672 /* Use the mouse's current position. */
673 FRAME_PTR new_f = SELECTED_FRAME ();
674 Lisp_Object bar_window;
675 enum scroll_bar_part part;
676 unsigned long time;
678 if (mouse_position_hook)
679 (*mouse_position_hook) (&new_f, 1, &bar_window,
680 &part, &x, &y, &time);
681 if (new_f != 0)
682 XSETFRAME (window, new_f);
683 else
685 window = selected_window;
686 XSETFASTINT (x, 0);
687 XSETFASTINT (y, 0);
690 else
692 tem = Fcar (position);
693 if (CONSP (tem))
695 window = Fcar (Fcdr (position));
696 x = Fcar (tem);
697 y = Fcar (Fcdr (tem));
699 else
701 for_click = 1;
702 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
703 window = Fcar (tem); /* POSN_WINDOW (tem) */
704 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
705 x = Fcar (tem);
706 y = Fcdr (tem);
710 CHECK_NUMBER (x);
711 CHECK_NUMBER (y);
713 /* Decode where to put the menu. */
715 if (FRAMEP (window))
717 f = XFRAME (window);
718 xpos = 0;
719 ypos = 0;
721 else if (WINDOWP (window))
723 CHECK_LIVE_WINDOW (window);
724 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
726 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
727 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
729 else
730 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
731 but I don't want to make one now. */
732 CHECK_WINDOW (window);
734 xpos += XINT (x);
735 ypos += XINT (y);
737 XSETFRAME (Vmenu_updating_frame, f);
739 else
740 Vmenu_updating_frame = Qnil;
741 #endif /* HAVE_MENUS */
743 title = Qnil;
744 GCPRO1 (title);
746 /* Decode the menu items from what was specified. */
748 keymap = get_keymap (menu, 0, 0);
749 if (CONSP (keymap))
751 /* We were given a keymap. Extract menu info from the keymap. */
752 Lisp_Object prompt;
754 /* Extract the detailed info to make one pane. */
755 keymap_panes (&menu, 1, NILP (position));
757 /* Search for a string appearing directly as an element of the keymap.
758 That string is the title of the menu. */
759 prompt = Fkeymap_prompt (keymap);
760 if (NILP (title) && !NILP (prompt))
761 title = prompt;
763 /* Make that be the pane title of the first pane. */
764 if (!NILP (prompt) && menu_items_n_panes >= 0)
765 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
767 keymaps = 1;
769 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
771 /* We were given a list of keymaps. */
772 int nmaps = XFASTINT (Flength (menu));
773 Lisp_Object *maps
774 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
775 int i;
777 title = Qnil;
779 /* The first keymap that has a prompt string
780 supplies the menu title. */
781 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
783 Lisp_Object prompt;
785 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
787 prompt = Fkeymap_prompt (keymap);
788 if (NILP (title) && !NILP (prompt))
789 title = prompt;
792 /* Extract the detailed info to make one pane. */
793 keymap_panes (maps, nmaps, NILP (position));
795 /* Make the title be the pane title of the first pane. */
796 if (!NILP (title) && menu_items_n_panes >= 0)
797 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
799 keymaps = 1;
801 else
803 /* We were given an old-fashioned menu. */
804 title = Fcar (menu);
805 CHECK_STRING (title);
807 list_of_panes (Fcdr (menu));
809 keymaps = 0;
812 if (NILP (position))
814 discard_menu_items ();
815 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
816 UNGCPRO;
817 return Qnil;
820 #ifdef HAVE_MENUS
821 /* If resources from a previous popup menu still exist, does nothing
822 until the `menu_free_timer' has freed them (see w32fns.c). This
823 can occur if you press ESC or click outside a menu without selecting
824 a menu item.
826 if (current_popup_menu)
828 discard_menu_items ();
829 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
830 UNGCPRO;
831 return Qnil;
834 /* Display them in a menu. */
835 BLOCK_INPUT;
837 selection = w32_menu_show (f, xpos, ypos, for_click,
838 keymaps, title, &error_name);
839 UNBLOCK_INPUT;
841 discard_menu_items ();
842 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
844 #endif /* HAVE_MENUS */
846 UNGCPRO;
848 if (error_name) error (error_name);
849 return selection;
852 #ifdef HAVE_MENUS
854 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
855 doc: /* Pop up a dialog box and return user's selection.
856 POSITION specifies which frame to use.
857 This is normally a mouse button event or a window or frame.
858 If POSITION is t, it means to use the frame the mouse is on.
859 The dialog box appears in the middle of the specified frame.
861 CONTENTS specifies the alternatives to display in the dialog box.
862 It is a list of the form (TITLE ITEM1 ITEM2...).
863 Each ITEM is a cons cell (STRING . VALUE).
864 The return value is VALUE from the chosen item.
866 An ITEM may also be just a string--that makes a nonselectable item.
867 An ITEM may also be nil--that means to put all preceding items
868 on the left of the dialog box and all following items on the right.
869 \(By default, approximately half appear on each side.)
871 If HEADER is non-nil, the frame title for the box is "Information",
872 otherwise it is "Question". */)
873 (position, contents, header)
874 Lisp_Object position, contents, header;
876 FRAME_PTR f = NULL;
877 Lisp_Object window;
879 check_w32 ();
881 /* Decode the first argument: find the window or frame to use. */
882 if (EQ (position, Qt)
883 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
884 || EQ (XCAR (position), Qtool_bar))))
886 #if 0 /* Using the frame the mouse is on may not be right. */
887 /* Use the mouse's current position. */
888 FRAME_PTR new_f = SELECTED_FRAME ();
889 Lisp_Object bar_window;
890 enum scroll_bar_part part;
891 unsigned long time;
892 Lisp_Object x, y;
894 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
896 if (new_f != 0)
897 XSETFRAME (window, new_f);
898 else
899 window = selected_window;
900 #endif
901 window = selected_window;
903 else if (CONSP (position))
905 Lisp_Object tem;
906 tem = Fcar (position);
907 if (CONSP (tem))
908 window = Fcar (Fcdr (position));
909 else
911 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
912 window = Fcar (tem); /* POSN_WINDOW (tem) */
915 else if (WINDOWP (position) || FRAMEP (position))
916 window = position;
917 else
918 window = Qnil;
920 /* Decode where to put the menu. */
922 if (FRAMEP (window))
923 f = XFRAME (window);
924 else if (WINDOWP (window))
926 CHECK_LIVE_WINDOW (window);
927 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
929 else
930 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
931 but I don't want to make one now. */
932 CHECK_WINDOW (window);
934 #ifndef HAVE_DIALOGS
935 /* Display a menu with these alternatives
936 in the middle of frame F. */
938 Lisp_Object x, y, frame, newpos;
939 XSETFRAME (frame, f);
940 XSETINT (x, x_pixel_width (f) / 2);
941 XSETINT (y, x_pixel_height (f) / 2);
942 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
944 return Fx_popup_menu (newpos,
945 Fcons (Fcar (contents), Fcons (contents, Qnil)));
947 #else /* HAVE_DIALOGS */
949 Lisp_Object title;
950 char *error_name;
951 Lisp_Object selection;
953 /* Decode the dialog items from what was specified. */
954 title = Fcar (contents);
955 CHECK_STRING (title);
957 list_of_panes (Fcons (contents, Qnil));
959 /* Display them in a dialog box. */
960 BLOCK_INPUT;
961 selection = w32_dialog_show (f, 0, title, header, &error_name);
962 UNBLOCK_INPUT;
964 discard_menu_items ();
965 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
967 if (error_name) error (error_name);
968 return selection;
970 #endif /* HAVE_DIALOGS */
973 /* Activate the menu bar of frame F.
974 This is called from keyboard.c when it gets the
975 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
977 To activate the menu bar, we signal to the input thread that it can
978 return from the WM_INITMENU message, allowing the normal Windows
979 processing of the menus.
981 But first we recompute the menu bar contents (the whole tree).
983 This way we can safely execute Lisp code. */
985 void
986 x_activate_menubar (f)
987 FRAME_PTR f;
989 set_frame_menubar (f, 0, 1);
991 /* Lock out further menubar changes while active. */
992 f->output_data.w32->menubar_active = 1;
994 /* Signal input thread to return from WM_INITMENU. */
995 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
998 /* This callback is called from the menu bar pulldown menu
999 when the user makes a selection.
1000 Figure out what the user chose
1001 and put the appropriate events into the keyboard buffer. */
1003 void
1004 menubar_selection_callback (FRAME_PTR f, void * client_data)
1006 Lisp_Object prefix, entry;
1007 Lisp_Object vector;
1008 Lisp_Object *subprefix_stack;
1009 int submenu_depth = 0;
1010 int i;
1012 if (!f)
1013 return;
1014 entry = Qnil;
1015 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1016 vector = f->menu_bar_vector;
1017 prefix = Qnil;
1018 i = 0;
1019 while (i < f->menu_bar_items_used)
1021 if (EQ (AREF (vector, i), Qnil))
1023 subprefix_stack[submenu_depth++] = prefix;
1024 prefix = entry;
1025 i++;
1027 else if (EQ (AREF (vector, i), Qlambda))
1029 prefix = subprefix_stack[--submenu_depth];
1030 i++;
1032 else if (EQ (AREF (vector, i), Qt))
1034 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1035 i += MENU_ITEMS_PANE_LENGTH;
1037 else
1039 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1040 /* The EMACS_INT cast avoids a warning. There's no problem
1041 as long as pointers have enough bits to hold small integers. */
1042 if ((int) (EMACS_INT) client_data == i)
1044 int j;
1045 struct input_event buf;
1046 Lisp_Object frame;
1047 EVENT_INIT (buf);
1049 XSETFRAME (frame, f);
1050 buf.kind = MENU_BAR_EVENT;
1051 buf.frame_or_window = frame;
1052 buf.arg = frame;
1053 kbd_buffer_store_event (&buf);
1055 for (j = 0; j < submenu_depth; j++)
1056 if (!NILP (subprefix_stack[j]))
1058 buf.kind = MENU_BAR_EVENT;
1059 buf.frame_or_window = frame;
1060 buf.arg = subprefix_stack[j];
1061 kbd_buffer_store_event (&buf);
1064 if (!NILP (prefix))
1066 buf.kind = MENU_BAR_EVENT;
1067 buf.frame_or_window = frame;
1068 buf.arg = prefix;
1069 kbd_buffer_store_event (&buf);
1072 buf.kind = MENU_BAR_EVENT;
1073 buf.frame_or_window = frame;
1074 buf.arg = entry;
1075 /* Free memory used by owner-drawn and help-echo strings. */
1076 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1077 kbd_buffer_store_event (&buf);
1079 f->output_data.w32->menubar_active = 0;
1080 return;
1082 i += MENU_ITEMS_ITEM_LENGTH;
1085 /* Free memory used by owner-drawn and help-echo strings. */
1086 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1087 f->output_data.w32->menubar_active = 0;
1090 /* Allocate a widget_value, blocking input. */
1092 widget_value *
1093 xmalloc_widget_value ()
1095 widget_value *value;
1097 BLOCK_INPUT;
1098 value = malloc_widget_value ();
1099 UNBLOCK_INPUT;
1101 return value;
1104 /* This recursively calls free_widget_value on the tree of widgets.
1105 It must free all data that was malloc'ed for these widget_values.
1106 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1107 must be left alone. */
1109 void
1110 free_menubar_widget_value_tree (wv)
1111 widget_value *wv;
1113 if (! wv) return;
1115 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1117 if (wv->contents && (wv->contents != (widget_value*)1))
1119 free_menubar_widget_value_tree (wv->contents);
1120 wv->contents = (widget_value *) 0xDEADBEEF;
1122 if (wv->next)
1124 free_menubar_widget_value_tree (wv->next);
1125 wv->next = (widget_value *) 0xDEADBEEF;
1127 BLOCK_INPUT;
1128 free_widget_value (wv);
1129 UNBLOCK_INPUT;
1132 /* Set up data i menu_items for a menu bar item
1133 whose event type is ITEM_KEY (with string ITEM_NAME)
1134 and whose contents come from the list of keymaps MAPS. */
1136 static int
1137 parse_single_submenu (item_key, item_name, maps)
1138 Lisp_Object item_key, item_name, maps;
1140 Lisp_Object length;
1141 int len;
1142 Lisp_Object *mapvec;
1143 int i;
1144 int top_level_items = 0;
1146 length = Flength (maps);
1147 len = XINT (length);
1149 /* Convert the list MAPS into a vector MAPVEC. */
1150 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1151 for (i = 0; i < len; i++)
1153 mapvec[i] = Fcar (maps);
1154 maps = Fcdr (maps);
1157 /* Loop over the given keymaps, making a pane for each map.
1158 But don't make a pane that is empty--ignore that map instead. */
1159 for (i = 0; i < len; i++)
1161 if (SYMBOLP (mapvec[i])
1162 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1164 /* Here we have a command at top level in the menu bar
1165 as opposed to a submenu. */
1166 top_level_items = 1;
1167 push_menu_pane (Qnil, Qnil);
1168 push_menu_item (item_name, Qt, item_key, mapvec[i],
1169 Qnil, Qnil, Qnil, Qnil);
1171 else
1173 Lisp_Object prompt;
1174 prompt = Fkeymap_prompt (mapvec[i]);
1175 single_keymap_panes (mapvec[i],
1176 !NILP (prompt) ? prompt : item_name,
1177 item_key, 0, 10);
1181 return top_level_items;
1185 /* Create a tree of widget_value objects
1186 representing the panes and items
1187 in menu_items starting at index START, up to index END. */
1189 static widget_value *
1190 digest_single_submenu (start, end, top_level_items)
1191 int start, end, top_level_items;
1193 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1194 int i;
1195 int submenu_depth = 0;
1196 widget_value **submenu_stack;
1198 submenu_stack
1199 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1200 wv = xmalloc_widget_value ();
1201 wv->name = "menu";
1202 wv->value = 0;
1203 wv->enabled = 1;
1204 wv->button_type = BUTTON_TYPE_NONE;
1205 wv->help = Qnil;
1206 first_wv = wv;
1207 save_wv = 0;
1208 prev_wv = 0;
1210 /* Loop over all panes and items made by the preceding call
1211 to parse_single_submenu and construct a tree of widget_value objects.
1212 Ignore the panes and items used by previous calls to
1213 digest_single_submenu, even though those are also in menu_items. */
1214 i = start;
1215 while (i < end)
1217 if (EQ (AREF (menu_items, i), Qnil))
1219 submenu_stack[submenu_depth++] = save_wv;
1220 save_wv = prev_wv;
1221 prev_wv = 0;
1222 i++;
1224 else if (EQ (AREF (menu_items, i), Qlambda))
1226 prev_wv = save_wv;
1227 save_wv = submenu_stack[--submenu_depth];
1228 i++;
1230 else if (EQ (AREF (menu_items, i), Qt)
1231 && submenu_depth != 0)
1232 i += MENU_ITEMS_PANE_LENGTH;
1233 /* Ignore a nil in the item list.
1234 It's meaningful only for dialog boxes. */
1235 else if (EQ (AREF (menu_items, i), Qquote))
1236 i += 1;
1237 else if (EQ (AREF (menu_items, i), Qt))
1239 /* Create a new pane. */
1240 Lisp_Object pane_name, prefix;
1241 char *pane_string;
1243 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1244 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1246 if (STRINGP (pane_name))
1248 if (unicode_append_menu)
1249 /* Encode as UTF-8 for now. */
1250 pane_name = ENCODE_UTF_8 (pane_name);
1251 else if (STRING_MULTIBYTE (pane_name))
1252 pane_name = ENCODE_SYSTEM (pane_name);
1254 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1257 pane_string = (NILP (pane_name)
1258 ? "" : (char *) SDATA (pane_name));
1259 /* If there is just one top-level pane, put all its items directly
1260 under the top-level menu. */
1261 if (menu_items_n_panes == 1)
1262 pane_string = "";
1264 /* If the pane has a meaningful name,
1265 make the pane a top-level menu item
1266 with its items as a submenu beneath it. */
1267 if (strcmp (pane_string, ""))
1269 wv = xmalloc_widget_value ();
1270 if (save_wv)
1271 save_wv->next = wv;
1272 else
1273 first_wv->contents = wv;
1274 wv->lname = pane_name;
1275 /* Set value to 1 so update_submenu_strings can handle '@' */
1276 wv->value = (char *) 1;
1277 wv->enabled = 1;
1278 wv->button_type = BUTTON_TYPE_NONE;
1279 wv->help = Qnil;
1281 save_wv = wv;
1282 prev_wv = 0;
1283 i += MENU_ITEMS_PANE_LENGTH;
1285 else
1287 /* Create a new item within current pane. */
1288 Lisp_Object item_name, enable, descrip, def, type, selected;
1289 Lisp_Object help;
1291 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1292 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1293 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1294 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1295 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1296 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1297 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1299 if (STRINGP (item_name))
1301 if (unicode_append_menu)
1302 item_name = ENCODE_UTF_8 (item_name);
1303 else if (STRING_MULTIBYTE (item_name))
1304 item_name = ENCODE_SYSTEM (item_name);
1306 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1309 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1311 descrip = ENCODE_SYSTEM (descrip);
1312 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1315 wv = xmalloc_widget_value ();
1316 if (prev_wv)
1317 prev_wv->next = wv;
1318 else
1319 save_wv->contents = wv;
1321 wv->lname = item_name;
1322 if (!NILP (descrip))
1323 wv->lkey = descrip;
1324 wv->value = 0;
1325 /* The EMACS_INT cast avoids a warning. There's no problem
1326 as long as pointers have enough bits to hold small integers. */
1327 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1328 wv->enabled = !NILP (enable);
1330 if (NILP (type))
1331 wv->button_type = BUTTON_TYPE_NONE;
1332 else if (EQ (type, QCradio))
1333 wv->button_type = BUTTON_TYPE_RADIO;
1334 else if (EQ (type, QCtoggle))
1335 wv->button_type = BUTTON_TYPE_TOGGLE;
1336 else
1337 abort ();
1339 wv->selected = !NILP (selected);
1340 if (!STRINGP (help))
1341 help = Qnil;
1343 wv->help = help;
1345 prev_wv = wv;
1347 i += MENU_ITEMS_ITEM_LENGTH;
1351 /* If we have just one "menu item"
1352 that was originally a button, return it by itself. */
1353 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1355 wv = first_wv->contents;
1356 free_widget_value (first_wv);
1357 return wv;
1360 return first_wv;
1364 /* Walk through the widget_value tree starting at FIRST_WV and update
1365 the char * pointers from the corresponding lisp values.
1366 We do this after building the whole tree, since GC may happen while the
1367 tree is constructed, and small strings are relocated. So we must wait
1368 until no GC can happen before storing pointers into lisp values. */
1369 static void
1370 update_submenu_strings (first_wv)
1371 widget_value *first_wv;
1373 widget_value *wv;
1375 for (wv = first_wv; wv; wv = wv->next)
1377 if (wv->lname && ! NILP (wv->lname))
1379 wv->name = SDATA (wv->lname);
1381 /* Ignore the @ that means "separate pane".
1382 This is a kludge, but this isn't worth more time. */
1383 if (wv->value == (char *)1)
1385 if (wv->name[0] == '@')
1386 wv->name++;
1387 wv->value = 0;
1391 if (wv->lkey && ! NILP (wv->lkey))
1392 wv->key = SDATA (wv->lkey);
1394 if (wv->contents)
1395 update_submenu_strings (wv->contents);
1400 /* Set the contents of the menubar widgets of frame F.
1401 The argument FIRST_TIME is currently ignored;
1402 it is set the first time this is called, from initialize_frame_menubar. */
1404 void
1405 set_frame_menubar (f, first_time, deep_p)
1406 FRAME_PTR f;
1407 int first_time;
1408 int deep_p;
1410 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1411 Lisp_Object items;
1412 widget_value *wv, *first_wv, *prev_wv = 0;
1413 int i, last_i;
1414 int *submenu_start, *submenu_end;
1415 int *submenu_top_level_items, *submenu_n_panes;
1417 /* We must not change the menubar when actually in use. */
1418 if (f->output_data.w32->menubar_active)
1419 return;
1421 XSETFRAME (Vmenu_updating_frame, f);
1423 if (! menubar_widget)
1424 deep_p = 1;
1425 else if (pending_menu_activation && !deep_p)
1426 deep_p = 1;
1428 if (deep_p)
1430 /* Make a widget-value tree representing the entire menu trees. */
1432 struct buffer *prev = current_buffer;
1433 Lisp_Object buffer;
1434 int specpdl_count = SPECPDL_INDEX ();
1435 int previous_menu_items_used = f->menu_bar_items_used;
1436 Lisp_Object *previous_items
1437 = (Lisp_Object *) alloca (previous_menu_items_used
1438 * sizeof (Lisp_Object));
1440 /* If we are making a new widget, its contents are empty,
1441 do always reinitialize them. */
1442 if (! menubar_widget)
1443 previous_menu_items_used = 0;
1445 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1446 specbind (Qinhibit_quit, Qt);
1447 /* Don't let the debugger step into this code
1448 because it is not reentrant. */
1449 specbind (Qdebug_on_next_call, Qnil);
1451 record_unwind_save_match_data ();
1453 if (NILP (Voverriding_local_map_menu_flag))
1455 specbind (Qoverriding_terminal_local_map, Qnil);
1456 specbind (Qoverriding_local_map, Qnil);
1459 set_buffer_internal_1 (XBUFFER (buffer));
1461 /* Run the Lucid hook. */
1462 safe_run_hooks (Qactivate_menubar_hook);
1463 /* If it has changed current-menubar from previous value,
1464 really recompute the menubar from the value. */
1465 if (! NILP (Vlucid_menu_bar_dirty_flag))
1466 call0 (Qrecompute_lucid_menubar);
1467 safe_run_hooks (Qmenu_bar_update_hook);
1468 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1470 items = FRAME_MENU_BAR_ITEMS (f);
1472 /* Save the frame's previous menu bar contents data. */
1473 if (previous_menu_items_used)
1474 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1475 previous_menu_items_used * sizeof (Lisp_Object));
1477 /* Fill in menu_items with the current menu bar contents.
1478 This can evaluate Lisp code. */
1479 menu_items = f->menu_bar_vector;
1480 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1481 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1482 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1483 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1484 submenu_top_level_items
1485 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1486 init_menu_items ();
1487 for (i = 0; i < ASIZE (items); i += 4)
1489 Lisp_Object key, string, maps;
1491 last_i = i;
1493 key = AREF (items, i);
1494 string = AREF (items, i + 1);
1495 maps = AREF (items, i + 2);
1496 if (NILP (string))
1497 break;
1499 submenu_start[i] = menu_items_used;
1501 menu_items_n_panes = 0;
1502 submenu_top_level_items[i]
1503 = parse_single_submenu (key, string, maps);
1504 submenu_n_panes[i] = menu_items_n_panes;
1506 submenu_end[i] = menu_items_used;
1509 finish_menu_items ();
1511 /* Convert menu_items into widget_value trees
1512 to display the menu. This cannot evaluate Lisp code. */
1514 wv = xmalloc_widget_value ();
1515 wv->name = "menubar";
1516 wv->value = 0;
1517 wv->enabled = 1;
1518 wv->button_type = BUTTON_TYPE_NONE;
1519 wv->help = Qnil;
1520 first_wv = wv;
1522 for (i = 0; i < last_i; i += 4)
1524 menu_items_n_panes = submenu_n_panes[i];
1525 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1526 submenu_top_level_items[i]);
1527 if (prev_wv)
1528 prev_wv->next = wv;
1529 else
1530 first_wv->contents = wv;
1531 /* Don't set wv->name here; GC during the loop might relocate it. */
1532 wv->enabled = 1;
1533 wv->button_type = BUTTON_TYPE_NONE;
1534 prev_wv = wv;
1537 set_buffer_internal_1 (prev);
1538 unbind_to (specpdl_count, Qnil);
1540 /* If there has been no change in the Lisp-level contents
1541 of the menu bar, skip redisplaying it. Just exit. */
1543 for (i = 0; i < previous_menu_items_used; i++)
1544 if (menu_items_used == i
1545 || (!EQ (previous_items[i], AREF (menu_items, i))))
1546 break;
1547 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1549 free_menubar_widget_value_tree (first_wv);
1550 menu_items = Qnil;
1552 return;
1555 /* Now GC cannot happen during the lifetime of the widget_value,
1556 so it's safe to store data from a Lisp_String, as long as
1557 local copies are made when the actual menu is created.
1558 Windows takes care of this for normal string items, but
1559 not for owner-drawn items or additional item-info. */
1560 wv = first_wv->contents;
1561 for (i = 0; i < ASIZE (items); i += 4)
1563 Lisp_Object string;
1564 string = AREF (items, i + 1);
1565 if (NILP (string))
1566 break;
1567 wv->name = (char *) SDATA (string);
1568 update_submenu_strings (wv->contents);
1569 wv = wv->next;
1572 f->menu_bar_vector = menu_items;
1573 f->menu_bar_items_used = menu_items_used;
1574 menu_items = Qnil;
1576 else
1578 /* Make a widget-value tree containing
1579 just the top level menu bar strings. */
1581 wv = xmalloc_widget_value ();
1582 wv->name = "menubar";
1583 wv->value = 0;
1584 wv->enabled = 1;
1585 wv->button_type = BUTTON_TYPE_NONE;
1586 wv->help = Qnil;
1587 first_wv = wv;
1589 items = FRAME_MENU_BAR_ITEMS (f);
1590 for (i = 0; i < ASIZE (items); i += 4)
1592 Lisp_Object string;
1594 string = AREF (items, i + 1);
1595 if (NILP (string))
1596 break;
1598 wv = xmalloc_widget_value ();
1599 wv->name = (char *) SDATA (string);
1600 wv->value = 0;
1601 wv->enabled = 1;
1602 wv->button_type = BUTTON_TYPE_NONE;
1603 wv->help = Qnil;
1604 /* This prevents lwlib from assuming this
1605 menu item is really supposed to be empty. */
1606 /* The EMACS_INT cast avoids a warning.
1607 This value just has to be different from small integers. */
1608 wv->call_data = (void *) (EMACS_INT) (-1);
1610 if (prev_wv)
1611 prev_wv->next = wv;
1612 else
1613 first_wv->contents = wv;
1614 prev_wv = wv;
1617 /* Forget what we thought we knew about what is in the
1618 detailed contents of the menu bar menus.
1619 Changing the top level always destroys the contents. */
1620 f->menu_bar_items_used = 0;
1623 /* Create or update the menu bar widget. */
1625 BLOCK_INPUT;
1627 if (menubar_widget)
1629 /* Empty current menubar, rather than creating a fresh one. */
1630 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1633 else
1635 menubar_widget = CreateMenu ();
1637 fill_in_menu (menubar_widget, first_wv->contents);
1639 free_menubar_widget_value_tree (first_wv);
1642 HMENU old_widget = f->output_data.w32->menubar_widget;
1644 f->output_data.w32->menubar_widget = menubar_widget;
1645 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1646 /* Causes flicker when menu bar is updated
1647 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1649 /* Force the window size to be recomputed so that the frame's text
1650 area remains the same, if menubar has just been created. */
1651 if (old_widget == NULL)
1652 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1655 UNBLOCK_INPUT;
1658 /* Called from Fx_create_frame to create the initial menubar of a frame
1659 before it is mapped, so that the window is mapped with the menubar already
1660 there instead of us tacking it on later and thrashing the window after it
1661 is visible. */
1663 void
1664 initialize_frame_menubar (f)
1665 FRAME_PTR f;
1667 /* This function is called before the first chance to redisplay
1668 the frame. It has to be, so the frame will have the right size. */
1669 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1670 set_frame_menubar (f, 1, 1);
1673 /* Get rid of the menu bar of frame F, and free its storage.
1674 This is used when deleting a frame, and when turning off the menu bar. */
1676 void
1677 free_frame_menubar (f)
1678 FRAME_PTR f;
1680 BLOCK_INPUT;
1683 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1684 SetMenu (FRAME_W32_WINDOW (f), NULL);
1685 f->output_data.w32->menubar_widget = NULL;
1686 DestroyMenu (old);
1689 UNBLOCK_INPUT;
1693 /* w32_menu_show actually displays a menu using the panes and items in
1694 menu_items and returns the value selected from it; we assume input
1695 is blocked by the caller. */
1697 /* F is the frame the menu is for.
1698 X and Y are the frame-relative specified position,
1699 relative to the inside upper left corner of the frame F.
1700 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1701 KEYMAPS is 1 if this menu was specified with keymaps;
1702 in that case, we return a list containing the chosen item's value
1703 and perhaps also the pane's prefix.
1704 TITLE is the specified menu title.
1705 ERROR is a place to store an error message string in case of failure.
1706 (We return nil on failure, but the value doesn't actually matter.) */
1708 static Lisp_Object
1709 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1710 FRAME_PTR f;
1711 int x;
1712 int y;
1713 int for_click;
1714 int keymaps;
1715 Lisp_Object title;
1716 char **error;
1718 int i;
1719 int menu_item_selection;
1720 HMENU menu;
1721 POINT pos;
1722 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1723 widget_value **submenu_stack
1724 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1725 Lisp_Object *subprefix_stack
1726 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1727 int submenu_depth = 0;
1728 int first_pane;
1730 *error = NULL;
1732 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1734 *error = "Empty menu";
1735 return Qnil;
1738 /* Create a tree of widget_value objects
1739 representing the panes and their items. */
1740 wv = xmalloc_widget_value ();
1741 wv->name = "menu";
1742 wv->value = 0;
1743 wv->enabled = 1;
1744 wv->button_type = BUTTON_TYPE_NONE;
1745 wv->help = Qnil;
1746 first_wv = wv;
1747 first_pane = 1;
1749 /* Loop over all panes and items, filling in the tree. */
1750 i = 0;
1751 while (i < menu_items_used)
1753 if (EQ (AREF (menu_items, i), Qnil))
1755 submenu_stack[submenu_depth++] = save_wv;
1756 save_wv = prev_wv;
1757 prev_wv = 0;
1758 first_pane = 1;
1759 i++;
1761 else if (EQ (AREF (menu_items, i), Qlambda))
1763 prev_wv = save_wv;
1764 save_wv = submenu_stack[--submenu_depth];
1765 first_pane = 0;
1766 i++;
1768 else if (EQ (AREF (menu_items, i), Qt)
1769 && submenu_depth != 0)
1770 i += MENU_ITEMS_PANE_LENGTH;
1771 /* Ignore a nil in the item list.
1772 It's meaningful only for dialog boxes. */
1773 else if (EQ (AREF (menu_items, i), Qquote))
1774 i += 1;
1775 else if (EQ (AREF (menu_items, i), Qt))
1777 /* Create a new pane. */
1778 Lisp_Object pane_name, prefix;
1779 char *pane_string;
1780 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1781 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1783 if (STRINGP (pane_name))
1785 if (unicode_append_menu)
1786 pane_name = ENCODE_UTF_8 (pane_name);
1787 else if (STRING_MULTIBYTE (pane_name))
1788 pane_name = ENCODE_SYSTEM (pane_name);
1790 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1793 pane_string = (NILP (pane_name)
1794 ? "" : (char *) SDATA (pane_name));
1795 /* If there is just one top-level pane, put all its items directly
1796 under the top-level menu. */
1797 if (menu_items_n_panes == 1)
1798 pane_string = "";
1800 /* If the pane has a meaningful name,
1801 make the pane a top-level menu item
1802 with its items as a submenu beneath it. */
1803 if (!keymaps && strcmp (pane_string, ""))
1805 wv = xmalloc_widget_value ();
1806 if (save_wv)
1807 save_wv->next = wv;
1808 else
1809 first_wv->contents = wv;
1810 wv->name = pane_string;
1811 if (keymaps && !NILP (prefix))
1812 wv->name++;
1813 wv->value = 0;
1814 wv->enabled = 1;
1815 wv->button_type = BUTTON_TYPE_NONE;
1816 wv->help = Qnil;
1817 save_wv = wv;
1818 prev_wv = 0;
1820 else if (first_pane)
1822 save_wv = wv;
1823 prev_wv = 0;
1825 first_pane = 0;
1826 i += MENU_ITEMS_PANE_LENGTH;
1828 else
1830 /* Create a new item within current pane. */
1831 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1833 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1834 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1835 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1836 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1837 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1838 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1839 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1841 if (STRINGP (item_name))
1843 if (unicode_append_menu)
1844 item_name = ENCODE_UTF_8 (item_name);
1845 else if (STRING_MULTIBYTE (item_name))
1846 item_name = ENCODE_SYSTEM (item_name);
1848 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1851 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1853 descrip = ENCODE_SYSTEM (descrip);
1854 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1857 wv = xmalloc_widget_value ();
1858 if (prev_wv)
1859 prev_wv->next = wv;
1860 else
1861 save_wv->contents = wv;
1862 wv->name = (char *) SDATA (item_name);
1863 if (!NILP (descrip))
1864 wv->key = (char *) SDATA (descrip);
1865 wv->value = 0;
1866 /* Use the contents index as call_data, since we are
1867 restricted to 16-bits. */
1868 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1869 wv->enabled = !NILP (enable);
1871 if (NILP (type))
1872 wv->button_type = BUTTON_TYPE_NONE;
1873 else if (EQ (type, QCtoggle))
1874 wv->button_type = BUTTON_TYPE_TOGGLE;
1875 else if (EQ (type, QCradio))
1876 wv->button_type = BUTTON_TYPE_RADIO;
1877 else
1878 abort ();
1880 wv->selected = !NILP (selected);
1881 if (!STRINGP (help))
1882 help = Qnil;
1884 wv->help = help;
1886 prev_wv = wv;
1888 i += MENU_ITEMS_ITEM_LENGTH;
1892 /* Deal with the title, if it is non-nil. */
1893 if (!NILP (title))
1895 widget_value *wv_title = xmalloc_widget_value ();
1896 widget_value *wv_sep = xmalloc_widget_value ();
1898 /* Maybe replace this separator with a bitmap or owner-draw item
1899 so that it looks better. Having two separators looks odd. */
1900 wv_sep->name = "--";
1901 wv_sep->next = first_wv->contents;
1902 wv_sep->help = Qnil;
1904 if (unicode_append_menu)
1905 title = ENCODE_UTF_8 (title);
1906 else if (STRING_MULTIBYTE (title))
1907 title = ENCODE_SYSTEM (title);
1909 wv_title->name = (char *) SDATA (title);
1910 wv_title->enabled = TRUE;
1911 wv_title->title = TRUE;
1912 wv_title->button_type = BUTTON_TYPE_NONE;
1913 wv_title->help = Qnil;
1914 wv_title->next = wv_sep;
1915 first_wv->contents = wv_title;
1918 /* Actually create the menu. */
1919 current_popup_menu = menu = CreatePopupMenu ();
1920 fill_in_menu (menu, first_wv->contents);
1922 /* Adjust coordinates to be root-window-relative. */
1923 pos.x = x;
1924 pos.y = y;
1925 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1927 /* No selection has been chosen yet. */
1928 menu_item_selection = 0;
1930 /* Display the menu. */
1931 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1932 WM_EMACS_TRACKPOPUPMENU,
1933 (WPARAM)menu, (LPARAM)&pos);
1935 /* Clean up extraneous mouse events which might have been generated
1936 during the call. */
1937 discard_mouse_events ();
1938 FRAME_X_DISPLAY_INFO (f)->grabbed = 0;
1940 /* Free the widget_value objects we used to specify the contents. */
1941 free_menubar_widget_value_tree (first_wv);
1943 DestroyMenu (menu);
1945 /* Free the owner-drawn and help-echo menu strings. */
1946 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1947 f->output_data.w32->menubar_active = 0;
1949 /* Find the selected item, and its pane, to return
1950 the proper value. */
1951 if (menu_item_selection != 0)
1953 Lisp_Object prefix, entry;
1955 prefix = entry = Qnil;
1956 i = 0;
1957 while (i < menu_items_used)
1959 if (EQ (AREF (menu_items, i), Qnil))
1961 subprefix_stack[submenu_depth++] = prefix;
1962 prefix = entry;
1963 i++;
1965 else if (EQ (AREF (menu_items, i), Qlambda))
1967 prefix = subprefix_stack[--submenu_depth];
1968 i++;
1970 else if (EQ (AREF (menu_items, i), Qt))
1972 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1973 i += MENU_ITEMS_PANE_LENGTH;
1975 /* Ignore a nil in the item list.
1976 It's meaningful only for dialog boxes. */
1977 else if (EQ (AREF (menu_items, i), Qquote))
1978 i += 1;
1979 else
1981 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1982 if (menu_item_selection == i)
1984 if (keymaps != 0)
1986 int j;
1988 entry = Fcons (entry, Qnil);
1989 if (!NILP (prefix))
1990 entry = Fcons (prefix, entry);
1991 for (j = submenu_depth - 1; j >= 0; j--)
1992 if (!NILP (subprefix_stack[j]))
1993 entry = Fcons (subprefix_stack[j], entry);
1995 return entry;
1997 i += MENU_ITEMS_ITEM_LENGTH;
2001 else if (!for_click)
2002 /* Make "Cancel" equivalent to C-g. */
2003 Fsignal (Qquit, Qnil);
2005 return Qnil;
2009 #ifdef HAVE_DIALOGS
2010 static char * button_names [] = {
2011 "button1", "button2", "button3", "button4", "button5",
2012 "button6", "button7", "button8", "button9", "button10" };
2014 static Lisp_Object
2015 w32_dialog_show (f, keymaps, title, header, error)
2016 FRAME_PTR f;
2017 int keymaps;
2018 Lisp_Object title, header;
2019 char **error;
2021 int i, nb_buttons=0;
2022 char dialog_name[6];
2023 int menu_item_selection;
2025 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2027 /* Number of elements seen so far, before boundary. */
2028 int left_count = 0;
2029 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2030 int boundary_seen = 0;
2032 *error = NULL;
2034 if (menu_items_n_panes > 1)
2036 *error = "Multiple panes in dialog box";
2037 return Qnil;
2040 /* Create a tree of widget_value objects
2041 representing the text label and buttons. */
2043 Lisp_Object pane_name, prefix;
2044 char *pane_string;
2045 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2046 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2047 pane_string = (NILP (pane_name)
2048 ? "" : (char *) SDATA (pane_name));
2049 prev_wv = xmalloc_widget_value ();
2050 prev_wv->value = pane_string;
2051 if (keymaps && !NILP (prefix))
2052 prev_wv->name++;
2053 prev_wv->enabled = 1;
2054 prev_wv->name = "message";
2055 prev_wv->help = Qnil;
2056 first_wv = prev_wv;
2058 /* Loop over all panes and items, filling in the tree. */
2059 i = MENU_ITEMS_PANE_LENGTH;
2060 while (i < menu_items_used)
2063 /* Create a new item within current pane. */
2064 Lisp_Object item_name, enable, descrip, help;
2066 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2067 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2068 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2069 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2071 if (NILP (item_name))
2073 free_menubar_widget_value_tree (first_wv);
2074 *error = "Submenu in dialog items";
2075 return Qnil;
2077 if (EQ (item_name, Qquote))
2079 /* This is the boundary between left-side elts
2080 and right-side elts. Stop incrementing right_count. */
2081 boundary_seen = 1;
2082 i++;
2083 continue;
2085 if (nb_buttons >= 9)
2087 free_menubar_widget_value_tree (first_wv);
2088 *error = "Too many dialog items";
2089 return Qnil;
2092 wv = xmalloc_widget_value ();
2093 prev_wv->next = wv;
2094 wv->name = (char *) button_names[nb_buttons];
2095 if (!NILP (descrip))
2096 wv->key = (char *) SDATA (descrip);
2097 wv->value = (char *) SDATA (item_name);
2098 wv->call_data = (void *) &AREF (menu_items, i);
2099 wv->enabled = !NILP (enable);
2100 wv->help = Qnil;
2101 prev_wv = wv;
2103 if (! boundary_seen)
2104 left_count++;
2106 nb_buttons++;
2107 i += MENU_ITEMS_ITEM_LENGTH;
2110 /* If the boundary was not specified,
2111 by default put half on the left and half on the right. */
2112 if (! boundary_seen)
2113 left_count = nb_buttons - nb_buttons / 2;
2115 wv = xmalloc_widget_value ();
2116 wv->name = dialog_name;
2117 wv->help = Qnil;
2119 /* Frame title: 'Q' = Question, 'I' = Information.
2120 Can also have 'E' = Error if, one day, we want
2121 a popup for errors. */
2122 if (NILP(header))
2123 dialog_name[0] = 'Q';
2124 else
2125 dialog_name[0] = 'I';
2127 /* Dialog boxes use a really stupid name encoding
2128 which specifies how many buttons to use
2129 and how many buttons are on the right. */
2130 dialog_name[1] = '0' + nb_buttons;
2131 dialog_name[2] = 'B';
2132 dialog_name[3] = 'R';
2133 /* Number of buttons to put on the right. */
2134 dialog_name[4] = '0' + nb_buttons - left_count;
2135 dialog_name[5] = 0;
2136 wv->contents = first_wv;
2137 first_wv = wv;
2140 /* Actually create the dialog. */
2141 dialog_id = widget_id_tick++;
2142 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2143 f->output_data.w32->widget, 1, 0,
2144 dialog_selection_callback, 0);
2145 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2147 /* Free the widget_value objects we used to specify the contents. */
2148 free_menubar_widget_value_tree (first_wv);
2150 /* No selection has been chosen yet. */
2151 menu_item_selection = 0;
2153 /* Display the menu. */
2154 lw_pop_up_all_widgets (dialog_id);
2156 /* Process events that apply to the menu. */
2157 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2159 lw_destroy_all_widgets (dialog_id);
2161 /* Find the selected item, and its pane, to return
2162 the proper value. */
2163 if (menu_item_selection != 0)
2165 Lisp_Object prefix;
2167 prefix = Qnil;
2168 i = 0;
2169 while (i < menu_items_used)
2171 Lisp_Object entry;
2173 if (EQ (AREF (menu_items, i), Qt))
2175 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2176 i += MENU_ITEMS_PANE_LENGTH;
2178 else
2180 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2181 if (menu_item_selection == i)
2183 if (keymaps != 0)
2185 entry = Fcons (entry, Qnil);
2186 if (!NILP (prefix))
2187 entry = Fcons (prefix, entry);
2189 return entry;
2191 i += MENU_ITEMS_ITEM_LENGTH;
2195 else
2196 /* Make "Cancel" equivalent to C-g. */
2197 Fsignal (Qquit, Qnil);
2199 return Qnil;
2201 #endif /* HAVE_DIALOGS */
2204 /* Is this item a separator? */
2205 static int
2206 name_is_separator (name)
2207 char *name;
2209 char *start = name;
2211 /* Check if name string consists of only dashes ('-'). */
2212 while (*name == '-') name++;
2213 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2214 or "--deep-shadow". We don't implement them yet, se we just treat
2215 them like normal separators. */
2216 return (*name == '\0' || start + 2 == name);
2220 /* Indicate boundary between left and right. */
2221 static int
2222 add_left_right_boundary (HMENU menu)
2224 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2227 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2228 static void
2229 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2231 while (len > 0)
2233 int utf16;
2234 if (*src < 0x80)
2236 *dest = (WCHAR) *src;
2237 dest++; src++; len--;
2239 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2240 else if (*src < 0xC0)
2242 src++; len--;
2244 /* 2 char UTF-8 sequence. */
2245 else if (*src < 0xE0)
2247 *dest = (WCHAR) (((*src & 0x1f) << 6)
2248 | (*(src + 1) & 0x3f));
2249 src += 2; len -= 2; dest++;
2251 else if (*src < 0xF0)
2253 *dest = (WCHAR) (((*src & 0x0f) << 12)
2254 | ((*(src + 1) & 0x3f) << 6)
2255 | (*(src + 2) & 0x3f));
2256 src += 3; len -= 3; dest++;
2258 else /* Not encodable. Insert Unicode Substitution char. */
2260 *dest = (WCHAR) 0xfffd;
2261 src++; len--; dest++;
2264 *dest = 0;
2267 static int
2268 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2270 UINT fuFlags;
2271 char *out_string, *p, *q;
2272 int return_value;
2273 size_t nlen, orig_len;
2275 if (name_is_separator (wv->name))
2277 fuFlags = MF_SEPARATOR;
2278 out_string = NULL;
2280 else
2282 if (wv->enabled)
2283 fuFlags = MF_STRING;
2284 else
2285 fuFlags = MF_STRING | MF_GRAYED;
2287 if (wv->key != NULL)
2289 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2290 strcpy (out_string, wv->name);
2291 strcat (out_string, "\t");
2292 strcat (out_string, wv->key);
2294 else
2295 out_string = wv->name;
2297 /* Quote any special characters within the menu item's text and
2298 key binding. */
2299 nlen = orig_len = strlen (out_string);
2300 if (unicode_append_menu)
2302 /* With UTF-8, & cannot be part of a multibyte character. */
2303 for (p = out_string; *p; p++)
2305 if (*p == '&')
2306 nlen++;
2309 else
2311 /* If encoded with the system codepage, use multibyte string
2312 functions in case of multibyte characters that contain '&'. */
2313 for (p = out_string; *p; p = _mbsinc (p))
2315 if (_mbsnextc (p) == '&')
2316 nlen++;
2320 if (nlen > orig_len)
2322 p = out_string;
2323 out_string = alloca (nlen + 1);
2324 q = out_string;
2325 while (*p)
2327 if (unicode_append_menu)
2329 if (*p == '&')
2330 *q++ = *p;
2331 *q++ = *p++;
2333 else
2335 if (_mbsnextc (p) == '&')
2337 _mbsncpy (q, p, 1);
2338 q = _mbsinc (q);
2340 _mbsncpy (q, p, 1);
2341 p = _mbsinc (p);
2342 q = _mbsinc (q);
2345 *q = '\0';
2348 if (item != NULL)
2349 fuFlags = MF_POPUP;
2350 else if (wv->title || wv->call_data == 0)
2352 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2353 we can't deallocate the memory otherwise. */
2354 if (get_menu_item_info)
2356 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2357 strcpy (out_string, wv->name);
2358 #ifdef MENU_DEBUG
2359 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2360 #endif
2361 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2363 else
2364 fuFlags = MF_DISABLED;
2367 /* Draw radio buttons and tickboxes. */
2368 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2369 wv->button_type == BUTTON_TYPE_RADIO))
2370 fuFlags |= MF_CHECKED;
2371 else
2372 fuFlags |= MF_UNCHECKED;
2375 if (unicode_append_menu && out_string)
2377 /* Convert out_string from UTF-8 to UTF-16-LE. */
2378 int utf8_len = strlen (out_string);
2379 WCHAR * utf16_string;
2380 if (fuFlags & MF_OWNERDRAW)
2381 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2382 else
2383 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2385 utf8to16 (out_string, utf8_len, utf16_string);
2386 return_value = unicode_append_menu (menu, fuFlags,
2387 item != NULL ? (UINT) item
2388 : (UINT) wv->call_data,
2389 utf16_string);
2390 if (!return_value)
2392 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2393 apparently does exist at least in some cases and appears to be
2394 stubbed out to do nothing. out_string is UTF-8, but since
2395 our standard menus are in English and this is only going to
2396 happen the first time a menu is used, the encoding is
2397 of minor importance compared with menus not working at all. */
2398 return_value =
2399 AppendMenu (menu, fuFlags,
2400 item != NULL ? (UINT) item: (UINT) wv->call_data,
2401 out_string);
2402 /* Don't use unicode menus in future. */
2403 unicode_append_menu = NULL;
2406 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2407 local_free (out_string);
2409 else
2411 return_value =
2412 AppendMenu (menu,
2413 fuFlags,
2414 item != NULL ? (UINT) item : (UINT) wv->call_data,
2415 out_string );
2418 /* This must be done after the menu item is created. */
2419 if (!wv->title && wv->call_data != 0)
2421 if (set_menu_item_info)
2423 MENUITEMINFO info;
2424 bzero (&info, sizeof (info));
2425 info.cbSize = sizeof (info);
2426 info.fMask = MIIM_DATA;
2428 /* Set help string for menu item. Leave it as a Lisp_Object
2429 until it is ready to be displayed, since GC can happen while
2430 menus are active. */
2431 if (!NILP (wv->help))
2432 #ifdef USE_LISP_UNION_TYPE
2433 info.dwItemData = (DWORD) (wv->help).i;
2434 #else
2435 info.dwItemData = (DWORD) (wv->help);
2436 #endif
2437 if (wv->button_type == BUTTON_TYPE_RADIO)
2439 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2440 RADIO items, but is not available on NT 3.51 and earlier. */
2441 info.fMask |= MIIM_TYPE | MIIM_STATE;
2442 info.fType = MFT_RADIOCHECK | MFT_STRING;
2443 info.dwTypeData = out_string;
2444 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2447 set_menu_item_info (menu,
2448 item != NULL ? (UINT) item : (UINT) wv->call_data,
2449 FALSE, &info);
2452 return return_value;
2455 /* Construct native Windows menu(bar) based on widget_value tree. */
2457 fill_in_menu (HMENU menu, widget_value *wv)
2459 int items_added = 0;
2461 for ( ; wv != NULL; wv = wv->next)
2463 if (wv->contents)
2465 HMENU sub_menu = CreatePopupMenu ();
2467 if (sub_menu == NULL)
2468 return 0;
2470 if (!fill_in_menu (sub_menu, wv->contents) ||
2471 !add_menu_item (menu, wv, sub_menu))
2473 DestroyMenu (sub_menu);
2474 return 0;
2477 else
2479 if (!add_menu_item (menu, wv, NULL))
2480 return 0;
2483 return 1;
2486 /* Display help string for currently pointed to menu item. Not
2487 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2488 available. */
2489 void
2490 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2492 if (get_menu_item_info)
2494 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2495 Lisp_Object frame, help;
2497 /* No help echo on owner-draw menu items, or when the keyboard is used
2498 to navigate the menus, since tooltips are distracting if they pop
2499 up elsewhere. */
2500 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2501 || !(flags & MF_MOUSESELECT))
2502 help = Qnil;
2503 else
2505 MENUITEMINFO info;
2507 bzero (&info, sizeof (info));
2508 info.cbSize = sizeof (info);
2509 info.fMask = MIIM_DATA;
2510 get_menu_item_info (menu, item, FALSE, &info);
2512 #ifdef USE_LISP_UNION_TYPE
2513 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2514 : Qnil;
2515 #else
2516 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2517 #endif
2520 /* Store the help echo in the keyboard buffer as the X toolkit
2521 version does, rather than directly showing it. This seems to
2522 solve the GC problems that were present when we based the
2523 Windows code on the non-toolkit version. */
2524 if (f)
2526 XSETFRAME (frame, f);
2527 kbd_buffer_store_help_event (frame, help);
2529 else
2530 /* X version has a loop through frames here, which doesn't
2531 appear to do anything, unless it has some side effect. */
2532 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2536 /* Free memory used by owner-drawn strings. */
2537 static void
2538 w32_free_submenu_strings (menu)
2539 HMENU menu;
2541 int i, num = GetMenuItemCount (menu);
2542 for (i = 0; i < num; i++)
2544 MENUITEMINFO info;
2545 bzero (&info, sizeof (info));
2546 info.cbSize = sizeof (info);
2547 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2549 get_menu_item_info (menu, i, TRUE, &info);
2551 /* Owner-drawn names are held in dwItemData. */
2552 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2554 #ifdef MENU_DEBUG
2555 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2556 #endif
2557 local_free (info.dwItemData);
2560 /* Recurse down submenus. */
2561 if (info.hSubMenu)
2562 w32_free_submenu_strings (info.hSubMenu);
2566 void
2567 w32_free_menu_strings (hwnd)
2568 HWND hwnd;
2570 HMENU menu = current_popup_menu;
2572 if (get_menu_item_info)
2574 /* If there is no popup menu active, free the strings from the frame's
2575 menubar. */
2576 if (!menu)
2577 menu = GetMenu (hwnd);
2579 if (menu)
2580 w32_free_submenu_strings (menu);
2583 current_popup_menu = NULL;
2586 #endif /* HAVE_MENUS */
2588 /* The following is used by delayed window autoselection. */
2590 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2591 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2594 #ifdef HAVE_MENUS
2595 FRAME_PTR f;
2596 f = SELECTED_FRAME ();
2597 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2598 #else
2599 return Qnil;
2600 #endif /* HAVE_MENUS */
2603 void syms_of_w32menu ()
2605 globals_of_w32menu ();
2606 staticpro (&menu_items);
2607 menu_items = Qnil;
2609 current_popup_menu = NULL;
2611 Qdebug_on_next_call = intern ("debug-on-next-call");
2612 staticpro (&Qdebug_on_next_call);
2614 defsubr (&Sx_popup_menu);
2615 defsubr (&Smenu_or_popup_active_p);
2616 #ifdef HAVE_MENUS
2617 defsubr (&Sx_popup_dialog);
2618 #endif
2622 globals_of_w32menu is used to initialize those global variables that
2623 must always be initialized on startup even when the global variable
2624 initialized is non zero (see the function main in emacs.c).
2625 globals_of_w32menu is called from syms_of_w32menu when the global
2626 variable initialized is 0 and directly from main when initialized
2627 is non zero.
2629 void globals_of_w32menu ()
2631 /* See if Get/SetMenuItemInfo functions are available. */
2632 HMODULE user32 = GetModuleHandle ("user32.dll");
2633 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2634 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2635 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2638 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2639 (do not change this comment) */