Don't load cl.
[emacs.git] / src / w32menu.c
blob4553895d829069312a044229e5bf2b5bdd07bbeb
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);
147 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
148 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
149 AppendMenuW_Proc unicode_append_menu = NULL;
151 Lisp_Object Vmenu_updating_frame;
153 Lisp_Object Qdebug_on_next_call;
155 extern Lisp_Object Qmenu_bar;
157 extern Lisp_Object QCtoggle, QCradio;
159 extern Lisp_Object Voverriding_local_map;
160 extern Lisp_Object Voverriding_local_map_menu_flag;
162 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
164 extern Lisp_Object Qmenu_bar_update_hook;
166 void set_frame_menubar ();
168 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
169 Lisp_Object, Lisp_Object, Lisp_Object,
170 Lisp_Object, Lisp_Object));
171 #ifdef HAVE_DIALOGS
172 static Lisp_Object w32_dialog_show ();
173 #endif
174 static Lisp_Object w32_menu_show ();
176 static void keymap_panes ();
177 static void single_keymap_panes ();
178 static void single_menu_item ();
179 static void list_of_panes ();
180 static void list_of_items ();
181 void w32_free_menu_strings (HWND);
183 /* This holds a Lisp vector that holds the results of decoding
184 the keymaps or alist-of-alists that specify a menu.
186 It describes the panes and items within the panes.
188 Each pane is described by 3 elements in the vector:
189 t, the pane name, the pane's prefix key.
190 Then follow the pane's items, with 5 elements per item:
191 the item string, the enable flag, the item's value,
192 the definition, and the equivalent keyboard key's description string.
194 In some cases, multiple levels of menus may be described.
195 A single vector slot containing nil indicates the start of a submenu.
196 A single vector slot containing lambda indicates the end of a submenu.
197 The submenu follows a menu item which is the way to reach the submenu.
199 A single vector slot containing quote indicates that the
200 following items should appear on the right of a dialog box.
202 Using a Lisp vector to hold this information while we decode it
203 takes care of protecting all the data from GC. */
205 #define MENU_ITEMS_PANE_NAME 1
206 #define MENU_ITEMS_PANE_PREFIX 2
207 #define MENU_ITEMS_PANE_LENGTH 3
209 enum menu_item_idx
211 MENU_ITEMS_ITEM_NAME = 0,
212 MENU_ITEMS_ITEM_ENABLE,
213 MENU_ITEMS_ITEM_VALUE,
214 MENU_ITEMS_ITEM_EQUIV_KEY,
215 MENU_ITEMS_ITEM_DEFINITION,
216 MENU_ITEMS_ITEM_TYPE,
217 MENU_ITEMS_ITEM_SELECTED,
218 MENU_ITEMS_ITEM_HELP,
219 MENU_ITEMS_ITEM_LENGTH
222 static Lisp_Object menu_items;
224 /* Number of slots currently allocated in menu_items. */
225 static int menu_items_allocated;
227 /* This is the index in menu_items of the first empty slot. */
228 static int menu_items_used;
230 /* The number of panes currently recorded in menu_items,
231 excluding those within submenus. */
232 static int menu_items_n_panes;
234 /* Current depth within submenus. */
235 static int menu_items_submenu_depth;
237 /* Flag which when set indicates a dialog or menu has been posted by
238 Xt on behalf of one of the widget sets. */
239 static int popup_activated_flag;
241 static int next_menubar_widget_id;
243 /* This is set nonzero after the user activates the menu bar, and set
244 to zero again after the menu bars are redisplayed by prepare_menu_bar.
245 While it is nonzero, all calls to set_frame_menubar go deep.
247 I don't understand why this is needed, but it does seem to be
248 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
250 int pending_menu_activation;
253 /* Return the frame whose ->output_data.w32->menubar_widget equals
254 ID, or 0 if none. */
256 static struct frame *
257 menubar_id_to_frame (id)
258 HMENU id;
260 Lisp_Object tail, frame;
261 FRAME_PTR f;
263 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
265 frame = XCAR (tail);
266 if (!GC_FRAMEP (frame))
267 continue;
268 f = XFRAME (frame);
269 if (!FRAME_WINDOW_P (f))
270 continue;
271 if (f->output_data.w32->menubar_widget == id)
272 return f;
274 return 0;
277 /* Initialize the menu_items structure if we haven't already done so.
278 Also mark it as currently empty. */
280 static void
281 init_menu_items ()
283 if (NILP (menu_items))
285 menu_items_allocated = 60;
286 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
289 menu_items_used = 0;
290 menu_items_n_panes = 0;
291 menu_items_submenu_depth = 0;
294 /* Call at the end of generating the data in menu_items.
295 This fills in the number of items in the last pane. */
297 static void
298 finish_menu_items ()
302 /* Call when finished using the data for the current menu
303 in menu_items. */
305 static void
306 discard_menu_items ()
308 /* Free the structure if it is especially large.
309 Otherwise, hold on to it, to save time. */
310 if (menu_items_allocated > 200)
312 menu_items = Qnil;
313 menu_items_allocated = 0;
317 /* Make the menu_items vector twice as large. */
319 static void
320 grow_menu_items ()
322 Lisp_Object old;
323 int old_size = menu_items_allocated;
324 old = menu_items;
326 menu_items_allocated *= 2;
327 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
328 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
329 old_size * sizeof (Lisp_Object));
332 /* Begin a submenu. */
334 static void
335 push_submenu_start ()
337 if (menu_items_used + 1 > menu_items_allocated)
338 grow_menu_items ();
340 ASET (menu_items, menu_items_used++, Qnil);
341 menu_items_submenu_depth++;
344 /* End a submenu. */
346 static void
347 push_submenu_end ()
349 if (menu_items_used + 1 > menu_items_allocated)
350 grow_menu_items ();
352 ASET (menu_items, menu_items_used++, Qlambda);
353 menu_items_submenu_depth--;
356 /* Indicate boundary between left and right. */
358 static void
359 push_left_right_boundary ()
361 if (menu_items_used + 1 > menu_items_allocated)
362 grow_menu_items ();
364 ASET (menu_items, menu_items_used++, Qquote);
367 /* Start a new menu pane in menu_items.
368 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
370 static void
371 push_menu_pane (name, prefix_vec)
372 Lisp_Object name, prefix_vec;
374 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
375 grow_menu_items ();
377 if (menu_items_submenu_depth == 0)
378 menu_items_n_panes++;
379 ASET (menu_items, menu_items_used++, Qt);
380 ASET (menu_items, menu_items_used++, name);
381 ASET (menu_items, menu_items_used++, prefix_vec);
384 /* Push one menu item into the current pane. NAME is the string to
385 display. ENABLE if non-nil means this item can be selected. KEY
386 is the key generated by choosing this item, or nil if this item
387 doesn't really have a definition. DEF is the definition of this
388 item. EQUIV is the textual description of the keyboard equivalent
389 for this item (or nil if none). TYPE is the type of this menu
390 item, one of nil, `toggle' or `radio'. */
392 static void
393 push_menu_item (name, enable, key, def, equiv, type, selected, help)
394 Lisp_Object name, enable, key, def, equiv, type, selected, help;
396 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
397 grow_menu_items ();
399 ASET (menu_items, menu_items_used++, name);
400 ASET (menu_items, menu_items_used++, enable);
401 ASET (menu_items, menu_items_used++, key);
402 ASET (menu_items, menu_items_used++, equiv);
403 ASET (menu_items, menu_items_used++, def);
404 ASET (menu_items, menu_items_used++, type);
405 ASET (menu_items, menu_items_used++, selected);
406 ASET (menu_items, menu_items_used++, help);
409 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
410 and generate menu panes for them in menu_items.
411 If NOTREAL is nonzero,
412 don't bother really computing whether an item is enabled. */
414 static void
415 keymap_panes (keymaps, nmaps, notreal)
416 Lisp_Object *keymaps;
417 int nmaps;
418 int notreal;
420 int mapno;
422 init_menu_items ();
424 /* Loop over the given keymaps, making a pane for each map.
425 But don't make a pane that is empty--ignore that map instead.
426 P is the number of panes we have made so far. */
427 for (mapno = 0; mapno < nmaps; mapno++)
428 single_keymap_panes (keymaps[mapno],
429 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
431 finish_menu_items ();
434 /* This is a recursive subroutine of keymap_panes.
435 It handles one keymap, KEYMAP.
436 The other arguments are passed along
437 or point to local variables of the previous function.
438 If NOTREAL is nonzero, only check for equivalent key bindings, don't
439 evaluate expressions in menu items and don't make any menu.
441 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
443 static void
444 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
445 Lisp_Object keymap;
446 Lisp_Object pane_name;
447 Lisp_Object prefix;
448 int notreal;
449 int maxdepth;
451 Lisp_Object pending_maps = Qnil;
452 Lisp_Object tail, item;
453 struct gcpro gcpro1, gcpro2;
455 if (maxdepth <= 0)
456 return;
458 push_menu_pane (pane_name, prefix);
460 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
462 GCPRO2 (keymap, pending_maps);
463 /* Look at each key binding, and if it is a menu item add it
464 to this menu. */
465 item = XCAR (tail);
466 if (CONSP (item))
467 single_menu_item (XCAR (item), XCDR (item),
468 &pending_maps, notreal, maxdepth);
469 else if (VECTORP (item))
471 /* Loop over the char values represented in the vector. */
472 int len = ASIZE (item);
473 int c;
474 for (c = 0; c < len; c++)
476 Lisp_Object character;
477 XSETFASTINT (character, c);
478 single_menu_item (character, AREF (item, c),
479 &pending_maps, notreal, maxdepth);
482 UNGCPRO;
485 /* Process now any submenus which want to be panes at this level. */
486 while (!NILP (pending_maps))
488 Lisp_Object elt, eltcdr, string;
489 elt = Fcar (pending_maps);
490 eltcdr = XCDR (elt);
491 string = XCAR (eltcdr);
492 /* We no longer discard the @ from the beginning of the string here.
493 Instead, we do this in w32_menu_show. */
494 single_keymap_panes (Fcar (elt), string,
495 XCDR (eltcdr), notreal, maxdepth - 1);
496 pending_maps = Fcdr (pending_maps);
500 /* This is a subroutine of single_keymap_panes that handles one
501 keymap entry.
502 KEY is a key in a keymap and ITEM is its binding.
503 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
504 separate panes.
505 If NOTREAL is nonzero, only check for equivalent key bindings, don't
506 evaluate expressions in menu items and don't make any menu.
507 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
509 static void
510 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
511 Lisp_Object key, item;
512 Lisp_Object *pending_maps_ptr;
513 int maxdepth, notreal;
515 Lisp_Object map, item_string, enabled;
516 struct gcpro gcpro1, gcpro2;
517 int res;
519 /* Parse the menu item and leave the result in item_properties. */
520 GCPRO2 (key, item);
521 res = parse_menu_item (item, notreal, 0);
522 UNGCPRO;
523 if (!res)
524 return; /* Not a menu item. */
526 map = AREF (item_properties, ITEM_PROPERTY_MAP);
528 if (notreal)
530 /* We don't want to make a menu, just traverse the keymaps to
531 precompute equivalent key bindings. */
532 if (!NILP (map))
533 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
534 return;
537 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
538 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
540 if (!NILP (map) && SREF (item_string, 0) == '@')
542 if (!NILP (enabled))
543 /* An enabled separate pane. Remember this to handle it later. */
544 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
545 *pending_maps_ptr);
546 return;
549 push_menu_item (item_string, enabled, key,
550 AREF (item_properties, ITEM_PROPERTY_DEF),
551 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
552 AREF (item_properties, ITEM_PROPERTY_TYPE),
553 AREF (item_properties, ITEM_PROPERTY_SELECTED),
554 AREF (item_properties, ITEM_PROPERTY_HELP));
556 /* Display a submenu using the toolkit. */
557 if (! (NILP (map) || NILP (enabled)))
559 push_submenu_start ();
560 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
561 push_submenu_end ();
565 /* Push all the panes and items of a menu described by the
566 alist-of-alists MENU.
567 This handles old-fashioned calls to x-popup-menu. */
569 static void
570 list_of_panes (menu)
571 Lisp_Object menu;
573 Lisp_Object tail;
575 init_menu_items ();
577 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
579 Lisp_Object elt, pane_name, pane_data;
580 elt = Fcar (tail);
581 pane_name = Fcar (elt);
582 CHECK_STRING (pane_name);
583 push_menu_pane (pane_name, Qnil);
584 pane_data = Fcdr (elt);
585 CHECK_CONS (pane_data);
586 list_of_items (pane_data);
589 finish_menu_items ();
592 /* Push the items in a single pane defined by the alist PANE. */
594 static void
595 list_of_items (pane)
596 Lisp_Object pane;
598 Lisp_Object tail, item, item1;
600 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
602 item = Fcar (tail);
603 if (STRINGP (item))
604 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
605 else if (NILP (item))
606 push_left_right_boundary ();
607 else
609 CHECK_CONS (item);
610 item1 = Fcar (item);
611 CHECK_STRING (item1);
612 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
617 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
618 doc: /* Pop up a deck-of-cards menu and return user's selection.
619 POSITION is a position specification. This is either a mouse button
620 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
621 are positions in pixels from the top left corner of WINDOW's frame
622 \(WINDOW may be a frame object instead of a window). This controls the
623 position of the center of the first line in the first pane of the
624 menu, not the top left of the menu as a whole. If POSITION is t, it
625 means to use the current mouse position.
627 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
628 The menu items come from key bindings that have a menu string as well as
629 a definition; actually, the \"definition\" in such a key binding looks like
630 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
631 the keymap as a top-level element.
633 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
634 Otherwise, REAL-DEFINITION should be a valid key binding definition.
636 You can also use a list of keymaps as MENU. Then each keymap makes a
637 separate pane. When MENU is a keymap or a list of keymaps, the return
638 value is a list of events.
640 Alternatively, you can specify a menu of multiple panes with a list of
641 the form (TITLE PANE1 PANE2...), where each pane is a list of
642 form (TITLE ITEM1 ITEM2...).
643 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
644 appear as an item--that makes a nonselectable line in the menu.
645 With this form of menu, the return value is VALUE from the chosen item.
647 If POSITION is nil, don't display the menu at all, just precalculate the
648 cached information about equivalent key sequences. */)
649 (position, menu)
650 Lisp_Object position, menu;
652 Lisp_Object keymap, tem;
653 int xpos = 0, ypos = 0;
654 Lisp_Object title;
655 char *error_name;
656 Lisp_Object selection;
657 FRAME_PTR f = NULL;
658 Lisp_Object x, y, window;
659 int keymaps = 0;
660 int for_click = 0;
661 struct gcpro gcpro1;
663 #ifdef HAVE_MENUS
664 if (! NILP (position))
666 check_w32 ();
668 /* Decode the first argument: find the window and the coordinates. */
669 if (EQ (position, Qt)
670 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
671 || EQ (XCAR (position), Qtool_bar))))
673 /* Use the mouse's current position. */
674 FRAME_PTR new_f = SELECTED_FRAME ();
675 Lisp_Object bar_window;
676 enum scroll_bar_part part;
677 unsigned long time;
679 if (mouse_position_hook)
680 (*mouse_position_hook) (&new_f, 1, &bar_window,
681 &part, &x, &y, &time);
682 if (new_f != 0)
683 XSETFRAME (window, new_f);
684 else
686 window = selected_window;
687 XSETFASTINT (x, 0);
688 XSETFASTINT (y, 0);
691 else
693 tem = Fcar (position);
694 if (CONSP (tem))
696 window = Fcar (Fcdr (position));
697 x = Fcar (tem);
698 y = Fcar (Fcdr (tem));
700 else
702 for_click = 1;
703 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
704 window = Fcar (tem); /* POSN_WINDOW (tem) */
705 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
706 x = Fcar (tem);
707 y = Fcdr (tem);
711 CHECK_NUMBER (x);
712 CHECK_NUMBER (y);
714 /* Decode where to put the menu. */
716 if (FRAMEP (window))
718 f = XFRAME (window);
719 xpos = 0;
720 ypos = 0;
722 else if (WINDOWP (window))
724 CHECK_LIVE_WINDOW (window);
725 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
727 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
728 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
730 else
731 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
732 but I don't want to make one now. */
733 CHECK_WINDOW (window);
735 xpos += XINT (x);
736 ypos += XINT (y);
738 XSETFRAME (Vmenu_updating_frame, f);
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 UNGCPRO;
816 return Qnil;
819 #ifdef HAVE_MENUS
820 /* If resources from a previous popup menu exist yet, does nothing
821 until the `menu_free_timer' has freed them (see w32fns.c).
823 if (current_popup_menu)
825 discard_menu_items ();
826 UNGCPRO;
827 return Qnil;
830 /* Display them in a menu. */
831 BLOCK_INPUT;
833 selection = w32_menu_show (f, xpos, ypos, for_click,
834 keymaps, title, &error_name);
835 UNBLOCK_INPUT;
837 discard_menu_items ();
838 #endif /* HAVE_MENUS */
840 UNGCPRO;
842 if (error_name) error (error_name);
843 return selection;
846 #ifdef HAVE_MENUS
848 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
849 doc: /* Pop up a dialog box and return user's selection.
850 POSITION specifies which frame to use.
851 This is normally a mouse button event or a window or frame.
852 If POSITION is t, it means to use the frame the mouse is on.
853 The dialog box appears in the middle of the specified frame.
855 CONTENTS specifies the alternatives to display in the dialog box.
856 It is a list of the form (TITLE ITEM1 ITEM2...).
857 Each ITEM is a cons cell (STRING . VALUE).
858 The return value is VALUE from the chosen item.
860 An ITEM may also be just a string--that makes a nonselectable item.
861 An ITEM may also be nil--that means to put all preceding items
862 on the left of the dialog box and all following items on the right.
863 \(By default, approximately half appear on each side.) */)
864 (position, contents)
865 Lisp_Object position, contents;
867 FRAME_PTR f = NULL;
868 Lisp_Object window;
870 check_w32 ();
872 /* Decode the first argument: find the window or frame to use. */
873 if (EQ (position, Qt)
874 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
875 || EQ (XCAR (position), Qtool_bar))))
877 #if 0 /* Using the frame the mouse is on may not be right. */
878 /* Use the mouse's current position. */
879 FRAME_PTR new_f = SELECTED_FRAME ();
880 Lisp_Object bar_window;
881 enum scroll_bar_part part;
882 unsigned long time;
883 Lisp_Object x, y;
885 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
887 if (new_f != 0)
888 XSETFRAME (window, new_f);
889 else
890 window = selected_window;
891 #endif
892 window = selected_window;
894 else if (CONSP (position))
896 Lisp_Object tem;
897 tem = Fcar (position);
898 if (CONSP (tem))
899 window = Fcar (Fcdr (position));
900 else
902 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
903 window = Fcar (tem); /* POSN_WINDOW (tem) */
906 else if (WINDOWP (position) || FRAMEP (position))
907 window = position;
908 else
909 window = Qnil;
911 /* Decode where to put the menu. */
913 if (FRAMEP (window))
914 f = XFRAME (window);
915 else if (WINDOWP (window))
917 CHECK_LIVE_WINDOW (window);
918 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
920 else
921 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
922 but I don't want to make one now. */
923 CHECK_WINDOW (window);
925 #ifndef HAVE_DIALOGS
926 /* Display a menu with these alternatives
927 in the middle of frame F. */
929 Lisp_Object x, y, frame, newpos;
930 XSETFRAME (frame, f);
931 XSETINT (x, x_pixel_width (f) / 2);
932 XSETINT (y, x_pixel_height (f) / 2);
933 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
935 return Fx_popup_menu (newpos,
936 Fcons (Fcar (contents), Fcons (contents, Qnil)));
938 #else /* HAVE_DIALOGS */
940 Lisp_Object title;
941 char *error_name;
942 Lisp_Object selection;
944 /* Decode the dialog items from what was specified. */
945 title = Fcar (contents);
946 CHECK_STRING (title);
948 list_of_panes (Fcons (contents, Qnil));
950 /* Display them in a dialog box. */
951 BLOCK_INPUT;
952 selection = w32_dialog_show (f, 0, title, &error_name);
953 UNBLOCK_INPUT;
955 discard_menu_items ();
957 if (error_name) error (error_name);
958 return selection;
960 #endif /* HAVE_DIALOGS */
963 /* Activate the menu bar of frame F.
964 This is called from keyboard.c when it gets the
965 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
967 To activate the menu bar, we signal to the input thread that it can
968 return from the WM_INITMENU message, allowing the normal Windows
969 processing of the menus.
971 But first we recompute the menu bar contents (the whole tree).
973 This way we can safely execute Lisp code. */
975 void
976 x_activate_menubar (f)
977 FRAME_PTR f;
979 set_frame_menubar (f, 0, 1);
981 /* Lock out further menubar changes while active. */
982 f->output_data.w32->menubar_active = 1;
984 /* Signal input thread to return from WM_INITMENU. */
985 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
993 void
994 menubar_selection_callback (FRAME_PTR f, void * client_data)
996 Lisp_Object prefix, entry;
997 Lisp_Object vector;
998 Lisp_Object *subprefix_stack;
999 int submenu_depth = 0;
1000 int i;
1002 if (!f)
1003 return;
1004 entry = Qnil;
1005 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1006 vector = f->menu_bar_vector;
1007 prefix = Qnil;
1008 i = 0;
1009 while (i < f->menu_bar_items_used)
1011 if (EQ (AREF (vector, i), Qnil))
1013 subprefix_stack[submenu_depth++] = prefix;
1014 prefix = entry;
1015 i++;
1017 else if (EQ (AREF (vector, i), Qlambda))
1019 prefix = subprefix_stack[--submenu_depth];
1020 i++;
1022 else if (EQ (AREF (vector, i), Qt))
1024 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1025 i += MENU_ITEMS_PANE_LENGTH;
1027 else
1029 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT) client_data == i)
1034 int j;
1035 struct input_event buf;
1036 Lisp_Object frame;
1037 EVENT_INIT (buf);
1039 XSETFRAME (frame, f);
1040 buf.kind = MENU_BAR_EVENT;
1041 buf.frame_or_window = frame;
1042 buf.arg = frame;
1043 kbd_buffer_store_event (&buf);
1045 for (j = 0; j < submenu_depth; j++)
1046 if (!NILP (subprefix_stack[j]))
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = subprefix_stack[j];
1051 kbd_buffer_store_event (&buf);
1054 if (!NILP (prefix))
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = prefix;
1059 kbd_buffer_store_event (&buf);
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = entry;
1065 kbd_buffer_store_event (&buf);
1067 /* Free memory used by owner-drawn and help-echo strings. */
1068 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1069 f->output_data.w32->menu_command_in_progress = 0;
1070 f->output_data.w32->menubar_active = 0;
1071 return;
1073 i += MENU_ITEMS_ITEM_LENGTH;
1076 /* Free memory used by owner-drawn and help-echo strings. */
1077 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1078 f->output_data.w32->menu_command_in_progress = 0;
1079 f->output_data.w32->menubar_active = 0;
1082 /* Allocate a widget_value, blocking input. */
1084 widget_value *
1085 xmalloc_widget_value ()
1087 widget_value *value;
1089 BLOCK_INPUT;
1090 value = malloc_widget_value ();
1091 UNBLOCK_INPUT;
1093 return value;
1096 /* This recursively calls free_widget_value on the tree of widgets.
1097 It must free all data that was malloc'ed for these widget_values.
1098 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1099 must be left alone. */
1101 void
1102 free_menubar_widget_value_tree (wv)
1103 widget_value *wv;
1105 if (! wv) return;
1107 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1109 if (wv->contents && (wv->contents != (widget_value*)1))
1111 free_menubar_widget_value_tree (wv->contents);
1112 wv->contents = (widget_value *) 0xDEADBEEF;
1114 if (wv->next)
1116 free_menubar_widget_value_tree (wv->next);
1117 wv->next = (widget_value *) 0xDEADBEEF;
1119 BLOCK_INPUT;
1120 free_widget_value (wv);
1121 UNBLOCK_INPUT;
1124 /* Set up data i menu_items for a menu bar item
1125 whose event type is ITEM_KEY (with string ITEM_NAME)
1126 and whose contents come from the list of keymaps MAPS. */
1128 static int
1129 parse_single_submenu (item_key, item_name, maps)
1130 Lisp_Object item_key, item_name, maps;
1132 Lisp_Object length;
1133 int len;
1134 Lisp_Object *mapvec;
1135 int i;
1136 int top_level_items = 0;
1138 length = Flength (maps);
1139 len = XINT (length);
1141 /* Convert the list MAPS into a vector MAPVEC. */
1142 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1143 for (i = 0; i < len; i++)
1145 mapvec[i] = Fcar (maps);
1146 maps = Fcdr (maps);
1149 /* Loop over the given keymaps, making a pane for each map.
1150 But don't make a pane that is empty--ignore that map instead. */
1151 for (i = 0; i < len; i++)
1153 if (SYMBOLP (mapvec[i])
1154 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1156 /* Here we have a command at top level in the menu bar
1157 as opposed to a submenu. */
1158 top_level_items = 1;
1159 push_menu_pane (Qnil, Qnil);
1160 push_menu_item (item_name, Qt, item_key, mapvec[i],
1161 Qnil, Qnil, Qnil, Qnil);
1163 else
1165 Lisp_Object prompt;
1166 prompt = Fkeymap_prompt (mapvec[i]);
1167 single_keymap_panes (mapvec[i],
1168 !NILP (prompt) ? prompt : item_name,
1169 item_key, 0, 10);
1173 return top_level_items;
1177 /* Create a tree of widget_value objects
1178 representing the panes and items
1179 in menu_items starting at index START, up to index END. */
1181 static widget_value *
1182 digest_single_submenu (start, end, top_level_items)
1183 int start, end, top_level_items;
1185 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1186 int i;
1187 int submenu_depth = 0;
1188 widget_value **submenu_stack;
1190 submenu_stack
1191 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1192 wv = xmalloc_widget_value ();
1193 wv->name = "menu";
1194 wv->value = 0;
1195 wv->enabled = 1;
1196 wv->button_type = BUTTON_TYPE_NONE;
1197 wv->help = Qnil;
1198 first_wv = wv;
1199 save_wv = 0;
1200 prev_wv = 0;
1202 /* Loop over all panes and items made by the preceding call
1203 to parse_single_submenu and construct a tree of widget_value objects.
1204 Ignore the panes and items used by previous calls to
1205 digest_single_submenu, even though those are also in menu_items. */
1206 i = start;
1207 while (i < end)
1209 if (EQ (AREF (menu_items, i), Qnil))
1211 submenu_stack[submenu_depth++] = save_wv;
1212 save_wv = prev_wv;
1213 prev_wv = 0;
1214 i++;
1216 else if (EQ (AREF (menu_items, i), Qlambda))
1218 prev_wv = save_wv;
1219 save_wv = submenu_stack[--submenu_depth];
1220 i++;
1222 else if (EQ (AREF (menu_items, i), Qt)
1223 && submenu_depth != 0)
1224 i += MENU_ITEMS_PANE_LENGTH;
1225 /* Ignore a nil in the item list.
1226 It's meaningful only for dialog boxes. */
1227 else if (EQ (AREF (menu_items, i), Qquote))
1228 i += 1;
1229 else if (EQ (AREF (menu_items, i), Qt))
1231 /* Create a new pane. */
1232 Lisp_Object pane_name, prefix;
1233 char *pane_string;
1235 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1236 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1238 if (STRINGP (pane_name))
1240 if (unicode_append_menu)
1241 /* Encode as UTF-8 for now. */
1242 pane_name = ENCODE_UTF_8 (pane_name);
1243 else if (STRING_MULTIBYTE (pane_name))
1244 pane_name = ENCODE_SYSTEM (pane_name);
1246 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1249 pane_string = (NILP (pane_name)
1250 ? "" : (char *) SDATA (pane_name));
1251 /* If there is just one top-level pane, put all its items directly
1252 under the top-level menu. */
1253 if (menu_items_n_panes == 1)
1254 pane_string = "";
1256 /* If the pane has a meaningful name,
1257 make the pane a top-level menu item
1258 with its items as a submenu beneath it. */
1259 if (strcmp (pane_string, ""))
1261 wv = xmalloc_widget_value ();
1262 if (save_wv)
1263 save_wv->next = wv;
1264 else
1265 first_wv->contents = wv;
1266 wv->lname = pane_name;
1267 /* Set value to 1 so update_submenu_strings can handle '@' */
1268 wv->value = (char *) 1;
1269 wv->enabled = 1;
1270 wv->button_type = BUTTON_TYPE_NONE;
1271 wv->help = Qnil;
1273 save_wv = wv;
1274 prev_wv = 0;
1275 i += MENU_ITEMS_PANE_LENGTH;
1277 else
1279 /* Create a new item within current pane. */
1280 Lisp_Object item_name, enable, descrip, def, type, selected;
1281 Lisp_Object help;
1283 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1284 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1285 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1286 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1287 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1288 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1289 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1291 if (STRINGP (item_name))
1293 if (unicode_append_menu)
1294 item_name = ENCODE_UTF_8 (item_name);
1295 else if (STRING_MULTIBYTE (item_name))
1296 item_name = ENCODE_SYSTEM (item_name);
1298 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1301 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1303 descrip = ENCODE_SYSTEM (descrip);
1304 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1307 wv = xmalloc_widget_value ();
1308 if (prev_wv)
1309 prev_wv->next = wv;
1310 else
1311 save_wv->contents = wv;
1313 wv->lname = item_name;
1314 if (!NILP (descrip))
1315 wv->lkey = descrip;
1316 wv->value = 0;
1317 /* The EMACS_INT cast avoids a warning. There's no problem
1318 as long as pointers have enough bits to hold small integers. */
1319 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1320 wv->enabled = !NILP (enable);
1322 if (NILP (type))
1323 wv->button_type = BUTTON_TYPE_NONE;
1324 else if (EQ (type, QCradio))
1325 wv->button_type = BUTTON_TYPE_RADIO;
1326 else if (EQ (type, QCtoggle))
1327 wv->button_type = BUTTON_TYPE_TOGGLE;
1328 else
1329 abort ();
1331 wv->selected = !NILP (selected);
1332 if (!STRINGP (help))
1333 help = Qnil;
1335 wv->help = help;
1337 prev_wv = wv;
1339 i += MENU_ITEMS_ITEM_LENGTH;
1343 /* If we have just one "menu item"
1344 that was originally a button, return it by itself. */
1345 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1347 wv = first_wv->contents;
1348 free_widget_value (first_wv);
1349 return wv;
1352 return first_wv;
1356 /* Walk through the widget_value tree starting at FIRST_WV and update
1357 the char * pointers from the corresponding lisp values.
1358 We do this after building the whole tree, since GC may happen while the
1359 tree is constructed, and small strings are relocated. So we must wait
1360 until no GC can happen before storing pointers into lisp values. */
1361 static void
1362 update_submenu_strings (first_wv)
1363 widget_value *first_wv;
1365 widget_value *wv;
1367 for (wv = first_wv; wv; wv = wv->next)
1369 if (wv->lname && ! NILP (wv->lname))
1371 wv->name = SDATA (wv->lname);
1373 /* Ignore the @ that means "separate pane".
1374 This is a kludge, but this isn't worth more time. */
1375 if (wv->value == (char *)1)
1377 if (wv->name[0] == '@')
1378 wv->name++;
1379 wv->value = 0;
1383 if (wv->lkey && ! NILP (wv->lkey))
1384 wv->key = SDATA (wv->lkey);
1386 if (wv->contents)
1387 update_submenu_strings (wv->contents);
1392 /* Set the contents of the menubar widgets of frame F.
1393 The argument FIRST_TIME is currently ignored;
1394 it is set the first time this is called, from initialize_frame_menubar. */
1396 void
1397 set_frame_menubar (f, first_time, deep_p)
1398 FRAME_PTR f;
1399 int first_time;
1400 int deep_p;
1402 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1403 Lisp_Object items;
1404 widget_value *wv, *first_wv, *prev_wv = 0;
1405 int i, last_i;
1406 int *submenu_start, *submenu_end;
1407 int *submenu_top_level_items, *submenu_n_panes;
1409 /* We must not change the menubar when actually in use. */
1410 if (f->output_data.w32->menubar_active)
1411 return;
1413 XSETFRAME (Vmenu_updating_frame, f);
1415 if (! menubar_widget)
1416 deep_p = 1;
1417 else if (pending_menu_activation && !deep_p)
1418 deep_p = 1;
1420 if (deep_p)
1422 /* Make a widget-value tree representing the entire menu trees. */
1424 struct buffer *prev = current_buffer;
1425 Lisp_Object buffer;
1426 int specpdl_count = SPECPDL_INDEX ();
1427 int previous_menu_items_used = f->menu_bar_items_used;
1428 Lisp_Object *previous_items
1429 = (Lisp_Object *) alloca (previous_menu_items_used
1430 * sizeof (Lisp_Object));
1432 /* If we are making a new widget, its contents are empty,
1433 do always reinitialize them. */
1434 if (! menubar_widget)
1435 previous_menu_items_used = 0;
1437 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1438 specbind (Qinhibit_quit, Qt);
1439 /* Don't let the debugger step into this code
1440 because it is not reentrant. */
1441 specbind (Qdebug_on_next_call, Qnil);
1443 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1444 if (NILP (Voverriding_local_map_menu_flag))
1446 specbind (Qoverriding_terminal_local_map, Qnil);
1447 specbind (Qoverriding_local_map, Qnil);
1450 set_buffer_internal_1 (XBUFFER (buffer));
1452 /* Run the Lucid hook. */
1453 safe_run_hooks (Qactivate_menubar_hook);
1454 /* If it has changed current-menubar from previous value,
1455 really recompute the menubar from the value. */
1456 if (! NILP (Vlucid_menu_bar_dirty_flag))
1457 call0 (Qrecompute_lucid_menubar);
1458 safe_run_hooks (Qmenu_bar_update_hook);
1459 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1461 items = FRAME_MENU_BAR_ITEMS (f);
1463 /* Save the frame's previous menu bar contents data. */
1464 if (previous_menu_items_used)
1465 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1466 previous_menu_items_used * sizeof (Lisp_Object));
1468 /* Fill in menu_items with the current menu bar contents.
1469 This can evaluate Lisp code. */
1470 menu_items = f->menu_bar_vector;
1471 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1472 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1473 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1474 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1475 submenu_top_level_items
1476 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1477 init_menu_items ();
1478 for (i = 0; i < ASIZE (items); i += 4)
1480 Lisp_Object key, string, maps;
1482 last_i = i;
1484 key = AREF (items, i);
1485 string = AREF (items, i + 1);
1486 maps = AREF (items, i + 2);
1487 if (NILP (string))
1488 break;
1490 submenu_start[i] = menu_items_used;
1492 menu_items_n_panes = 0;
1493 submenu_top_level_items[i]
1494 = parse_single_submenu (key, string, maps);
1495 submenu_n_panes[i] = menu_items_n_panes;
1497 submenu_end[i] = menu_items_used;
1500 finish_menu_items ();
1502 /* Convert menu_items into widget_value trees
1503 to display the menu. This cannot evaluate Lisp code. */
1505 wv = xmalloc_widget_value ();
1506 wv->name = "menubar";
1507 wv->value = 0;
1508 wv->enabled = 1;
1509 wv->button_type = BUTTON_TYPE_NONE;
1510 wv->help = Qnil;
1511 first_wv = wv;
1513 for (i = 0; i < last_i; i += 4)
1515 menu_items_n_panes = submenu_n_panes[i];
1516 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1517 submenu_top_level_items[i]);
1518 if (prev_wv)
1519 prev_wv->next = wv;
1520 else
1521 first_wv->contents = wv;
1522 /* Don't set wv->name here; GC during the loop might relocate it. */
1523 wv->enabled = 1;
1524 wv->button_type = BUTTON_TYPE_NONE;
1525 prev_wv = wv;
1528 set_buffer_internal_1 (prev);
1529 unbind_to (specpdl_count, Qnil);
1531 /* If there has been no change in the Lisp-level contents
1532 of the menu bar, skip redisplaying it. Just exit. */
1534 for (i = 0; i < previous_menu_items_used; i++)
1535 if (menu_items_used == i
1536 || (!EQ (previous_items[i], AREF (menu_items, i))))
1537 break;
1538 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1540 free_menubar_widget_value_tree (first_wv);
1541 menu_items = Qnil;
1543 return;
1546 /* Now GC cannot happen during the lifetime of the widget_value,
1547 so it's safe to store data from a Lisp_String, as long as
1548 local copies are made when the actual menu is created.
1549 Windows takes care of this for normal string items, but
1550 not for owner-drawn items or additional item-info. */
1551 wv = first_wv->contents;
1552 for (i = 0; i < ASIZE (items); i += 4)
1554 Lisp_Object string;
1555 string = AREF (items, i + 1);
1556 if (NILP (string))
1557 break;
1558 wv->name = (char *) SDATA (string);
1559 update_submenu_strings (wv->contents);
1560 wv = wv->next;
1563 f->menu_bar_vector = menu_items;
1564 f->menu_bar_items_used = menu_items_used;
1565 menu_items = Qnil;
1567 else
1569 /* Make a widget-value tree containing
1570 just the top level menu bar strings. */
1572 wv = xmalloc_widget_value ();
1573 wv->name = "menubar";
1574 wv->value = 0;
1575 wv->enabled = 1;
1576 wv->button_type = BUTTON_TYPE_NONE;
1577 wv->help = Qnil;
1578 first_wv = wv;
1580 items = FRAME_MENU_BAR_ITEMS (f);
1581 for (i = 0; i < ASIZE (items); i += 4)
1583 Lisp_Object string;
1585 string = AREF (items, i + 1);
1586 if (NILP (string))
1587 break;
1589 wv = xmalloc_widget_value ();
1590 wv->name = (char *) SDATA (string);
1591 wv->value = 0;
1592 wv->enabled = 1;
1593 wv->button_type = BUTTON_TYPE_NONE;
1594 wv->help = Qnil;
1595 /* This prevents lwlib from assuming this
1596 menu item is really supposed to be empty. */
1597 /* The EMACS_INT cast avoids a warning.
1598 This value just has to be different from small integers. */
1599 wv->call_data = (void *) (EMACS_INT) (-1);
1601 if (prev_wv)
1602 prev_wv->next = wv;
1603 else
1604 first_wv->contents = wv;
1605 prev_wv = wv;
1608 /* Forget what we thought we knew about what is in the
1609 detailed contents of the menu bar menus.
1610 Changing the top level always destroys the contents. */
1611 f->menu_bar_items_used = 0;
1614 /* Create or update the menu bar widget. */
1616 BLOCK_INPUT;
1618 if (menubar_widget)
1620 /* Empty current menubar, rather than creating a fresh one. */
1621 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1624 else
1626 menubar_widget = CreateMenu ();
1628 fill_in_menu (menubar_widget, first_wv->contents);
1630 free_menubar_widget_value_tree (first_wv);
1633 HMENU old_widget = f->output_data.w32->menubar_widget;
1635 f->output_data.w32->menubar_widget = menubar_widget;
1636 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1637 /* Causes flicker when menu bar is updated
1638 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1640 /* Force the window size to be recomputed so that the frame's text
1641 area remains the same, if menubar has just been created. */
1642 if (old_widget == NULL)
1643 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1646 UNBLOCK_INPUT;
1649 /* Called from Fx_create_frame to create the initial menubar of a frame
1650 before it is mapped, so that the window is mapped with the menubar already
1651 there instead of us tacking it on later and thrashing the window after it
1652 is visible. */
1654 void
1655 initialize_frame_menubar (f)
1656 FRAME_PTR f;
1658 /* This function is called before the first chance to redisplay
1659 the frame. It has to be, so the frame will have the right size. */
1660 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1661 set_frame_menubar (f, 1, 1);
1664 /* Get rid of the menu bar of frame F, and free its storage.
1665 This is used when deleting a frame, and when turning off the menu bar. */
1667 void
1668 free_frame_menubar (f)
1669 FRAME_PTR f;
1671 BLOCK_INPUT;
1674 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1675 SetMenu (FRAME_W32_WINDOW (f), NULL);
1676 f->output_data.w32->menubar_widget = NULL;
1677 DestroyMenu (old);
1680 UNBLOCK_INPUT;
1684 /* w32_menu_show actually displays a menu using the panes and items in
1685 menu_items and returns the value selected from it; we assume input
1686 is blocked by the caller. */
1688 /* F is the frame the menu is for.
1689 X and Y are the frame-relative specified position,
1690 relative to the inside upper left corner of the frame F.
1691 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1692 KEYMAPS is 1 if this menu was specified with keymaps;
1693 in that case, we return a list containing the chosen item's value
1694 and perhaps also the pane's prefix.
1695 TITLE is the specified menu title.
1696 ERROR is a place to store an error message string in case of failure.
1697 (We return nil on failure, but the value doesn't actually matter.) */
1699 static Lisp_Object
1700 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1701 FRAME_PTR f;
1702 int x;
1703 int y;
1704 int for_click;
1705 int keymaps;
1706 Lisp_Object title;
1707 char **error;
1709 int i;
1710 int menu_item_selection;
1711 HMENU menu;
1712 POINT pos;
1713 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1714 widget_value **submenu_stack
1715 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1716 Lisp_Object *subprefix_stack
1717 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1718 int submenu_depth = 0;
1719 int first_pane;
1721 *error = NULL;
1723 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1725 *error = "Empty menu";
1726 return Qnil;
1729 /* Create a tree of widget_value objects
1730 representing the panes and their items. */
1731 wv = xmalloc_widget_value ();
1732 wv->name = "menu";
1733 wv->value = 0;
1734 wv->enabled = 1;
1735 wv->button_type = BUTTON_TYPE_NONE;
1736 wv->help = Qnil;
1737 first_wv = wv;
1738 first_pane = 1;
1740 /* Loop over all panes and items, filling in the tree. */
1741 i = 0;
1742 while (i < menu_items_used)
1744 if (EQ (AREF (menu_items, i), Qnil))
1746 submenu_stack[submenu_depth++] = save_wv;
1747 save_wv = prev_wv;
1748 prev_wv = 0;
1749 first_pane = 1;
1750 i++;
1752 else if (EQ (AREF (menu_items, i), Qlambda))
1754 prev_wv = save_wv;
1755 save_wv = submenu_stack[--submenu_depth];
1756 first_pane = 0;
1757 i++;
1759 else if (EQ (AREF (menu_items, i), Qt)
1760 && submenu_depth != 0)
1761 i += MENU_ITEMS_PANE_LENGTH;
1762 /* Ignore a nil in the item list.
1763 It's meaningful only for dialog boxes. */
1764 else if (EQ (AREF (menu_items, i), Qquote))
1765 i += 1;
1766 else if (EQ (AREF (menu_items, i), Qt))
1768 /* Create a new pane. */
1769 Lisp_Object pane_name, prefix;
1770 char *pane_string;
1771 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1772 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1774 if (STRINGP (pane_name))
1776 if (unicode_append_menu)
1777 pane_name = ENCODE_UTF_8 (pane_name);
1778 else if (STRING_MULTIBYTE (pane_name))
1779 pane_name = ENCODE_SYSTEM (pane_name);
1781 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1784 pane_string = (NILP (pane_name)
1785 ? "" : (char *) SDATA (pane_name));
1786 /* If there is just one top-level pane, put all its items directly
1787 under the top-level menu. */
1788 if (menu_items_n_panes == 1)
1789 pane_string = "";
1791 /* If the pane has a meaningful name,
1792 make the pane a top-level menu item
1793 with its items as a submenu beneath it. */
1794 if (!keymaps && strcmp (pane_string, ""))
1796 wv = xmalloc_widget_value ();
1797 if (save_wv)
1798 save_wv->next = wv;
1799 else
1800 first_wv->contents = wv;
1801 wv->name = pane_string;
1802 if (keymaps && !NILP (prefix))
1803 wv->name++;
1804 wv->value = 0;
1805 wv->enabled = 1;
1806 wv->button_type = BUTTON_TYPE_NONE;
1807 wv->help = Qnil;
1808 save_wv = wv;
1809 prev_wv = 0;
1811 else if (first_pane)
1813 save_wv = wv;
1814 prev_wv = 0;
1816 first_pane = 0;
1817 i += MENU_ITEMS_PANE_LENGTH;
1819 else
1821 /* Create a new item within current pane. */
1822 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1824 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1825 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1826 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1827 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1828 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1829 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1830 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1832 if (STRINGP (item_name))
1834 if (unicode_append_menu)
1835 item_name = ENCODE_UTF_8 (item_name);
1836 else if (STRING_MULTIBYTE (item_name))
1837 item_name = ENCODE_SYSTEM (item_name);
1839 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1842 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1844 descrip = ENCODE_SYSTEM (descrip);
1845 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1848 wv = xmalloc_widget_value ();
1849 if (prev_wv)
1850 prev_wv->next = wv;
1851 else
1852 save_wv->contents = wv;
1853 wv->name = (char *) SDATA (item_name);
1854 if (!NILP (descrip))
1855 wv->key = (char *) SDATA (descrip);
1856 wv->value = 0;
1857 /* Use the contents index as call_data, since we are
1858 restricted to 16-bits. */
1859 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1860 wv->enabled = !NILP (enable);
1862 if (NILP (type))
1863 wv->button_type = BUTTON_TYPE_NONE;
1864 else if (EQ (type, QCtoggle))
1865 wv->button_type = BUTTON_TYPE_TOGGLE;
1866 else if (EQ (type, QCradio))
1867 wv->button_type = BUTTON_TYPE_RADIO;
1868 else
1869 abort ();
1871 wv->selected = !NILP (selected);
1872 if (!STRINGP (help))
1873 help = Qnil;
1875 wv->help = help;
1877 prev_wv = wv;
1879 i += MENU_ITEMS_ITEM_LENGTH;
1883 /* Deal with the title, if it is non-nil. */
1884 if (!NILP (title))
1886 widget_value *wv_title = xmalloc_widget_value ();
1887 widget_value *wv_sep = xmalloc_widget_value ();
1889 /* Maybe replace this separator with a bitmap or owner-draw item
1890 so that it looks better. Having two separators looks odd. */
1891 wv_sep->name = "--";
1892 wv_sep->next = first_wv->contents;
1893 wv_sep->help = Qnil;
1895 if (unicode_append_menu)
1896 title = ENCODE_UTF_8 (title);
1897 else if (STRING_MULTIBYTE (title))
1898 title = ENCODE_SYSTEM (title);
1900 wv_title->name = (char *) SDATA (title);
1901 wv_title->enabled = TRUE;
1902 wv_title->title = TRUE;
1903 wv_title->button_type = BUTTON_TYPE_NONE;
1904 wv_title->help = Qnil;
1905 wv_title->next = wv_sep;
1906 first_wv->contents = wv_title;
1909 /* Actually create the menu. */
1910 current_popup_menu = menu = CreatePopupMenu ();
1911 fill_in_menu (menu, first_wv->contents);
1913 /* Adjust coordinates to be root-window-relative. */
1914 pos.x = x;
1915 pos.y = y;
1916 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1918 /* No selection has been chosen yet. */
1919 menu_item_selection = 0;
1921 /* Display the menu. */
1922 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1923 WM_EMACS_TRACKPOPUPMENU,
1924 (WPARAM)menu, (LPARAM)&pos);
1926 /* Clean up extraneous mouse events which might have been generated
1927 during the call. */
1928 discard_mouse_events ();
1930 /* Free the widget_value objects we used to specify the contents. */
1931 free_menubar_widget_value_tree (first_wv);
1933 DestroyMenu (menu);
1935 /* Find the selected item, and its pane, to return
1936 the proper value. */
1937 if (menu_item_selection != 0)
1939 Lisp_Object prefix, entry;
1941 prefix = entry = Qnil;
1942 i = 0;
1943 while (i < menu_items_used)
1945 if (EQ (AREF (menu_items, i), Qnil))
1947 subprefix_stack[submenu_depth++] = prefix;
1948 prefix = entry;
1949 i++;
1951 else if (EQ (AREF (menu_items, i), Qlambda))
1953 prefix = subprefix_stack[--submenu_depth];
1954 i++;
1956 else if (EQ (AREF (menu_items, i), Qt))
1958 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1959 i += MENU_ITEMS_PANE_LENGTH;
1961 /* Ignore a nil in the item list.
1962 It's meaningful only for dialog boxes. */
1963 else if (EQ (AREF (menu_items, i), Qquote))
1964 i += 1;
1965 else
1967 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1968 if (menu_item_selection == i)
1970 if (keymaps != 0)
1972 int j;
1974 entry = Fcons (entry, Qnil);
1975 if (!NILP (prefix))
1976 entry = Fcons (prefix, entry);
1977 for (j = submenu_depth - 1; j >= 0; j--)
1978 if (!NILP (subprefix_stack[j]))
1979 entry = Fcons (subprefix_stack[j], entry);
1981 return entry;
1983 i += MENU_ITEMS_ITEM_LENGTH;
1988 return Qnil;
1992 #ifdef HAVE_DIALOGS
1993 static char * button_names [] = {
1994 "button1", "button2", "button3", "button4", "button5",
1995 "button6", "button7", "button8", "button9", "button10" };
1997 static Lisp_Object
1998 w32_dialog_show (f, keymaps, title, error)
1999 FRAME_PTR f;
2000 int keymaps;
2001 Lisp_Object title;
2002 char **error;
2004 int i, nb_buttons=0;
2005 char dialog_name[6];
2006 int menu_item_selection;
2008 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2010 /* Number of elements seen so far, before boundary. */
2011 int left_count = 0;
2012 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2013 int boundary_seen = 0;
2015 *error = NULL;
2017 if (menu_items_n_panes > 1)
2019 *error = "Multiple panes in dialog box";
2020 return Qnil;
2023 /* Create a tree of widget_value objects
2024 representing the text label and buttons. */
2026 Lisp_Object pane_name, prefix;
2027 char *pane_string;
2028 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2029 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2030 pane_string = (NILP (pane_name)
2031 ? "" : (char *) SDATA (pane_name));
2032 prev_wv = xmalloc_widget_value ();
2033 prev_wv->value = pane_string;
2034 if (keymaps && !NILP (prefix))
2035 prev_wv->name++;
2036 prev_wv->enabled = 1;
2037 prev_wv->name = "message";
2038 prev_wv->help = Qnil;
2039 first_wv = prev_wv;
2041 /* Loop over all panes and items, filling in the tree. */
2042 i = MENU_ITEMS_PANE_LENGTH;
2043 while (i < menu_items_used)
2046 /* Create a new item within current pane. */
2047 Lisp_Object item_name, enable, descrip, help;
2049 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2050 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2051 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2052 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2054 if (NILP (item_name))
2056 free_menubar_widget_value_tree (first_wv);
2057 *error = "Submenu in dialog items";
2058 return Qnil;
2060 if (EQ (item_name, Qquote))
2062 /* This is the boundary between left-side elts
2063 and right-side elts. Stop incrementing right_count. */
2064 boundary_seen = 1;
2065 i++;
2066 continue;
2068 if (nb_buttons >= 9)
2070 free_menubar_widget_value_tree (first_wv);
2071 *error = "Too many dialog items";
2072 return Qnil;
2075 wv = xmalloc_widget_value ();
2076 prev_wv->next = wv;
2077 wv->name = (char *) button_names[nb_buttons];
2078 if (!NILP (descrip))
2079 wv->key = (char *) SDATA (descrip);
2080 wv->value = (char *) SDATA (item_name);
2081 wv->call_data = (void *) &AREF (menu_items, i);
2082 wv->enabled = !NILP (enable);
2083 wv->help = Qnil;
2084 prev_wv = wv;
2086 if (! boundary_seen)
2087 left_count++;
2089 nb_buttons++;
2090 i += MENU_ITEMS_ITEM_LENGTH;
2093 /* If the boundary was not specified,
2094 by default put half on the left and half on the right. */
2095 if (! boundary_seen)
2096 left_count = nb_buttons - nb_buttons / 2;
2098 wv = xmalloc_widget_value ();
2099 wv->name = dialog_name;
2100 wv->help = Qnil;
2102 /* Dialog boxes use a really stupid name encoding
2103 which specifies how many buttons to use
2104 and how many buttons are on the right.
2105 The Q means something also. */
2106 dialog_name[0] = 'Q';
2107 dialog_name[1] = '0' + nb_buttons;
2108 dialog_name[2] = 'B';
2109 dialog_name[3] = 'R';
2110 /* Number of buttons to put on the right. */
2111 dialog_name[4] = '0' + nb_buttons - left_count;
2112 dialog_name[5] = 0;
2113 wv->contents = first_wv;
2114 first_wv = wv;
2117 /* Actually create the dialog. */
2118 dialog_id = widget_id_tick++;
2119 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2120 f->output_data.w32->widget, 1, 0,
2121 dialog_selection_callback, 0);
2122 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2124 /* Free the widget_value objects we used to specify the contents. */
2125 free_menubar_widget_value_tree (first_wv);
2127 /* No selection has been chosen yet. */
2128 menu_item_selection = 0;
2130 /* Display the menu. */
2131 lw_pop_up_all_widgets (dialog_id);
2132 popup_activated_flag = 1;
2134 /* Process events that apply to the menu. */
2135 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2137 lw_destroy_all_widgets (dialog_id);
2139 /* Find the selected item, and its pane, to return
2140 the proper value. */
2141 if (menu_item_selection != 0)
2143 Lisp_Object prefix;
2145 prefix = Qnil;
2146 i = 0;
2147 while (i < menu_items_used)
2149 Lisp_Object entry;
2151 if (EQ (AREF (menu_items, i), Qt))
2153 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2154 i += MENU_ITEMS_PANE_LENGTH;
2156 else
2158 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2159 if (menu_item_selection == i)
2161 if (keymaps != 0)
2163 entry = Fcons (entry, Qnil);
2164 if (!NILP (prefix))
2165 entry = Fcons (prefix, entry);
2167 return entry;
2169 i += MENU_ITEMS_ITEM_LENGTH;
2174 return Qnil;
2176 #endif /* HAVE_DIALOGS */
2179 /* Is this item a separator? */
2180 static int
2181 name_is_separator (name)
2182 char *name;
2184 char *start = name;
2186 /* Check if name string consists of only dashes ('-'). */
2187 while (*name == '-') name++;
2188 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2189 or "--deep-shadow". We don't implement them yet, se we just treat
2190 them like normal separators. */
2191 return (*name == '\0' || start + 2 == name);
2195 /* Indicate boundary between left and right. */
2196 static int
2197 add_left_right_boundary (HMENU menu)
2199 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2202 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2203 static void
2204 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2206 while (len > 0)
2208 int utf16;
2209 if (*src < 0x80)
2211 *dest = (WCHAR) *src;
2212 dest++; src++; len--;
2214 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2215 else if (*src < 0xC0)
2217 src++; len--;
2219 /* 2 char UTF-8 sequence. */
2220 else if (*src < 0xE0)
2222 *dest = (WCHAR) (((*src & 0x1f) << 6)
2223 | (*(src + 1) & 0x3f));
2224 src += 2; len -= 2; dest++;
2226 else if (*src < 0xF0)
2228 *dest = (WCHAR) (((*src & 0x0f) << 12)
2229 | ((*(src + 1) & 0x3f) << 6)
2230 | (*(src + 2) & 0x3f));
2231 src += 3; len -= 3; dest++;
2233 else /* Not encodable. Insert Unicode Substitution char. */
2235 *dest = (WCHAR) 0xfffd;
2236 src++; len--; dest++;
2239 *dest = 0;
2242 static int
2243 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2245 UINT fuFlags;
2246 char *out_string;
2247 int return_value;
2249 if (name_is_separator (wv->name))
2251 fuFlags = MF_SEPARATOR;
2252 out_string = NULL;
2254 else
2256 if (wv->enabled)
2257 fuFlags = MF_STRING;
2258 else
2259 fuFlags = MF_STRING | MF_GRAYED;
2261 if (wv->key != NULL)
2263 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2264 strcpy (out_string, wv->name);
2265 strcat (out_string, "\t");
2266 strcat (out_string, wv->key);
2268 else
2269 out_string = wv->name;
2271 if (item != NULL)
2272 fuFlags = MF_POPUP;
2273 else if (wv->title || wv->call_data == 0)
2275 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2276 we can't deallocate the memory otherwise. */
2277 if (get_menu_item_info)
2279 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2280 strcpy (out_string, wv->name);
2281 #ifdef MENU_DEBUG
2282 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2283 #endif
2284 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2286 else
2287 fuFlags = MF_DISABLED;
2290 /* Draw radio buttons and tickboxes. */
2291 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2292 wv->button_type == BUTTON_TYPE_RADIO))
2293 fuFlags |= MF_CHECKED;
2294 else
2295 fuFlags |= MF_UNCHECKED;
2298 if (unicode_append_menu && out_string)
2300 /* Convert out_string from UTF-8 to UTF-16-LE. */
2301 int utf8_len = strlen (out_string);
2302 WCHAR * utf16_string;
2303 if (fuFlags & MF_OWNERDRAW)
2304 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2305 else
2306 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2308 utf8to16 (out_string, utf8_len, utf16_string);
2309 return_value = unicode_append_menu (menu, fuFlags,
2310 item != NULL ? (UINT) item
2311 : (UINT) wv->call_data,
2312 utf16_string);
2313 if (fuFlags & MF_OWNERDRAW)
2314 local_free (out_string);
2316 else
2318 return_value =
2319 AppendMenu (menu,
2320 fuFlags,
2321 item != NULL ? (UINT) item : (UINT) wv->call_data,
2322 out_string );
2325 /* This must be done after the menu item is created. */
2326 if (!wv->title && wv->call_data != 0)
2328 if (set_menu_item_info)
2330 MENUITEMINFO info;
2331 bzero (&info, sizeof (info));
2332 info.cbSize = sizeof (info);
2333 info.fMask = MIIM_DATA;
2335 /* Set help string for menu item. Leave it as a Lisp_Object
2336 until it is ready to be displayed, since GC can happen while
2337 menus are active. */
2338 if (!NILP (wv->help))
2339 #ifdef USE_LISP_UNION_TYPE
2340 info.dwItemData = (DWORD) (wv->help).i;
2341 #else
2342 info.dwItemData = (DWORD) (wv->help);
2343 #endif
2344 if (wv->button_type == BUTTON_TYPE_RADIO)
2346 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2347 RADIO items, but is not available on NT 3.51 and earlier. */
2348 info.fMask |= MIIM_TYPE | MIIM_STATE;
2349 info.fType = MFT_RADIOCHECK | MFT_STRING;
2350 info.dwTypeData = out_string;
2351 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2354 set_menu_item_info (menu,
2355 item != NULL ? (UINT) item : (UINT) wv->call_data,
2356 FALSE, &info);
2359 return return_value;
2362 /* Construct native Windows menu(bar) based on widget_value tree. */
2364 fill_in_menu (HMENU menu, widget_value *wv)
2366 int items_added = 0;
2368 for ( ; wv != NULL; wv = wv->next)
2370 if (wv->contents)
2372 HMENU sub_menu = CreatePopupMenu ();
2374 if (sub_menu == NULL)
2375 return 0;
2377 if (!fill_in_menu (sub_menu, wv->contents) ||
2378 !add_menu_item (menu, wv, sub_menu))
2380 DestroyMenu (sub_menu);
2381 return 0;
2384 else
2386 if (!add_menu_item (menu, wv, NULL))
2387 return 0;
2390 return 1;
2394 popup_activated ()
2396 /* popup_activated_flag not actually used on W32 */
2397 return 0;
2400 /* Display help string for currently pointed to menu item. Not
2401 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2402 available. */
2403 void
2404 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2406 if (get_menu_item_info)
2408 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2409 Lisp_Object frame, help;
2411 /* No help echo on owner-draw menu items. */
2412 if (flags & MF_OWNERDRAW || flags & MF_POPUP)
2413 help = Qnil;
2414 else
2416 MENUITEMINFO info;
2418 bzero (&info, sizeof (info));
2419 info.cbSize = sizeof (info);
2420 info.fMask = MIIM_DATA;
2421 get_menu_item_info (menu, item, FALSE, &info);
2423 #ifdef USE_LISP_UNION_TYPE
2424 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2425 : Qnil;
2426 #else
2427 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2428 #endif
2431 /* Store the help echo in the keyboard buffer as the X toolkit
2432 version does, rather than directly showing it. This seems to
2433 solve the GC problems that were present when we based the
2434 Windows code on the non-toolkit version. */
2435 if (f)
2437 XSETFRAME (frame, f);
2438 kbd_buffer_store_help_event (frame, help);
2440 else
2441 /* X version has a loop through frames here, which doesn't
2442 appear to do anything, unless it has some side effect. */
2443 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2447 /* Free memory used by owner-drawn strings. */
2448 static void
2449 w32_free_submenu_strings (menu)
2450 HMENU menu;
2452 int i, num = GetMenuItemCount (menu);
2453 for (i = 0; i < num; i++)
2455 MENUITEMINFO info;
2456 bzero (&info, sizeof (info));
2457 info.cbSize = sizeof (info);
2458 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2460 get_menu_item_info (menu, i, TRUE, &info);
2462 /* Owner-drawn names are held in dwItemData. */
2463 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2465 #ifdef MENU_DEBUG
2466 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2467 #endif
2468 local_free (info.dwItemData);
2471 /* Recurse down submenus. */
2472 if (info.hSubMenu)
2473 w32_free_submenu_strings (info.hSubMenu);
2477 void
2478 w32_free_menu_strings (hwnd)
2479 HWND hwnd;
2481 HMENU menu = current_popup_menu;
2483 if (get_menu_item_info)
2485 /* If there is no popup menu active, free the strings from the frame's
2486 menubar. */
2487 if (!menu)
2488 menu = GetMenu (hwnd);
2490 if (menu)
2491 w32_free_submenu_strings (menu);
2494 current_popup_menu = NULL;
2497 #endif /* HAVE_MENUS */
2499 void syms_of_w32menu ()
2501 globals_of_w32menu ();
2502 staticpro (&menu_items);
2503 menu_items = Qnil;
2505 current_popup_menu = NULL;
2507 Qdebug_on_next_call = intern ("debug-on-next-call");
2508 staticpro (&Qdebug_on_next_call);
2510 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2511 doc: /* Frame for which we are updating a menu.
2512 The enable predicate for a menu command should check this variable. */);
2513 Vmenu_updating_frame = Qnil;
2515 defsubr (&Sx_popup_menu);
2516 #ifdef HAVE_MENUS
2517 defsubr (&Sx_popup_dialog);
2518 #endif
2522 globals_of_w32menu is used to initialize those global variables that
2523 must always be initialized on startup even when the global variable
2524 initialized is non zero (see the function main in emacs.c).
2525 globals_of_w32menu is called from syms_of_w32menu when the global
2526 variable initialized is 0 and directly from main when initialized
2527 is non zero.
2529 void globals_of_w32menu ()
2531 /* See if Get/SetMenuItemInfo functions are available. */
2532 HMODULE user32 = GetModuleHandle ("user32.dll");
2533 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2534 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2535 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2538 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2539 (do not change this comment) */