(thumbs-view-image-mode-map): Fix `thumbs-set-root' command name typo.
[emacs.git] / src / w32menu.c
blobf3f3eb785b06e4d0ce5a0901b6cbba7175de4ca9
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986,88,93,94,96,98,1999,2003 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 #include <config.h>
22 #include <signal.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "termhooks.h"
27 #include "keyboard.h"
28 #include "keymap.h"
29 #include "frame.h"
30 #include "window.h"
31 #include "blockinput.h"
32 #include "buffer.h"
33 #include "charset.h"
34 #include "coding.h"
36 /* This may include sys/types.h, and that somehow loses
37 if this is not done before the other system files. */
38 #include "w32term.h"
40 /* Load sys/types.h if not already loaded.
41 In some systems loading it twice is suicidal. */
42 #ifndef makedev
43 #include <sys/types.h>
44 #endif
46 #include "dispextern.h"
48 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
50 /******************************************************************/
51 /* Definitions copied from lwlib.h */
53 typedef void * XtPointer;
54 typedef char Boolean;
56 enum button_type
58 BUTTON_TYPE_NONE,
59 BUTTON_TYPE_TOGGLE,
60 BUTTON_TYPE_RADIO
63 /* This structure is based on the one in ../lwlib/lwlib.h, modified
64 for Windows. */
65 typedef struct _widget_value
67 /* name of widget */
68 Lisp_Object lname;
69 char* name;
70 /* value (meaning depend on widget type) */
71 char* value;
72 /* keyboard equivalent. no implications for XtTranslations */
73 Lisp_Object lkey;
74 char* key;
75 /* Help string or nil if none.
76 GC finds this string through the frame's menu_bar_vector
77 or through menu_items. */
78 Lisp_Object help;
79 /* true if enabled */
80 Boolean enabled;
81 /* true if selected */
82 Boolean selected;
83 /* The type of a button. */
84 enum button_type button_type;
85 /* true if menu title */
86 Boolean title;
87 #if 0
88 /* true if was edited (maintained by get_value) */
89 Boolean edited;
90 /* true if has changed (maintained by lw library) */
91 change_type change;
92 /* true if this widget itself has changed,
93 but not counting the other widgets found in the `next' field. */
94 change_type this_one_change;
95 #endif
96 /* Contents of the sub-widgets, also selected slot for checkbox */
97 struct _widget_value* contents;
98 /* data passed to callback */
99 XtPointer call_data;
100 /* next one in the list */
101 struct _widget_value* next;
102 #if 0
103 /* slot for the toolkit dependent part. Always initialize to NULL. */
104 void* toolkit_data;
105 /* tell us if we should free the toolkit data slot when freeing the
106 widget_value itself. */
107 Boolean free_toolkit_data;
109 /* we resource the widget_value structures; this points to the next
110 one on the free list if this one has been deallocated.
112 struct _widget_value *free_list;
113 #endif
114 } widget_value;
116 /* Local memory management */
117 #define local_heap (GetProcessHeap ())
118 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
119 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
121 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
122 #define free_widget_value(wv) (local_free ((wv)))
124 /******************************************************************/
126 #ifndef TRUE
127 #define TRUE 1
128 #define FALSE 0
129 #endif /* no TRUE */
131 static HMENU current_popup_menu;
133 void syms_of_w32menu ();
134 void globals_of_w32menu ();
136 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
137 IN HMENU,
138 IN UINT,
139 IN BOOL,
140 IN OUT LPMENUITEMINFOA);
141 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
142 IN HMENU,
143 IN UINT,
144 IN BOOL,
145 IN LPCMENUITEMINFOA);
146 typedef BOOL (WINAPI * AppendMenuW_Proc) (
147 IN HMENU,
148 IN UINT,
149 IN UINT_PTR,
150 IN LPCWSTR);
152 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
153 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
154 AppendMenuW_Proc unicode_append_menu = NULL;
156 Lisp_Object Vmenu_updating_frame;
158 Lisp_Object Qdebug_on_next_call;
160 extern Lisp_Object Qmenu_bar;
162 extern Lisp_Object QCtoggle, QCradio;
164 extern Lisp_Object Voverriding_local_map;
165 extern Lisp_Object Voverriding_local_map_menu_flag;
167 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
169 extern Lisp_Object Qmenu_bar_update_hook;
171 void set_frame_menubar ();
173 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
174 Lisp_Object, Lisp_Object, Lisp_Object,
175 Lisp_Object, Lisp_Object));
176 #ifdef HAVE_DIALOGS
177 static Lisp_Object w32_dialog_show ();
178 #endif
179 static Lisp_Object w32_menu_show ();
181 static void keymap_panes ();
182 static void single_keymap_panes ();
183 static void single_menu_item ();
184 static void list_of_panes ();
185 static void list_of_items ();
186 void w32_free_menu_strings (HWND);
188 /* This holds a Lisp vector that holds the results of decoding
189 the keymaps or alist-of-alists that specify a menu.
191 It describes the panes and items within the panes.
193 Each pane is described by 3 elements in the vector:
194 t, the pane name, the pane's prefix key.
195 Then follow the pane's items, with 5 elements per item:
196 the item string, the enable flag, the item's value,
197 the definition, and the equivalent keyboard key's description string.
199 In some cases, multiple levels of menus may be described.
200 A single vector slot containing nil indicates the start of a submenu.
201 A single vector slot containing lambda indicates the end of a submenu.
202 The submenu follows a menu item which is the way to reach the submenu.
204 A single vector slot containing quote indicates that the
205 following items should appear on the right of a dialog box.
207 Using a Lisp vector to hold this information while we decode it
208 takes care of protecting all the data from GC. */
210 #define MENU_ITEMS_PANE_NAME 1
211 #define MENU_ITEMS_PANE_PREFIX 2
212 #define MENU_ITEMS_PANE_LENGTH 3
214 enum menu_item_idx
216 MENU_ITEMS_ITEM_NAME = 0,
217 MENU_ITEMS_ITEM_ENABLE,
218 MENU_ITEMS_ITEM_VALUE,
219 MENU_ITEMS_ITEM_EQUIV_KEY,
220 MENU_ITEMS_ITEM_DEFINITION,
221 MENU_ITEMS_ITEM_TYPE,
222 MENU_ITEMS_ITEM_SELECTED,
223 MENU_ITEMS_ITEM_HELP,
224 MENU_ITEMS_ITEM_LENGTH
227 static Lisp_Object menu_items;
229 /* Number of slots currently allocated in menu_items. */
230 static int menu_items_allocated;
232 /* This is the index in menu_items of the first empty slot. */
233 static int menu_items_used;
235 /* The number of panes currently recorded in menu_items,
236 excluding those within submenus. */
237 static int menu_items_n_panes;
239 /* Current depth within submenus. */
240 static int menu_items_submenu_depth;
242 /* Flag which when set indicates a dialog or menu has been posted by
243 Xt on behalf of one of the widget sets. */
244 static int popup_activated_flag;
246 static int next_menubar_widget_id;
248 /* This is set nonzero after the user activates the menu bar, and set
249 to zero again after the menu bars are redisplayed by prepare_menu_bar.
250 While it is nonzero, all calls to set_frame_menubar go deep.
252 I don't understand why this is needed, but it does seem to be
253 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
255 int pending_menu_activation;
258 /* Return the frame whose ->output_data.w32->menubar_widget equals
259 ID, or 0 if none. */
261 static struct frame *
262 menubar_id_to_frame (id)
263 HMENU id;
265 Lisp_Object tail, frame;
266 FRAME_PTR f;
268 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
270 frame = XCAR (tail);
271 if (!GC_FRAMEP (frame))
272 continue;
273 f = XFRAME (frame);
274 if (!FRAME_WINDOW_P (f))
275 continue;
276 if (f->output_data.w32->menubar_widget == id)
277 return f;
279 return 0;
282 /* Initialize the menu_items structure if we haven't already done so.
283 Also mark it as currently empty. */
285 static void
286 init_menu_items ()
288 if (NILP (menu_items))
290 menu_items_allocated = 60;
291 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
294 menu_items_used = 0;
295 menu_items_n_panes = 0;
296 menu_items_submenu_depth = 0;
299 /* Call at the end of generating the data in menu_items.
300 This fills in the number of items in the last pane. */
302 static void
303 finish_menu_items ()
307 /* Call when finished using the data for the current menu
308 in menu_items. */
310 static void
311 discard_menu_items ()
313 /* Free the structure if it is especially large.
314 Otherwise, hold on to it, to save time. */
315 if (menu_items_allocated > 200)
317 menu_items = Qnil;
318 menu_items_allocated = 0;
322 /* Make the menu_items vector twice as large. */
324 static void
325 grow_menu_items ()
327 Lisp_Object old;
328 int old_size = menu_items_allocated;
329 old = menu_items;
331 menu_items_allocated *= 2;
332 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
333 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
334 old_size * sizeof (Lisp_Object));
337 /* Begin a submenu. */
339 static void
340 push_submenu_start ()
342 if (menu_items_used + 1 > menu_items_allocated)
343 grow_menu_items ();
345 ASET (menu_items, menu_items_used++, Qnil);
346 menu_items_submenu_depth++;
349 /* End a submenu. */
351 static void
352 push_submenu_end ()
354 if (menu_items_used + 1 > menu_items_allocated)
355 grow_menu_items ();
357 ASET (menu_items, menu_items_used++, Qlambda);
358 menu_items_submenu_depth--;
361 /* Indicate boundary between left and right. */
363 static void
364 push_left_right_boundary ()
366 if (menu_items_used + 1 > menu_items_allocated)
367 grow_menu_items ();
369 ASET (menu_items, menu_items_used++, Qquote);
372 /* Start a new menu pane in menu_items.
373 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
375 static void
376 push_menu_pane (name, prefix_vec)
377 Lisp_Object name, prefix_vec;
379 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
380 grow_menu_items ();
382 if (menu_items_submenu_depth == 0)
383 menu_items_n_panes++;
384 ASET (menu_items, menu_items_used++, Qt);
385 ASET (menu_items, menu_items_used++, name);
386 ASET (menu_items, menu_items_used++, prefix_vec);
389 /* Push one menu item into the current pane. NAME is the string to
390 display. ENABLE if non-nil means this item can be selected. KEY
391 is the key generated by choosing this item, or nil if this item
392 doesn't really have a definition. DEF is the definition of this
393 item. EQUIV is the textual description of the keyboard equivalent
394 for this item (or nil if none). TYPE is the type of this menu
395 item, one of nil, `toggle' or `radio'. */
397 static void
398 push_menu_item (name, enable, key, def, equiv, type, selected, help)
399 Lisp_Object name, enable, key, def, equiv, type, selected, help;
401 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
402 grow_menu_items ();
404 ASET (menu_items, menu_items_used++, name);
405 ASET (menu_items, menu_items_used++, enable);
406 ASET (menu_items, menu_items_used++, key);
407 ASET (menu_items, menu_items_used++, equiv);
408 ASET (menu_items, menu_items_used++, def);
409 ASET (menu_items, menu_items_used++, type);
410 ASET (menu_items, menu_items_used++, selected);
411 ASET (menu_items, menu_items_used++, help);
414 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
415 and generate menu panes for them in menu_items.
416 If NOTREAL is nonzero,
417 don't bother really computing whether an item is enabled. */
419 static void
420 keymap_panes (keymaps, nmaps, notreal)
421 Lisp_Object *keymaps;
422 int nmaps;
423 int notreal;
425 int mapno;
427 init_menu_items ();
429 /* Loop over the given keymaps, making a pane for each map.
430 But don't make a pane that is empty--ignore that map instead.
431 P is the number of panes we have made so far. */
432 for (mapno = 0; mapno < nmaps; mapno++)
433 single_keymap_panes (keymaps[mapno],
434 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
436 finish_menu_items ();
439 /* This is a recursive subroutine of keymap_panes.
440 It handles one keymap, KEYMAP.
441 The other arguments are passed along
442 or point to local variables of the previous function.
443 If NOTREAL is nonzero, only check for equivalent key bindings, don't
444 evaluate expressions in menu items and don't make any menu.
446 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
448 static void
449 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
450 Lisp_Object keymap;
451 Lisp_Object pane_name;
452 Lisp_Object prefix;
453 int notreal;
454 int maxdepth;
456 Lisp_Object pending_maps = Qnil;
457 Lisp_Object tail, item;
458 struct gcpro gcpro1, gcpro2;
460 if (maxdepth <= 0)
461 return;
463 push_menu_pane (pane_name, prefix);
465 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
467 GCPRO2 (keymap, pending_maps);
468 /* Look at each key binding, and if it is a menu item add it
469 to this menu. */
470 item = XCAR (tail);
471 if (CONSP (item))
472 single_menu_item (XCAR (item), XCDR (item),
473 &pending_maps, notreal, maxdepth);
474 else if (VECTORP (item))
476 /* Loop over the char values represented in the vector. */
477 int len = ASIZE (item);
478 int c;
479 for (c = 0; c < len; c++)
481 Lisp_Object character;
482 XSETFASTINT (character, c);
483 single_menu_item (character, AREF (item, c),
484 &pending_maps, notreal, maxdepth);
487 UNGCPRO;
490 /* Process now any submenus which want to be panes at this level. */
491 while (!NILP (pending_maps))
493 Lisp_Object elt, eltcdr, string;
494 elt = Fcar (pending_maps);
495 eltcdr = XCDR (elt);
496 string = XCAR (eltcdr);
497 /* We no longer discard the @ from the beginning of the string here.
498 Instead, we do this in w32_menu_show. */
499 single_keymap_panes (Fcar (elt), string,
500 XCDR (eltcdr), notreal, maxdepth - 1);
501 pending_maps = Fcdr (pending_maps);
505 /* This is a subroutine of single_keymap_panes that handles one
506 keymap entry.
507 KEY is a key in a keymap and ITEM is its binding.
508 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
509 separate panes.
510 If NOTREAL is nonzero, only check for equivalent key bindings, don't
511 evaluate expressions in menu items and don't make any menu.
512 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
514 static void
515 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
516 Lisp_Object key, item;
517 Lisp_Object *pending_maps_ptr;
518 int maxdepth, notreal;
520 Lisp_Object map, item_string, enabled;
521 struct gcpro gcpro1, gcpro2;
522 int res;
524 /* Parse the menu item and leave the result in item_properties. */
525 GCPRO2 (key, item);
526 res = parse_menu_item (item, notreal, 0);
527 UNGCPRO;
528 if (!res)
529 return; /* Not a menu item. */
531 map = AREF (item_properties, ITEM_PROPERTY_MAP);
533 if (notreal)
535 /* We don't want to make a menu, just traverse the keymaps to
536 precompute equivalent key bindings. */
537 if (!NILP (map))
538 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
539 return;
542 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
543 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
545 if (!NILP (map) && SREF (item_string, 0) == '@')
547 if (!NILP (enabled))
548 /* An enabled separate pane. Remember this to handle it later. */
549 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
550 *pending_maps_ptr);
551 return;
554 push_menu_item (item_string, enabled, key,
555 AREF (item_properties, ITEM_PROPERTY_DEF),
556 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
557 AREF (item_properties, ITEM_PROPERTY_TYPE),
558 AREF (item_properties, ITEM_PROPERTY_SELECTED),
559 AREF (item_properties, ITEM_PROPERTY_HELP));
561 /* Display a submenu using the toolkit. */
562 if (! (NILP (map) || NILP (enabled)))
564 push_submenu_start ();
565 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
566 push_submenu_end ();
570 /* Push all the panes and items of a menu described by the
571 alist-of-alists MENU.
572 This handles old-fashioned calls to x-popup-menu. */
574 static void
575 list_of_panes (menu)
576 Lisp_Object menu;
578 Lisp_Object tail;
580 init_menu_items ();
582 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
584 Lisp_Object elt, pane_name, pane_data;
585 elt = Fcar (tail);
586 pane_name = Fcar (elt);
587 CHECK_STRING (pane_name);
588 push_menu_pane (pane_name, Qnil);
589 pane_data = Fcdr (elt);
590 CHECK_CONS (pane_data);
591 list_of_items (pane_data);
594 finish_menu_items ();
597 /* Push the items in a single pane defined by the alist PANE. */
599 static void
600 list_of_items (pane)
601 Lisp_Object pane;
603 Lisp_Object tail, item, item1;
605 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
607 item = Fcar (tail);
608 if (STRINGP (item))
609 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
610 else if (NILP (item))
611 push_left_right_boundary ();
612 else
614 CHECK_CONS (item);
615 item1 = Fcar (item);
616 CHECK_STRING (item1);
617 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
622 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
623 doc: /* Pop up a deck-of-cards menu and return user's selection.
624 POSITION is a position specification. This is either a mouse button
625 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
626 are positions in pixels from the top left corner of WINDOW's frame
627 \(WINDOW may be a frame object instead of a window). This controls the
628 position of the center of the first line in the first pane of the
629 menu, not the top left of the menu as a whole. If POSITION is t, it
630 means to use the current mouse position.
632 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
633 The menu items come from key bindings that have a menu string as well as
634 a definition; actually, the \"definition\" in such a key binding looks like
635 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
636 the keymap as a top-level element.
638 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
639 Otherwise, REAL-DEFINITION should be a valid key binding definition.
641 You can also use a list of keymaps as MENU. Then each keymap makes a
642 separate pane. When MENU is a keymap or a list of keymaps, the return
643 value is a list of events.
645 Alternatively, you can specify a menu of multiple panes with a list of
646 the form (TITLE PANE1 PANE2...), where each pane is a list of
647 form (TITLE ITEM1 ITEM2...).
648 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
649 appear as an item--that makes a nonselectable line in the menu.
650 With this form of menu, the return value is VALUE from the chosen item.
652 If POSITION is nil, don't display the menu at all, just precalculate the
653 cached information about equivalent key sequences. */)
654 (position, menu)
655 Lisp_Object position, menu;
657 Lisp_Object keymap, tem;
658 int xpos = 0, ypos = 0;
659 Lisp_Object title;
660 char *error_name;
661 Lisp_Object selection;
662 FRAME_PTR f = NULL;
663 Lisp_Object x, y, window;
664 int keymaps = 0;
665 int for_click = 0;
666 struct gcpro gcpro1;
668 #ifdef HAVE_MENUS
669 if (! NILP (position))
671 check_w32 ();
673 /* Decode the first argument: find the window and the coordinates. */
674 if (EQ (position, Qt)
675 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
676 || EQ (XCAR (position), Qtool_bar))))
678 /* Use the mouse's current position. */
679 FRAME_PTR new_f = SELECTED_FRAME ();
680 Lisp_Object bar_window;
681 enum scroll_bar_part part;
682 unsigned long time;
684 if (mouse_position_hook)
685 (*mouse_position_hook) (&new_f, 1, &bar_window,
686 &part, &x, &y, &time);
687 if (new_f != 0)
688 XSETFRAME (window, new_f);
689 else
691 window = selected_window;
692 XSETFASTINT (x, 0);
693 XSETFASTINT (y, 0);
696 else
698 tem = Fcar (position);
699 if (CONSP (tem))
701 window = Fcar (Fcdr (position));
702 x = Fcar (tem);
703 y = Fcar (Fcdr (tem));
705 else
707 for_click = 1;
708 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
709 window = Fcar (tem); /* POSN_WINDOW (tem) */
710 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
711 x = Fcar (tem);
712 y = Fcdr (tem);
716 CHECK_NUMBER (x);
717 CHECK_NUMBER (y);
719 /* Decode where to put the menu. */
721 if (FRAMEP (window))
723 f = XFRAME (window);
724 xpos = 0;
725 ypos = 0;
727 else if (WINDOWP (window))
729 CHECK_LIVE_WINDOW (window);
730 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
732 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
733 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
735 else
736 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
737 but I don't want to make one now. */
738 CHECK_WINDOW (window);
740 xpos += XINT (x);
741 ypos += XINT (y);
743 XSETFRAME (Vmenu_updating_frame, f);
745 Vmenu_updating_frame = Qnil;
746 #endif /* HAVE_MENUS */
748 title = Qnil;
749 GCPRO1 (title);
751 /* Decode the menu items from what was specified. */
753 keymap = get_keymap (menu, 0, 0);
754 if (CONSP (keymap))
756 /* We were given a keymap. Extract menu info from the keymap. */
757 Lisp_Object prompt;
759 /* Extract the detailed info to make one pane. */
760 keymap_panes (&menu, 1, NILP (position));
762 /* Search for a string appearing directly as an element of the keymap.
763 That string is the title of the menu. */
764 prompt = Fkeymap_prompt (keymap);
765 if (NILP (title) && !NILP (prompt))
766 title = prompt;
768 /* Make that be the pane title of the first pane. */
769 if (!NILP (prompt) && menu_items_n_panes >= 0)
770 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
772 keymaps = 1;
774 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
776 /* We were given a list of keymaps. */
777 int nmaps = XFASTINT (Flength (menu));
778 Lisp_Object *maps
779 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
780 int i;
782 title = Qnil;
784 /* The first keymap that has a prompt string
785 supplies the menu title. */
786 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
788 Lisp_Object prompt;
790 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
792 prompt = Fkeymap_prompt (keymap);
793 if (NILP (title) && !NILP (prompt))
794 title = prompt;
797 /* Extract the detailed info to make one pane. */
798 keymap_panes (maps, nmaps, NILP (position));
800 /* Make the title be the pane title of the first pane. */
801 if (!NILP (title) && menu_items_n_panes >= 0)
802 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
804 keymaps = 1;
806 else
808 /* We were given an old-fashioned menu. */
809 title = Fcar (menu);
810 CHECK_STRING (title);
812 list_of_panes (Fcdr (menu));
814 keymaps = 0;
817 if (NILP (position))
819 discard_menu_items ();
820 UNGCPRO;
821 return Qnil;
824 #ifdef HAVE_MENUS
825 /* If resources from a previous popup menu exist yet, does nothing
826 until the `menu_free_timer' has freed them (see w32fns.c).
828 if (current_popup_menu)
830 discard_menu_items ();
831 UNGCPRO;
832 return Qnil;
835 /* Display them in a menu. */
836 BLOCK_INPUT;
838 selection = w32_menu_show (f, xpos, ypos, for_click,
839 keymaps, title, &error_name);
840 UNBLOCK_INPUT;
842 discard_menu_items ();
843 #endif /* HAVE_MENUS */
845 UNGCPRO;
847 if (error_name) error (error_name);
848 return selection;
851 #ifdef HAVE_MENUS
853 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
854 doc: /* Pop up a dialog box and return user's selection.
855 POSITION specifies which frame to use.
856 This is normally a mouse button event or a window or frame.
857 If POSITION is t, it means to use the frame the mouse is on.
858 The dialog box appears in the middle of the specified frame.
860 CONTENTS specifies the alternatives to display in the dialog box.
861 It is a list of the form (TITLE ITEM1 ITEM2...).
862 Each ITEM is a cons cell (STRING . VALUE).
863 The return value is VALUE from the chosen item.
865 An ITEM may also be just a string--that makes a nonselectable item.
866 An ITEM may also be nil--that means to put all preceding items
867 on the left of the dialog box and all following items on the right.
868 \(By default, approximately half appear on each side.) */)
869 (position, contents)
870 Lisp_Object position, contents;
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, &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 kbd_buffer_store_event (&buf);
1072 /* Free memory used by owner-drawn and help-echo strings. */
1073 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1074 f->output_data.w32->menu_command_in_progress = 0;
1075 f->output_data.w32->menubar_active = 0;
1076 return;
1078 i += MENU_ITEMS_ITEM_LENGTH;
1081 /* Free memory used by owner-drawn and help-echo strings. */
1082 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1083 f->output_data.w32->menu_command_in_progress = 0;
1084 f->output_data.w32->menubar_active = 0;
1087 /* Allocate a widget_value, blocking input. */
1089 widget_value *
1090 xmalloc_widget_value ()
1092 widget_value *value;
1094 BLOCK_INPUT;
1095 value = malloc_widget_value ();
1096 UNBLOCK_INPUT;
1098 return value;
1101 /* This recursively calls free_widget_value on the tree of widgets.
1102 It must free all data that was malloc'ed for these widget_values.
1103 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1104 must be left alone. */
1106 void
1107 free_menubar_widget_value_tree (wv)
1108 widget_value *wv;
1110 if (! wv) return;
1112 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1114 if (wv->contents && (wv->contents != (widget_value*)1))
1116 free_menubar_widget_value_tree (wv->contents);
1117 wv->contents = (widget_value *) 0xDEADBEEF;
1119 if (wv->next)
1121 free_menubar_widget_value_tree (wv->next);
1122 wv->next = (widget_value *) 0xDEADBEEF;
1124 BLOCK_INPUT;
1125 free_widget_value (wv);
1126 UNBLOCK_INPUT;
1129 /* Set up data i menu_items for a menu bar item
1130 whose event type is ITEM_KEY (with string ITEM_NAME)
1131 and whose contents come from the list of keymaps MAPS. */
1133 static int
1134 parse_single_submenu (item_key, item_name, maps)
1135 Lisp_Object item_key, item_name, maps;
1137 Lisp_Object length;
1138 int len;
1139 Lisp_Object *mapvec;
1140 int i;
1141 int top_level_items = 0;
1143 length = Flength (maps);
1144 len = XINT (length);
1146 /* Convert the list MAPS into a vector MAPVEC. */
1147 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1148 for (i = 0; i < len; i++)
1150 mapvec[i] = Fcar (maps);
1151 maps = Fcdr (maps);
1154 /* Loop over the given keymaps, making a pane for each map.
1155 But don't make a pane that is empty--ignore that map instead. */
1156 for (i = 0; i < len; i++)
1158 if (SYMBOLP (mapvec[i])
1159 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1161 /* Here we have a command at top level in the menu bar
1162 as opposed to a submenu. */
1163 top_level_items = 1;
1164 push_menu_pane (Qnil, Qnil);
1165 push_menu_item (item_name, Qt, item_key, mapvec[i],
1166 Qnil, Qnil, Qnil, Qnil);
1168 else
1170 Lisp_Object prompt;
1171 prompt = Fkeymap_prompt (mapvec[i]);
1172 single_keymap_panes (mapvec[i],
1173 !NILP (prompt) ? prompt : item_name,
1174 item_key, 0, 10);
1178 return top_level_items;
1182 /* Create a tree of widget_value objects
1183 representing the panes and items
1184 in menu_items starting at index START, up to index END. */
1186 static widget_value *
1187 digest_single_submenu (start, end, top_level_items)
1188 int start, end, top_level_items;
1190 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1191 int i;
1192 int submenu_depth = 0;
1193 widget_value **submenu_stack;
1195 submenu_stack
1196 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1197 wv = xmalloc_widget_value ();
1198 wv->name = "menu";
1199 wv->value = 0;
1200 wv->enabled = 1;
1201 wv->button_type = BUTTON_TYPE_NONE;
1202 wv->help = Qnil;
1203 first_wv = wv;
1204 save_wv = 0;
1205 prev_wv = 0;
1207 /* Loop over all panes and items made by the preceding call
1208 to parse_single_submenu and construct a tree of widget_value objects.
1209 Ignore the panes and items used by previous calls to
1210 digest_single_submenu, even though those are also in menu_items. */
1211 i = start;
1212 while (i < end)
1214 if (EQ (AREF (menu_items, i), Qnil))
1216 submenu_stack[submenu_depth++] = save_wv;
1217 save_wv = prev_wv;
1218 prev_wv = 0;
1219 i++;
1221 else if (EQ (AREF (menu_items, i), Qlambda))
1223 prev_wv = save_wv;
1224 save_wv = submenu_stack[--submenu_depth];
1225 i++;
1227 else if (EQ (AREF (menu_items, i), Qt)
1228 && submenu_depth != 0)
1229 i += MENU_ITEMS_PANE_LENGTH;
1230 /* Ignore a nil in the item list.
1231 It's meaningful only for dialog boxes. */
1232 else if (EQ (AREF (menu_items, i), Qquote))
1233 i += 1;
1234 else if (EQ (AREF (menu_items, i), Qt))
1236 /* Create a new pane. */
1237 Lisp_Object pane_name, prefix;
1238 char *pane_string;
1240 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1241 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1243 if (STRINGP (pane_name))
1245 if (unicode_append_menu)
1246 /* Encode as UTF-8 for now. */
1247 pane_name = ENCODE_UTF_8 (pane_name);
1248 else if (STRING_MULTIBYTE (pane_name))
1249 pane_name = ENCODE_SYSTEM (pane_name);
1251 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1254 pane_string = (NILP (pane_name)
1255 ? "" : (char *) SDATA (pane_name));
1256 /* If there is just one top-level pane, put all its items directly
1257 under the top-level menu. */
1258 if (menu_items_n_panes == 1)
1259 pane_string = "";
1261 /* If the pane has a meaningful name,
1262 make the pane a top-level menu item
1263 with its items as a submenu beneath it. */
1264 if (strcmp (pane_string, ""))
1266 wv = xmalloc_widget_value ();
1267 if (save_wv)
1268 save_wv->next = wv;
1269 else
1270 first_wv->contents = wv;
1271 wv->lname = pane_name;
1272 /* Set value to 1 so update_submenu_strings can handle '@' */
1273 wv->value = (char *) 1;
1274 wv->enabled = 1;
1275 wv->button_type = BUTTON_TYPE_NONE;
1276 wv->help = Qnil;
1278 save_wv = wv;
1279 prev_wv = 0;
1280 i += MENU_ITEMS_PANE_LENGTH;
1282 else
1284 /* Create a new item within current pane. */
1285 Lisp_Object item_name, enable, descrip, def, type, selected;
1286 Lisp_Object help;
1288 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1289 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1290 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1291 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1292 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1293 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1294 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1296 if (STRINGP (item_name))
1298 if (unicode_append_menu)
1299 item_name = ENCODE_UTF_8 (item_name);
1300 else if (STRING_MULTIBYTE (item_name))
1301 item_name = ENCODE_SYSTEM (item_name);
1303 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1306 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1308 descrip = ENCODE_SYSTEM (descrip);
1309 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1312 wv = xmalloc_widget_value ();
1313 if (prev_wv)
1314 prev_wv->next = wv;
1315 else
1316 save_wv->contents = wv;
1318 wv->lname = item_name;
1319 if (!NILP (descrip))
1320 wv->lkey = descrip;
1321 wv->value = 0;
1322 /* The EMACS_INT cast avoids a warning. There's no problem
1323 as long as pointers have enough bits to hold small integers. */
1324 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1325 wv->enabled = !NILP (enable);
1327 if (NILP (type))
1328 wv->button_type = BUTTON_TYPE_NONE;
1329 else if (EQ (type, QCradio))
1330 wv->button_type = BUTTON_TYPE_RADIO;
1331 else if (EQ (type, QCtoggle))
1332 wv->button_type = BUTTON_TYPE_TOGGLE;
1333 else
1334 abort ();
1336 wv->selected = !NILP (selected);
1337 if (!STRINGP (help))
1338 help = Qnil;
1340 wv->help = help;
1342 prev_wv = wv;
1344 i += MENU_ITEMS_ITEM_LENGTH;
1348 /* If we have just one "menu item"
1349 that was originally a button, return it by itself. */
1350 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1352 wv = first_wv->contents;
1353 free_widget_value (first_wv);
1354 return wv;
1357 return first_wv;
1361 /* Walk through the widget_value tree starting at FIRST_WV and update
1362 the char * pointers from the corresponding lisp values.
1363 We do this after building the whole tree, since GC may happen while the
1364 tree is constructed, and small strings are relocated. So we must wait
1365 until no GC can happen before storing pointers into lisp values. */
1366 static void
1367 update_submenu_strings (first_wv)
1368 widget_value *first_wv;
1370 widget_value *wv;
1372 for (wv = first_wv; wv; wv = wv->next)
1374 if (wv->lname && ! NILP (wv->lname))
1376 wv->name = SDATA (wv->lname);
1378 /* Ignore the @ that means "separate pane".
1379 This is a kludge, but this isn't worth more time. */
1380 if (wv->value == (char *)1)
1382 if (wv->name[0] == '@')
1383 wv->name++;
1384 wv->value = 0;
1388 if (wv->lkey && ! NILP (wv->lkey))
1389 wv->key = SDATA (wv->lkey);
1391 if (wv->contents)
1392 update_submenu_strings (wv->contents);
1397 /* Set the contents of the menubar widgets of frame F.
1398 The argument FIRST_TIME is currently ignored;
1399 it is set the first time this is called, from initialize_frame_menubar. */
1401 void
1402 set_frame_menubar (f, first_time, deep_p)
1403 FRAME_PTR f;
1404 int first_time;
1405 int deep_p;
1407 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1408 Lisp_Object items;
1409 widget_value *wv, *first_wv, *prev_wv = 0;
1410 int i, last_i;
1411 int *submenu_start, *submenu_end;
1412 int *submenu_top_level_items, *submenu_n_panes;
1414 /* We must not change the menubar when actually in use. */
1415 if (f->output_data.w32->menubar_active)
1416 return;
1418 XSETFRAME (Vmenu_updating_frame, f);
1420 if (! menubar_widget)
1421 deep_p = 1;
1422 else if (pending_menu_activation && !deep_p)
1423 deep_p = 1;
1425 if (deep_p)
1427 /* Make a widget-value tree representing the entire menu trees. */
1429 struct buffer *prev = current_buffer;
1430 Lisp_Object buffer;
1431 int specpdl_count = SPECPDL_INDEX ();
1432 int previous_menu_items_used = f->menu_bar_items_used;
1433 Lisp_Object *previous_items
1434 = (Lisp_Object *) alloca (previous_menu_items_used
1435 * sizeof (Lisp_Object));
1437 /* If we are making a new widget, its contents are empty,
1438 do always reinitialize them. */
1439 if (! menubar_widget)
1440 previous_menu_items_used = 0;
1442 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1443 specbind (Qinhibit_quit, Qt);
1444 /* Don't let the debugger step into this code
1445 because it is not reentrant. */
1446 specbind (Qdebug_on_next_call, Qnil);
1448 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1449 if (NILP (Voverriding_local_map_menu_flag))
1451 specbind (Qoverriding_terminal_local_map, Qnil);
1452 specbind (Qoverriding_local_map, Qnil);
1455 set_buffer_internal_1 (XBUFFER (buffer));
1457 /* Run the Lucid hook. */
1458 safe_run_hooks (Qactivate_menubar_hook);
1459 /* If it has changed current-menubar from previous value,
1460 really recompute the menubar from the value. */
1461 if (! NILP (Vlucid_menu_bar_dirty_flag))
1462 call0 (Qrecompute_lucid_menubar);
1463 safe_run_hooks (Qmenu_bar_update_hook);
1464 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1466 items = FRAME_MENU_BAR_ITEMS (f);
1468 /* Save the frame's previous menu bar contents data. */
1469 if (previous_menu_items_used)
1470 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1471 previous_menu_items_used * sizeof (Lisp_Object));
1473 /* Fill in menu_items with the current menu bar contents.
1474 This can evaluate Lisp code. */
1475 menu_items = f->menu_bar_vector;
1476 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1477 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1478 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1479 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1480 submenu_top_level_items
1481 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1482 init_menu_items ();
1483 for (i = 0; i < ASIZE (items); i += 4)
1485 Lisp_Object key, string, maps;
1487 last_i = i;
1489 key = AREF (items, i);
1490 string = AREF (items, i + 1);
1491 maps = AREF (items, i + 2);
1492 if (NILP (string))
1493 break;
1495 submenu_start[i] = menu_items_used;
1497 menu_items_n_panes = 0;
1498 submenu_top_level_items[i]
1499 = parse_single_submenu (key, string, maps);
1500 submenu_n_panes[i] = menu_items_n_panes;
1502 submenu_end[i] = menu_items_used;
1505 finish_menu_items ();
1507 /* Convert menu_items into widget_value trees
1508 to display the menu. This cannot evaluate Lisp code. */
1510 wv = xmalloc_widget_value ();
1511 wv->name = "menubar";
1512 wv->value = 0;
1513 wv->enabled = 1;
1514 wv->button_type = BUTTON_TYPE_NONE;
1515 wv->help = Qnil;
1516 first_wv = wv;
1518 for (i = 0; i < last_i; i += 4)
1520 menu_items_n_panes = submenu_n_panes[i];
1521 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1522 submenu_top_level_items[i]);
1523 if (prev_wv)
1524 prev_wv->next = wv;
1525 else
1526 first_wv->contents = wv;
1527 /* Don't set wv->name here; GC during the loop might relocate it. */
1528 wv->enabled = 1;
1529 wv->button_type = BUTTON_TYPE_NONE;
1530 prev_wv = wv;
1533 set_buffer_internal_1 (prev);
1534 unbind_to (specpdl_count, Qnil);
1536 /* If there has been no change in the Lisp-level contents
1537 of the menu bar, skip redisplaying it. Just exit. */
1539 for (i = 0; i < previous_menu_items_used; i++)
1540 if (menu_items_used == i
1541 || (!EQ (previous_items[i], AREF (menu_items, i))))
1542 break;
1543 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1545 free_menubar_widget_value_tree (first_wv);
1546 menu_items = Qnil;
1548 return;
1551 /* Now GC cannot happen during the lifetime of the widget_value,
1552 so it's safe to store data from a Lisp_String, as long as
1553 local copies are made when the actual menu is created.
1554 Windows takes care of this for normal string items, but
1555 not for owner-drawn items or additional item-info. */
1556 wv = first_wv->contents;
1557 for (i = 0; i < ASIZE (items); i += 4)
1559 Lisp_Object string;
1560 string = AREF (items, i + 1);
1561 if (NILP (string))
1562 break;
1563 wv->name = (char *) SDATA (string);
1564 update_submenu_strings (wv->contents);
1565 wv = wv->next;
1568 f->menu_bar_vector = menu_items;
1569 f->menu_bar_items_used = menu_items_used;
1570 menu_items = Qnil;
1572 else
1574 /* Make a widget-value tree containing
1575 just the top level menu bar strings. */
1577 wv = xmalloc_widget_value ();
1578 wv->name = "menubar";
1579 wv->value = 0;
1580 wv->enabled = 1;
1581 wv->button_type = BUTTON_TYPE_NONE;
1582 wv->help = Qnil;
1583 first_wv = wv;
1585 items = FRAME_MENU_BAR_ITEMS (f);
1586 for (i = 0; i < ASIZE (items); i += 4)
1588 Lisp_Object string;
1590 string = AREF (items, i + 1);
1591 if (NILP (string))
1592 break;
1594 wv = xmalloc_widget_value ();
1595 wv->name = (char *) SDATA (string);
1596 wv->value = 0;
1597 wv->enabled = 1;
1598 wv->button_type = BUTTON_TYPE_NONE;
1599 wv->help = Qnil;
1600 /* This prevents lwlib from assuming this
1601 menu item is really supposed to be empty. */
1602 /* The EMACS_INT cast avoids a warning.
1603 This value just has to be different from small integers. */
1604 wv->call_data = (void *) (EMACS_INT) (-1);
1606 if (prev_wv)
1607 prev_wv->next = wv;
1608 else
1609 first_wv->contents = wv;
1610 prev_wv = wv;
1613 /* Forget what we thought we knew about what is in the
1614 detailed contents of the menu bar menus.
1615 Changing the top level always destroys the contents. */
1616 f->menu_bar_items_used = 0;
1619 /* Create or update the menu bar widget. */
1621 BLOCK_INPUT;
1623 if (menubar_widget)
1625 /* Empty current menubar, rather than creating a fresh one. */
1626 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1629 else
1631 menubar_widget = CreateMenu ();
1633 fill_in_menu (menubar_widget, first_wv->contents);
1635 free_menubar_widget_value_tree (first_wv);
1638 HMENU old_widget = f->output_data.w32->menubar_widget;
1640 f->output_data.w32->menubar_widget = menubar_widget;
1641 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1642 /* Causes flicker when menu bar is updated
1643 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1645 /* Force the window size to be recomputed so that the frame's text
1646 area remains the same, if menubar has just been created. */
1647 if (old_widget == NULL)
1648 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1651 UNBLOCK_INPUT;
1654 /* Called from Fx_create_frame to create the initial menubar of a frame
1655 before it is mapped, so that the window is mapped with the menubar already
1656 there instead of us tacking it on later and thrashing the window after it
1657 is visible. */
1659 void
1660 initialize_frame_menubar (f)
1661 FRAME_PTR f;
1663 /* This function is called before the first chance to redisplay
1664 the frame. It has to be, so the frame will have the right size. */
1665 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1666 set_frame_menubar (f, 1, 1);
1669 /* Get rid of the menu bar of frame F, and free its storage.
1670 This is used when deleting a frame, and when turning off the menu bar. */
1672 void
1673 free_frame_menubar (f)
1674 FRAME_PTR f;
1676 BLOCK_INPUT;
1679 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1680 SetMenu (FRAME_W32_WINDOW (f), NULL);
1681 f->output_data.w32->menubar_widget = NULL;
1682 DestroyMenu (old);
1685 UNBLOCK_INPUT;
1689 /* w32_menu_show actually displays a menu using the panes and items in
1690 menu_items and returns the value selected from it; we assume input
1691 is blocked by the caller. */
1693 /* F is the frame the menu is for.
1694 X and Y are the frame-relative specified position,
1695 relative to the inside upper left corner of the frame F.
1696 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1697 KEYMAPS is 1 if this menu was specified with keymaps;
1698 in that case, we return a list containing the chosen item's value
1699 and perhaps also the pane's prefix.
1700 TITLE is the specified menu title.
1701 ERROR is a place to store an error message string in case of failure.
1702 (We return nil on failure, but the value doesn't actually matter.) */
1704 static Lisp_Object
1705 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1706 FRAME_PTR f;
1707 int x;
1708 int y;
1709 int for_click;
1710 int keymaps;
1711 Lisp_Object title;
1712 char **error;
1714 int i;
1715 int menu_item_selection;
1716 HMENU menu;
1717 POINT pos;
1718 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1719 widget_value **submenu_stack
1720 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1721 Lisp_Object *subprefix_stack
1722 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1723 int submenu_depth = 0;
1724 int first_pane;
1726 *error = NULL;
1728 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1730 *error = "Empty menu";
1731 return Qnil;
1734 /* Create a tree of widget_value objects
1735 representing the panes and their items. */
1736 wv = xmalloc_widget_value ();
1737 wv->name = "menu";
1738 wv->value = 0;
1739 wv->enabled = 1;
1740 wv->button_type = BUTTON_TYPE_NONE;
1741 wv->help = Qnil;
1742 first_wv = wv;
1743 first_pane = 1;
1745 /* Loop over all panes and items, filling in the tree. */
1746 i = 0;
1747 while (i < menu_items_used)
1749 if (EQ (AREF (menu_items, i), Qnil))
1751 submenu_stack[submenu_depth++] = save_wv;
1752 save_wv = prev_wv;
1753 prev_wv = 0;
1754 first_pane = 1;
1755 i++;
1757 else if (EQ (AREF (menu_items, i), Qlambda))
1759 prev_wv = save_wv;
1760 save_wv = submenu_stack[--submenu_depth];
1761 first_pane = 0;
1762 i++;
1764 else if (EQ (AREF (menu_items, i), Qt)
1765 && submenu_depth != 0)
1766 i += MENU_ITEMS_PANE_LENGTH;
1767 /* Ignore a nil in the item list.
1768 It's meaningful only for dialog boxes. */
1769 else if (EQ (AREF (menu_items, i), Qquote))
1770 i += 1;
1771 else if (EQ (AREF (menu_items, i), Qt))
1773 /* Create a new pane. */
1774 Lisp_Object pane_name, prefix;
1775 char *pane_string;
1776 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1777 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1779 if (STRINGP (pane_name))
1781 if (unicode_append_menu)
1782 pane_name = ENCODE_UTF_8 (pane_name);
1783 else if (STRING_MULTIBYTE (pane_name))
1784 pane_name = ENCODE_SYSTEM (pane_name);
1786 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1789 pane_string = (NILP (pane_name)
1790 ? "" : (char *) SDATA (pane_name));
1791 /* If there is just one top-level pane, put all its items directly
1792 under the top-level menu. */
1793 if (menu_items_n_panes == 1)
1794 pane_string = "";
1796 /* If the pane has a meaningful name,
1797 make the pane a top-level menu item
1798 with its items as a submenu beneath it. */
1799 if (!keymaps && strcmp (pane_string, ""))
1801 wv = xmalloc_widget_value ();
1802 if (save_wv)
1803 save_wv->next = wv;
1804 else
1805 first_wv->contents = wv;
1806 wv->name = pane_string;
1807 if (keymaps && !NILP (prefix))
1808 wv->name++;
1809 wv->value = 0;
1810 wv->enabled = 1;
1811 wv->button_type = BUTTON_TYPE_NONE;
1812 wv->help = Qnil;
1813 save_wv = wv;
1814 prev_wv = 0;
1816 else if (first_pane)
1818 save_wv = wv;
1819 prev_wv = 0;
1821 first_pane = 0;
1822 i += MENU_ITEMS_PANE_LENGTH;
1824 else
1826 /* Create a new item within current pane. */
1827 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1829 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1830 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1831 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1832 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1833 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1834 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1835 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1837 if (STRINGP (item_name))
1839 if (unicode_append_menu)
1840 item_name = ENCODE_UTF_8 (item_name);
1841 else if (STRING_MULTIBYTE (item_name))
1842 item_name = ENCODE_SYSTEM (item_name);
1844 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1847 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1849 descrip = ENCODE_SYSTEM (descrip);
1850 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1853 wv = xmalloc_widget_value ();
1854 if (prev_wv)
1855 prev_wv->next = wv;
1856 else
1857 save_wv->contents = wv;
1858 wv->name = (char *) SDATA (item_name);
1859 if (!NILP (descrip))
1860 wv->key = (char *) SDATA (descrip);
1861 wv->value = 0;
1862 /* Use the contents index as call_data, since we are
1863 restricted to 16-bits. */
1864 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1865 wv->enabled = !NILP (enable);
1867 if (NILP (type))
1868 wv->button_type = BUTTON_TYPE_NONE;
1869 else if (EQ (type, QCtoggle))
1870 wv->button_type = BUTTON_TYPE_TOGGLE;
1871 else if (EQ (type, QCradio))
1872 wv->button_type = BUTTON_TYPE_RADIO;
1873 else
1874 abort ();
1876 wv->selected = !NILP (selected);
1877 if (!STRINGP (help))
1878 help = Qnil;
1880 wv->help = help;
1882 prev_wv = wv;
1884 i += MENU_ITEMS_ITEM_LENGTH;
1888 /* Deal with the title, if it is non-nil. */
1889 if (!NILP (title))
1891 widget_value *wv_title = xmalloc_widget_value ();
1892 widget_value *wv_sep = xmalloc_widget_value ();
1894 /* Maybe replace this separator with a bitmap or owner-draw item
1895 so that it looks better. Having two separators looks odd. */
1896 wv_sep->name = "--";
1897 wv_sep->next = first_wv->contents;
1898 wv_sep->help = Qnil;
1900 if (unicode_append_menu)
1901 title = ENCODE_UTF_8 (title);
1902 else if (STRING_MULTIBYTE (title))
1903 title = ENCODE_SYSTEM (title);
1905 wv_title->name = (char *) SDATA (title);
1906 wv_title->enabled = TRUE;
1907 wv_title->title = TRUE;
1908 wv_title->button_type = BUTTON_TYPE_NONE;
1909 wv_title->help = Qnil;
1910 wv_title->next = wv_sep;
1911 first_wv->contents = wv_title;
1914 /* Actually create the menu. */
1915 current_popup_menu = menu = CreatePopupMenu ();
1916 fill_in_menu (menu, first_wv->contents);
1918 /* Adjust coordinates to be root-window-relative. */
1919 pos.x = x;
1920 pos.y = y;
1921 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1923 /* No selection has been chosen yet. */
1924 menu_item_selection = 0;
1926 /* Display the menu. */
1927 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1928 WM_EMACS_TRACKPOPUPMENU,
1929 (WPARAM)menu, (LPARAM)&pos);
1931 /* Clean up extraneous mouse events which might have been generated
1932 during the call. */
1933 discard_mouse_events ();
1935 /* Free the widget_value objects we used to specify the contents. */
1936 free_menubar_widget_value_tree (first_wv);
1938 DestroyMenu (menu);
1940 /* Find the selected item, and its pane, to return
1941 the proper value. */
1942 if (menu_item_selection != 0)
1944 Lisp_Object prefix, entry;
1946 prefix = entry = Qnil;
1947 i = 0;
1948 while (i < menu_items_used)
1950 if (EQ (AREF (menu_items, i), Qnil))
1952 subprefix_stack[submenu_depth++] = prefix;
1953 prefix = entry;
1954 i++;
1956 else if (EQ (AREF (menu_items, i), Qlambda))
1958 prefix = subprefix_stack[--submenu_depth];
1959 i++;
1961 else if (EQ (AREF (menu_items, i), Qt))
1963 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1964 i += MENU_ITEMS_PANE_LENGTH;
1966 /* Ignore a nil in the item list.
1967 It's meaningful only for dialog boxes. */
1968 else if (EQ (AREF (menu_items, i), Qquote))
1969 i += 1;
1970 else
1972 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1973 if (menu_item_selection == i)
1975 if (keymaps != 0)
1977 int j;
1979 entry = Fcons (entry, Qnil);
1980 if (!NILP (prefix))
1981 entry = Fcons (prefix, entry);
1982 for (j = submenu_depth - 1; j >= 0; j--)
1983 if (!NILP (subprefix_stack[j]))
1984 entry = Fcons (subprefix_stack[j], entry);
1986 return entry;
1988 i += MENU_ITEMS_ITEM_LENGTH;
1993 return Qnil;
1997 #ifdef HAVE_DIALOGS
1998 static char * button_names [] = {
1999 "button1", "button2", "button3", "button4", "button5",
2000 "button6", "button7", "button8", "button9", "button10" };
2002 static Lisp_Object
2003 w32_dialog_show (f, keymaps, title, error)
2004 FRAME_PTR f;
2005 int keymaps;
2006 Lisp_Object title;
2007 char **error;
2009 int i, nb_buttons=0;
2010 char dialog_name[6];
2011 int menu_item_selection;
2013 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2015 /* Number of elements seen so far, before boundary. */
2016 int left_count = 0;
2017 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2018 int boundary_seen = 0;
2020 *error = NULL;
2022 if (menu_items_n_panes > 1)
2024 *error = "Multiple panes in dialog box";
2025 return Qnil;
2028 /* Create a tree of widget_value objects
2029 representing the text label and buttons. */
2031 Lisp_Object pane_name, prefix;
2032 char *pane_string;
2033 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2034 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2035 pane_string = (NILP (pane_name)
2036 ? "" : (char *) SDATA (pane_name));
2037 prev_wv = xmalloc_widget_value ();
2038 prev_wv->value = pane_string;
2039 if (keymaps && !NILP (prefix))
2040 prev_wv->name++;
2041 prev_wv->enabled = 1;
2042 prev_wv->name = "message";
2043 prev_wv->help = Qnil;
2044 first_wv = prev_wv;
2046 /* Loop over all panes and items, filling in the tree. */
2047 i = MENU_ITEMS_PANE_LENGTH;
2048 while (i < menu_items_used)
2051 /* Create a new item within current pane. */
2052 Lisp_Object item_name, enable, descrip, help;
2054 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2055 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2056 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2057 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2059 if (NILP (item_name))
2061 free_menubar_widget_value_tree (first_wv);
2062 *error = "Submenu in dialog items";
2063 return Qnil;
2065 if (EQ (item_name, Qquote))
2067 /* This is the boundary between left-side elts
2068 and right-side elts. Stop incrementing right_count. */
2069 boundary_seen = 1;
2070 i++;
2071 continue;
2073 if (nb_buttons >= 9)
2075 free_menubar_widget_value_tree (first_wv);
2076 *error = "Too many dialog items";
2077 return Qnil;
2080 wv = xmalloc_widget_value ();
2081 prev_wv->next = wv;
2082 wv->name = (char *) button_names[nb_buttons];
2083 if (!NILP (descrip))
2084 wv->key = (char *) SDATA (descrip);
2085 wv->value = (char *) SDATA (item_name);
2086 wv->call_data = (void *) &AREF (menu_items, i);
2087 wv->enabled = !NILP (enable);
2088 wv->help = Qnil;
2089 prev_wv = wv;
2091 if (! boundary_seen)
2092 left_count++;
2094 nb_buttons++;
2095 i += MENU_ITEMS_ITEM_LENGTH;
2098 /* If the boundary was not specified,
2099 by default put half on the left and half on the right. */
2100 if (! boundary_seen)
2101 left_count = nb_buttons - nb_buttons / 2;
2103 wv = xmalloc_widget_value ();
2104 wv->name = dialog_name;
2105 wv->help = Qnil;
2107 /* Dialog boxes use a really stupid name encoding
2108 which specifies how many buttons to use
2109 and how many buttons are on the right.
2110 The Q means something also. */
2111 dialog_name[0] = 'Q';
2112 dialog_name[1] = '0' + nb_buttons;
2113 dialog_name[2] = 'B';
2114 dialog_name[3] = 'R';
2115 /* Number of buttons to put on the right. */
2116 dialog_name[4] = '0' + nb_buttons - left_count;
2117 dialog_name[5] = 0;
2118 wv->contents = first_wv;
2119 first_wv = wv;
2122 /* Actually create the dialog. */
2123 dialog_id = widget_id_tick++;
2124 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2125 f->output_data.w32->widget, 1, 0,
2126 dialog_selection_callback, 0);
2127 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2129 /* Free the widget_value objects we used to specify the contents. */
2130 free_menubar_widget_value_tree (first_wv);
2132 /* No selection has been chosen yet. */
2133 menu_item_selection = 0;
2135 /* Display the menu. */
2136 lw_pop_up_all_widgets (dialog_id);
2137 popup_activated_flag = 1;
2139 /* Process events that apply to the menu. */
2140 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2142 lw_destroy_all_widgets (dialog_id);
2144 /* Find the selected item, and its pane, to return
2145 the proper value. */
2146 if (menu_item_selection != 0)
2148 Lisp_Object prefix;
2150 prefix = Qnil;
2151 i = 0;
2152 while (i < menu_items_used)
2154 Lisp_Object entry;
2156 if (EQ (AREF (menu_items, i), Qt))
2158 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2159 i += MENU_ITEMS_PANE_LENGTH;
2161 else
2163 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2164 if (menu_item_selection == i)
2166 if (keymaps != 0)
2168 entry = Fcons (entry, Qnil);
2169 if (!NILP (prefix))
2170 entry = Fcons (prefix, entry);
2172 return entry;
2174 i += MENU_ITEMS_ITEM_LENGTH;
2179 return Qnil;
2181 #endif /* HAVE_DIALOGS */
2184 /* Is this item a separator? */
2185 static int
2186 name_is_separator (name)
2187 char *name;
2189 char *start = name;
2191 /* Check if name string consists of only dashes ('-'). */
2192 while (*name == '-') name++;
2193 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2194 or "--deep-shadow". We don't implement them yet, se we just treat
2195 them like normal separators. */
2196 return (*name == '\0' || start + 2 == name);
2200 /* Indicate boundary between left and right. */
2201 static int
2202 add_left_right_boundary (HMENU menu)
2204 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2207 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2208 static void
2209 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2211 while (len > 0)
2213 int utf16;
2214 if (*src < 0x80)
2216 *dest = (WCHAR) *src;
2217 dest++; src++; len--;
2219 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2220 else if (*src < 0xC0)
2222 src++; len--;
2224 /* 2 char UTF-8 sequence. */
2225 else if (*src < 0xE0)
2227 *dest = (WCHAR) (((*src & 0x1f) << 6)
2228 | (*(src + 1) & 0x3f));
2229 src += 2; len -= 2; dest++;
2231 else if (*src < 0xF0)
2233 *dest = (WCHAR) (((*src & 0x0f) << 12)
2234 | ((*(src + 1) & 0x3f) << 6)
2235 | (*(src + 2) & 0x3f));
2236 src += 3; len -= 3; dest++;
2238 else /* Not encodable. Insert Unicode Substitution char. */
2240 *dest = (WCHAR) 0xfffd;
2241 src++; len--; dest++;
2244 *dest = 0;
2247 static int
2248 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2250 UINT fuFlags;
2251 char *out_string;
2252 int return_value;
2254 if (name_is_separator (wv->name))
2256 fuFlags = MF_SEPARATOR;
2257 out_string = NULL;
2259 else
2261 if (wv->enabled)
2262 fuFlags = MF_STRING;
2263 else
2264 fuFlags = MF_STRING | MF_GRAYED;
2266 if (wv->key != NULL)
2268 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2269 strcpy (out_string, wv->name);
2270 strcat (out_string, "\t");
2271 strcat (out_string, wv->key);
2273 else
2274 out_string = wv->name;
2276 if (item != NULL)
2277 fuFlags = MF_POPUP;
2278 else if (wv->title || wv->call_data == 0)
2280 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2281 we can't deallocate the memory otherwise. */
2282 if (get_menu_item_info)
2284 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2285 strcpy (out_string, wv->name);
2286 #ifdef MENU_DEBUG
2287 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2288 #endif
2289 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2291 else
2292 fuFlags = MF_DISABLED;
2295 /* Draw radio buttons and tickboxes. */
2296 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2297 wv->button_type == BUTTON_TYPE_RADIO))
2298 fuFlags |= MF_CHECKED;
2299 else
2300 fuFlags |= MF_UNCHECKED;
2303 if (unicode_append_menu && out_string)
2305 /* Convert out_string from UTF-8 to UTF-16-LE. */
2306 int utf8_len = strlen (out_string);
2307 WCHAR * utf16_string;
2308 if (fuFlags & MF_OWNERDRAW)
2309 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2310 else
2311 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2313 utf8to16 (out_string, utf8_len, utf16_string);
2314 return_value = unicode_append_menu (menu, fuFlags,
2315 item != NULL ? (UINT) item
2316 : (UINT) wv->call_data,
2317 utf16_string);
2318 if (fuFlags & MF_OWNERDRAW)
2319 local_free (out_string);
2321 else
2323 return_value =
2324 AppendMenu (menu,
2325 fuFlags,
2326 item != NULL ? (UINT) item : (UINT) wv->call_data,
2327 out_string );
2330 /* This must be done after the menu item is created. */
2331 if (!wv->title && wv->call_data != 0)
2333 if (set_menu_item_info)
2335 MENUITEMINFO info;
2336 bzero (&info, sizeof (info));
2337 info.cbSize = sizeof (info);
2338 info.fMask = MIIM_DATA;
2340 /* Set help string for menu item. Leave it as a Lisp_Object
2341 until it is ready to be displayed, since GC can happen while
2342 menus are active. */
2343 if (!NILP (wv->help))
2344 #ifdef USE_LISP_UNION_TYPE
2345 info.dwItemData = (DWORD) (wv->help).i;
2346 #else
2347 info.dwItemData = (DWORD) (wv->help);
2348 #endif
2349 if (wv->button_type == BUTTON_TYPE_RADIO)
2351 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2352 RADIO items, but is not available on NT 3.51 and earlier. */
2353 info.fMask |= MIIM_TYPE | MIIM_STATE;
2354 info.fType = MFT_RADIOCHECK | MFT_STRING;
2355 info.dwTypeData = out_string;
2356 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2359 set_menu_item_info (menu,
2360 item != NULL ? (UINT) item : (UINT) wv->call_data,
2361 FALSE, &info);
2364 return return_value;
2367 /* Construct native Windows menu(bar) based on widget_value tree. */
2369 fill_in_menu (HMENU menu, widget_value *wv)
2371 int items_added = 0;
2373 for ( ; wv != NULL; wv = wv->next)
2375 if (wv->contents)
2377 HMENU sub_menu = CreatePopupMenu ();
2379 if (sub_menu == NULL)
2380 return 0;
2382 if (!fill_in_menu (sub_menu, wv->contents) ||
2383 !add_menu_item (menu, wv, sub_menu))
2385 DestroyMenu (sub_menu);
2386 return 0;
2389 else
2391 if (!add_menu_item (menu, wv, NULL))
2392 return 0;
2395 return 1;
2399 popup_activated ()
2401 /* popup_activated_flag not actually used on W32 */
2402 return 0;
2405 /* Display help string for currently pointed to menu item. Not
2406 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2407 available. */
2408 void
2409 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2411 if (get_menu_item_info)
2413 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2414 Lisp_Object frame, help;
2416 /* No help echo on owner-draw menu items. */
2417 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2418 help = Qnil;
2419 else
2421 MENUITEMINFO info;
2423 bzero (&info, sizeof (info));
2424 info.cbSize = sizeof (info);
2425 info.fMask = MIIM_DATA;
2426 get_menu_item_info (menu, item, FALSE, &info);
2428 #ifdef USE_LISP_UNION_TYPE
2429 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2430 : Qnil;
2431 #else
2432 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2433 #endif
2436 /* Store the help echo in the keyboard buffer as the X toolkit
2437 version does, rather than directly showing it. This seems to
2438 solve the GC problems that were present when we based the
2439 Windows code on the non-toolkit version. */
2440 if (f)
2442 XSETFRAME (frame, f);
2443 kbd_buffer_store_help_event (frame, help);
2445 else
2446 /* X version has a loop through frames here, which doesn't
2447 appear to do anything, unless it has some side effect. */
2448 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2452 /* Free memory used by owner-drawn strings. */
2453 static void
2454 w32_free_submenu_strings (menu)
2455 HMENU menu;
2457 int i, num = GetMenuItemCount (menu);
2458 for (i = 0; i < num; i++)
2460 MENUITEMINFO info;
2461 bzero (&info, sizeof (info));
2462 info.cbSize = sizeof (info);
2463 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2465 get_menu_item_info (menu, i, TRUE, &info);
2467 /* Owner-drawn names are held in dwItemData. */
2468 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2470 #ifdef MENU_DEBUG
2471 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2472 #endif
2473 local_free (info.dwItemData);
2476 /* Recurse down submenus. */
2477 if (info.hSubMenu)
2478 w32_free_submenu_strings (info.hSubMenu);
2482 void
2483 w32_free_menu_strings (hwnd)
2484 HWND hwnd;
2486 HMENU menu = current_popup_menu;
2488 if (get_menu_item_info)
2490 /* If there is no popup menu active, free the strings from the frame's
2491 menubar. */
2492 if (!menu)
2493 menu = GetMenu (hwnd);
2495 if (menu)
2496 w32_free_submenu_strings (menu);
2499 current_popup_menu = NULL;
2502 #endif /* HAVE_MENUS */
2504 void syms_of_w32menu ()
2506 globals_of_w32menu ();
2507 staticpro (&menu_items);
2508 menu_items = Qnil;
2510 current_popup_menu = NULL;
2512 Qdebug_on_next_call = intern ("debug-on-next-call");
2513 staticpro (&Qdebug_on_next_call);
2515 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2516 doc: /* Frame for which we are updating a menu.
2517 The enable predicate for a menu command should check this variable. */);
2518 Vmenu_updating_frame = Qnil;
2520 defsubr (&Sx_popup_menu);
2521 #ifdef HAVE_MENUS
2522 defsubr (&Sx_popup_dialog);
2523 #endif
2527 globals_of_w32menu is used to initialize those global variables that
2528 must always be initialized on startup even when the global variable
2529 initialized is non zero (see the function main in emacs.c).
2530 globals_of_w32menu is called from syms_of_w32menu when the global
2531 variable initialized is 0 and directly from main when initialized
2532 is non zero.
2534 void globals_of_w32menu ()
2536 /* See if Get/SetMenuItemInfo functions are available. */
2537 HMODULE user32 = GetModuleHandle ("user32.dll");
2538 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2539 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2540 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2543 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2544 (do not change this comment) */