(mouse-drag-region-1): When remapping mouse-1 to mouse-2, go back to
[bpt/emacs.git] / src / w32menu.c
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998, 1999, 2002, 2003,
3 2004, 2005 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
21
22 #include <config.h>
23 #include <signal.h>
24
25 #include <stdio.h>
26 #include "lisp.h"
27 #include "termhooks.h"
28 #include "keyboard.h"
29 #include "keymap.h"
30 #include "frame.h"
31 #include "window.h"
32 #include "blockinput.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "coding.h"
36
37 /* This may include sys/types.h, and that somehow loses
38 if this is not done before the other system files. */
39 #include "w32term.h"
40
41 /* Load sys/types.h if not already loaded.
42 In some systems loading it twice is suicidal. */
43 #ifndef makedev
44 #include <sys/types.h>
45 #endif
46
47 #include "dispextern.h"
48
49 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
50
51 /******************************************************************/
52 /* Definitions copied from lwlib.h */
53
54 typedef void * XtPointer;
55 typedef char Boolean;
56
57 enum button_type
58 {
59 BUTTON_TYPE_NONE,
60 BUTTON_TYPE_TOGGLE,
61 BUTTON_TYPE_RADIO
62 };
63
64 /* This structure is based on the one in ../lwlib/lwlib.h, modified
65 for Windows. */
66 typedef struct _widget_value
67 {
68 /* name of widget */
69 Lisp_Object lname;
70 char* name;
71 /* value (meaning depend on widget type) */
72 char* value;
73 /* keyboard equivalent. no implications for XtTranslations */
74 Lisp_Object lkey;
75 char* key;
76 /* Help string or nil if none.
77 GC finds this string through the frame's menu_bar_vector
78 or through menu_items. */
79 Lisp_Object help;
80 /* true if enabled */
81 Boolean enabled;
82 /* true if selected */
83 Boolean selected;
84 /* The type of a button. */
85 enum button_type button_type;
86 /* true if menu title */
87 Boolean title;
88 #if 0
89 /* true if was edited (maintained by get_value) */
90 Boolean edited;
91 /* true if has changed (maintained by lw library) */
92 change_type change;
93 /* true if this widget itself has changed,
94 but not counting the other widgets found in the `next' field. */
95 change_type this_one_change;
96 #endif
97 /* Contents of the sub-widgets, also selected slot for checkbox */
98 struct _widget_value* contents;
99 /* data passed to callback */
100 XtPointer call_data;
101 /* next one in the list */
102 struct _widget_value* next;
103 #if 0
104 /* slot for the toolkit dependent part. Always initialize to NULL. */
105 void* toolkit_data;
106 /* tell us if we should free the toolkit data slot when freeing the
107 widget_value itself. */
108 Boolean free_toolkit_data;
109
110 /* we resource the widget_value structures; this points to the next
111 one on the free list if this one has been deallocated.
112 */
113 struct _widget_value *free_list;
114 #endif
115 } widget_value;
116
117 /* Local memory management */
118 #define local_heap (GetProcessHeap ())
119 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
120 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
121
122 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
123 #define free_widget_value(wv) (local_free ((wv)))
124
125 /******************************************************************/
126
127 #ifndef TRUE
128 #define TRUE 1
129 #define FALSE 0
130 #endif /* no TRUE */
131
132 static HMENU current_popup_menu;
133
134 void syms_of_w32menu ();
135 void globals_of_w32menu ();
136
137 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
138 IN HMENU,
139 IN UINT,
140 IN BOOL,
141 IN OUT LPMENUITEMINFOA);
142 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
143 IN HMENU,
144 IN UINT,
145 IN BOOL,
146 IN LPCMENUITEMINFOA);
147
148 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
149 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
150 AppendMenuW_Proc unicode_append_menu = NULL;
151
152 Lisp_Object Vmenu_updating_frame;
153
154 Lisp_Object Qdebug_on_next_call;
155
156 extern Lisp_Object Qmenu_bar;
157
158 extern Lisp_Object QCtoggle, QCradio;
159
160 extern Lisp_Object Voverriding_local_map;
161 extern Lisp_Object Voverriding_local_map_menu_flag;
162
163 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
164
165 extern Lisp_Object Qmenu_bar_update_hook;
166
167 void set_frame_menubar ();
168
169 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
170 Lisp_Object, Lisp_Object, Lisp_Object,
171 Lisp_Object, Lisp_Object));
172 #ifdef HAVE_DIALOGS
173 static Lisp_Object w32_dialog_show ();
174 #endif
175 static Lisp_Object w32_menu_show ();
176
177 static void keymap_panes ();
178 static void single_keymap_panes ();
179 static void single_menu_item ();
180 static void list_of_panes ();
181 static void list_of_items ();
182 void w32_free_menu_strings (HWND);
183 \f
184 /* This holds a Lisp vector that holds the results of decoding
185 the keymaps or alist-of-alists that specify a menu.
186
187 It describes the panes and items within the panes.
188
189 Each pane is described by 3 elements in the vector:
190 t, the pane name, the pane's prefix key.
191 Then follow the pane's items, with 5 elements per item:
192 the item string, the enable flag, the item's value,
193 the definition, and the equivalent keyboard key's description string.
194
195 In some cases, multiple levels of menus may be described.
196 A single vector slot containing nil indicates the start of a submenu.
197 A single vector slot containing lambda indicates the end of a submenu.
198 The submenu follows a menu item which is the way to reach the submenu.
199
200 A single vector slot containing quote indicates that the
201 following items should appear on the right of a dialog box.
202
203 Using a Lisp vector to hold this information while we decode it
204 takes care of protecting all the data from GC. */
205
206 #define MENU_ITEMS_PANE_NAME 1
207 #define MENU_ITEMS_PANE_PREFIX 2
208 #define MENU_ITEMS_PANE_LENGTH 3
209
210 enum menu_item_idx
211 {
212 MENU_ITEMS_ITEM_NAME = 0,
213 MENU_ITEMS_ITEM_ENABLE,
214 MENU_ITEMS_ITEM_VALUE,
215 MENU_ITEMS_ITEM_EQUIV_KEY,
216 MENU_ITEMS_ITEM_DEFINITION,
217 MENU_ITEMS_ITEM_TYPE,
218 MENU_ITEMS_ITEM_SELECTED,
219 MENU_ITEMS_ITEM_HELP,
220 MENU_ITEMS_ITEM_LENGTH
221 };
222
223 static Lisp_Object menu_items;
224
225 /* Number of slots currently allocated in menu_items. */
226 static int menu_items_allocated;
227
228 /* This is the index in menu_items of the first empty slot. */
229 static int menu_items_used;
230
231 /* The number of panes currently recorded in menu_items,
232 excluding those within submenus. */
233 static int menu_items_n_panes;
234
235 /* Current depth within submenus. */
236 static int menu_items_submenu_depth;
237
238 /* Flag which when set indicates a dialog or menu has been posted by
239 Xt on behalf of one of the widget sets. */
240 static int popup_activated_flag;
241
242 static int next_menubar_widget_id;
243
244 /* This is set nonzero after the user activates the menu bar, and set
245 to zero again after the menu bars are redisplayed by prepare_menu_bar.
246 While it is nonzero, all calls to set_frame_menubar go deep.
247
248 I don't understand why this is needed, but it does seem to be
249 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
250
251 int pending_menu_activation;
252 \f
253
254 /* Return the frame whose ->output_data.w32->menubar_widget equals
255 ID, or 0 if none. */
256
257 static struct frame *
258 menubar_id_to_frame (id)
259 HMENU id;
260 {
261 Lisp_Object tail, frame;
262 FRAME_PTR f;
263
264 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
265 {
266 frame = XCAR (tail);
267 if (!GC_FRAMEP (frame))
268 continue;
269 f = XFRAME (frame);
270 if (!FRAME_WINDOW_P (f))
271 continue;
272 if (f->output_data.w32->menubar_widget == id)
273 return f;
274 }
275 return 0;
276 }
277 \f
278 /* Initialize the menu_items structure if we haven't already done so.
279 Also mark it as currently empty. */
280
281 static void
282 init_menu_items ()
283 {
284 if (NILP (menu_items))
285 {
286 menu_items_allocated = 60;
287 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
288 }
289
290 menu_items_used = 0;
291 menu_items_n_panes = 0;
292 menu_items_submenu_depth = 0;
293 }
294
295 /* Call at the end of generating the data in menu_items.
296 This fills in the number of items in the last pane. */
297
298 static void
299 finish_menu_items ()
300 {
301 }
302
303 /* Call when finished using the data for the current menu
304 in menu_items. */
305
306 static void
307 discard_menu_items ()
308 {
309 /* Free the structure if it is especially large.
310 Otherwise, hold on to it, to save time. */
311 if (menu_items_allocated > 200)
312 {
313 menu_items = Qnil;
314 menu_items_allocated = 0;
315 }
316 }
317
318 /* Make the menu_items vector twice as large. */
319
320 static void
321 grow_menu_items ()
322 {
323 Lisp_Object old;
324 int old_size = menu_items_allocated;
325 old = menu_items;
326
327 menu_items_allocated *= 2;
328 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
329 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
330 old_size * sizeof (Lisp_Object));
331 }
332
333 /* Begin a submenu. */
334
335 static void
336 push_submenu_start ()
337 {
338 if (menu_items_used + 1 > menu_items_allocated)
339 grow_menu_items ();
340
341 ASET (menu_items, menu_items_used++, Qnil);
342 menu_items_submenu_depth++;
343 }
344
345 /* End a submenu. */
346
347 static void
348 push_submenu_end ()
349 {
350 if (menu_items_used + 1 > menu_items_allocated)
351 grow_menu_items ();
352
353 ASET (menu_items, menu_items_used++, Qlambda);
354 menu_items_submenu_depth--;
355 }
356
357 /* Indicate boundary between left and right. */
358
359 static void
360 push_left_right_boundary ()
361 {
362 if (menu_items_used + 1 > menu_items_allocated)
363 grow_menu_items ();
364
365 ASET (menu_items, menu_items_used++, Qquote);
366 }
367
368 /* Start a new menu pane in menu_items.
369 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
370
371 static void
372 push_menu_pane (name, prefix_vec)
373 Lisp_Object name, prefix_vec;
374 {
375 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
376 grow_menu_items ();
377
378 if (menu_items_submenu_depth == 0)
379 menu_items_n_panes++;
380 ASET (menu_items, menu_items_used++, Qt);
381 ASET (menu_items, menu_items_used++, name);
382 ASET (menu_items, menu_items_used++, prefix_vec);
383 }
384
385 /* Push one menu item into the current pane. NAME is the string to
386 display. ENABLE if non-nil means this item can be selected. KEY
387 is the key generated by choosing this item, or nil if this item
388 doesn't really have a definition. DEF is the definition of this
389 item. EQUIV is the textual description of the keyboard equivalent
390 for this item (or nil if none). TYPE is the type of this menu
391 item, one of nil, `toggle' or `radio'. */
392
393 static void
394 push_menu_item (name, enable, key, def, equiv, type, selected, help)
395 Lisp_Object name, enable, key, def, equiv, type, selected, help;
396 {
397 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
398 grow_menu_items ();
399
400 ASET (menu_items, menu_items_used++, name);
401 ASET (menu_items, menu_items_used++, enable);
402 ASET (menu_items, menu_items_used++, key);
403 ASET (menu_items, menu_items_used++, equiv);
404 ASET (menu_items, menu_items_used++, def);
405 ASET (menu_items, menu_items_used++, type);
406 ASET (menu_items, menu_items_used++, selected);
407 ASET (menu_items, menu_items_used++, help);
408 }
409 \f
410 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
411 and generate menu panes for them in menu_items.
412 If NOTREAL is nonzero,
413 don't bother really computing whether an item is enabled. */
414
415 static void
416 keymap_panes (keymaps, nmaps, notreal)
417 Lisp_Object *keymaps;
418 int nmaps;
419 int notreal;
420 {
421 int mapno;
422
423 init_menu_items ();
424
425 /* Loop over the given keymaps, making a pane for each map.
426 But don't make a pane that is empty--ignore that map instead.
427 P is the number of panes we have made so far. */
428 for (mapno = 0; mapno < nmaps; mapno++)
429 single_keymap_panes (keymaps[mapno],
430 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
431
432 finish_menu_items ();
433 }
434
435 /* This is a recursive subroutine of keymap_panes.
436 It handles one keymap, KEYMAP.
437 The other arguments are passed along
438 or point to local variables of the previous function.
439 If NOTREAL is nonzero, only check for equivalent key bindings, don't
440 evaluate expressions in menu items and don't make any menu.
441
442 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
443
444 static void
445 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
446 Lisp_Object keymap;
447 Lisp_Object pane_name;
448 Lisp_Object prefix;
449 int notreal;
450 int maxdepth;
451 {
452 Lisp_Object pending_maps = Qnil;
453 Lisp_Object tail, item;
454 struct gcpro gcpro1, gcpro2;
455
456 if (maxdepth <= 0)
457 return;
458
459 push_menu_pane (pane_name, prefix);
460
461 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
462 {
463 GCPRO2 (keymap, pending_maps);
464 /* Look at each key binding, and if it is a menu item add it
465 to this menu. */
466 item = XCAR (tail);
467 if (CONSP (item))
468 single_menu_item (XCAR (item), XCDR (item),
469 &pending_maps, notreal, maxdepth);
470 else if (VECTORP (item))
471 {
472 /* Loop over the char values represented in the vector. */
473 int len = ASIZE (item);
474 int c;
475 for (c = 0; c < len; c++)
476 {
477 Lisp_Object character;
478 XSETFASTINT (character, c);
479 single_menu_item (character, AREF (item, c),
480 &pending_maps, notreal, maxdepth);
481 }
482 }
483 UNGCPRO;
484 }
485
486 /* Process now any submenus which want to be panes at this level. */
487 while (!NILP (pending_maps))
488 {
489 Lisp_Object elt, eltcdr, string;
490 elt = Fcar (pending_maps);
491 eltcdr = XCDR (elt);
492 string = XCAR (eltcdr);
493 /* We no longer discard the @ from the beginning of the string here.
494 Instead, we do this in w32_menu_show. */
495 single_keymap_panes (Fcar (elt), string,
496 XCDR (eltcdr), notreal, maxdepth - 1);
497 pending_maps = Fcdr (pending_maps);
498 }
499 }
500 \f
501 /* This is a subroutine of single_keymap_panes that handles one
502 keymap entry.
503 KEY is a key in a keymap and ITEM is its binding.
504 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
505 separate panes.
506 If NOTREAL is nonzero, only check for equivalent key bindings, don't
507 evaluate expressions in menu items and don't make any menu.
508 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
509
510 static void
511 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
512 Lisp_Object key, item;
513 Lisp_Object *pending_maps_ptr;
514 int maxdepth, notreal;
515 {
516 Lisp_Object map, item_string, enabled;
517 struct gcpro gcpro1, gcpro2;
518 int res;
519
520 /* Parse the menu item and leave the result in item_properties. */
521 GCPRO2 (key, item);
522 res = parse_menu_item (item, notreal, 0);
523 UNGCPRO;
524 if (!res)
525 return; /* Not a menu item. */
526
527 map = AREF (item_properties, ITEM_PROPERTY_MAP);
528
529 if (notreal)
530 {
531 /* We don't want to make a menu, just traverse the keymaps to
532 precompute equivalent key bindings. */
533 if (!NILP (map))
534 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
535 return;
536 }
537
538 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
539 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
540
541 if (!NILP (map) && SREF (item_string, 0) == '@')
542 {
543 if (!NILP (enabled))
544 /* An enabled separate pane. Remember this to handle it later. */
545 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
546 *pending_maps_ptr);
547 return;
548 }
549
550 push_menu_item (item_string, enabled, key,
551 AREF (item_properties, ITEM_PROPERTY_DEF),
552 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
553 AREF (item_properties, ITEM_PROPERTY_TYPE),
554 AREF (item_properties, ITEM_PROPERTY_SELECTED),
555 AREF (item_properties, ITEM_PROPERTY_HELP));
556
557 /* Display a submenu using the toolkit. */
558 if (! (NILP (map) || NILP (enabled)))
559 {
560 push_submenu_start ();
561 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
562 push_submenu_end ();
563 }
564 }
565 \f
566 /* Push all the panes and items of a menu described by the
567 alist-of-alists MENU.
568 This handles old-fashioned calls to x-popup-menu. */
569
570 static void
571 list_of_panes (menu)
572 Lisp_Object menu;
573 {
574 Lisp_Object tail;
575
576 init_menu_items ();
577
578 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
579 {
580 Lisp_Object elt, pane_name, pane_data;
581 elt = Fcar (tail);
582 pane_name = Fcar (elt);
583 CHECK_STRING (pane_name);
584 push_menu_pane (pane_name, Qnil);
585 pane_data = Fcdr (elt);
586 CHECK_CONS (pane_data);
587 list_of_items (pane_data);
588 }
589
590 finish_menu_items ();
591 }
592
593 /* Push the items in a single pane defined by the alist PANE. */
594
595 static void
596 list_of_items (pane)
597 Lisp_Object pane;
598 {
599 Lisp_Object tail, item, item1;
600
601 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
602 {
603 item = Fcar (tail);
604 if (STRINGP (item))
605 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
606 else if (NILP (item))
607 push_left_right_boundary ();
608 else
609 {
610 CHECK_CONS (item);
611 item1 = Fcar (item);
612 CHECK_STRING (item1);
613 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
614 }
615 }
616 }
617 \f
618 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
619 doc: /* Pop up a deck-of-cards menu and return user's selection.
620 POSITION is a position specification. This is either a mouse button
621 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
622 are positions in pixels from the top left corner of WINDOW's frame
623 \(WINDOW may be a frame object instead of a window). This controls the
624 position of the center of the first line in the first pane of the
625 menu, not the top left of the menu as a whole. If POSITION is t, it
626 means to use the current mouse position.
627
628 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
629 The menu items come from key bindings that have a menu string as well as
630 a definition; actually, the \"definition\" in such a key binding looks like
631 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
632 the keymap as a top-level element.
633
634 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
635 Otherwise, REAL-DEFINITION should be a valid key binding definition.
636
637 You can also use a list of keymaps as MENU. Then each keymap makes a
638 separate pane. When MENU is a keymap or a list of keymaps, the return
639 value is a list of events.
640
641 Alternatively, you can specify a menu of multiple panes with a list of
642 the form (TITLE PANE1 PANE2...), where each pane is a list of
643 form (TITLE ITEM1 ITEM2...).
644 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
645 appear as an item--that makes a nonselectable line in the menu.
646 With this form of menu, the return value is VALUE from the chosen item.
647
648 If POSITION is nil, don't display the menu at all, just precalculate the
649 cached information about equivalent key sequences. */)
650 (position, menu)
651 Lisp_Object position, menu;
652 {
653 Lisp_Object keymap, tem;
654 int xpos = 0, ypos = 0;
655 Lisp_Object title;
656 char *error_name;
657 Lisp_Object selection;
658 FRAME_PTR f = NULL;
659 Lisp_Object x, y, window;
660 int keymaps = 0;
661 int for_click = 0;
662 struct gcpro gcpro1;
663
664 #ifdef HAVE_MENUS
665 if (! NILP (position))
666 {
667 check_w32 ();
668
669 /* Decode the first argument: find the window and the coordinates. */
670 if (EQ (position, Qt)
671 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
672 || EQ (XCAR (position), Qtool_bar))))
673 {
674 /* Use the mouse's current position. */
675 FRAME_PTR new_f = SELECTED_FRAME ();
676 Lisp_Object bar_window;
677 enum scroll_bar_part part;
678 unsigned long time;
679
680 if (mouse_position_hook)
681 (*mouse_position_hook) (&new_f, 1, &bar_window,
682 &part, &x, &y, &time);
683 if (new_f != 0)
684 XSETFRAME (window, new_f);
685 else
686 {
687 window = selected_window;
688 XSETFASTINT (x, 0);
689 XSETFASTINT (y, 0);
690 }
691 }
692 else
693 {
694 tem = Fcar (position);
695 if (CONSP (tem))
696 {
697 window = Fcar (Fcdr (position));
698 x = Fcar (tem);
699 y = Fcar (Fcdr (tem));
700 }
701 else
702 {
703 for_click = 1;
704 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
705 window = Fcar (tem); /* POSN_WINDOW (tem) */
706 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
707 x = Fcar (tem);
708 y = Fcdr (tem);
709 }
710 }
711
712 CHECK_NUMBER (x);
713 CHECK_NUMBER (y);
714
715 /* Decode where to put the menu. */
716
717 if (FRAMEP (window))
718 {
719 f = XFRAME (window);
720 xpos = 0;
721 ypos = 0;
722 }
723 else if (WINDOWP (window))
724 {
725 CHECK_LIVE_WINDOW (window);
726 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
727
728 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
729 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
730 }
731 else
732 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
733 but I don't want to make one now. */
734 CHECK_WINDOW (window);
735
736 xpos += XINT (x);
737 ypos += XINT (y);
738
739 XSETFRAME (Vmenu_updating_frame, f);
740 }
741 else
742 Vmenu_updating_frame = Qnil;
743 #endif /* HAVE_MENUS */
744
745 title = Qnil;
746 GCPRO1 (title);
747
748 /* Decode the menu items from what was specified. */
749
750 keymap = get_keymap (menu, 0, 0);
751 if (CONSP (keymap))
752 {
753 /* We were given a keymap. Extract menu info from the keymap. */
754 Lisp_Object prompt;
755
756 /* Extract the detailed info to make one pane. */
757 keymap_panes (&menu, 1, NILP (position));
758
759 /* Search for a string appearing directly as an element of the keymap.
760 That string is the title of the menu. */
761 prompt = Fkeymap_prompt (keymap);
762 if (NILP (title) && !NILP (prompt))
763 title = prompt;
764
765 /* Make that be the pane title of the first pane. */
766 if (!NILP (prompt) && menu_items_n_panes >= 0)
767 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
768
769 keymaps = 1;
770 }
771 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
772 {
773 /* We were given a list of keymaps. */
774 int nmaps = XFASTINT (Flength (menu));
775 Lisp_Object *maps
776 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
777 int i;
778
779 title = Qnil;
780
781 /* The first keymap that has a prompt string
782 supplies the menu title. */
783 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
784 {
785 Lisp_Object prompt;
786
787 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
788
789 prompt = Fkeymap_prompt (keymap);
790 if (NILP (title) && !NILP (prompt))
791 title = prompt;
792 }
793
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (maps, nmaps, NILP (position));
796
797 /* Make the title be the pane title of the first pane. */
798 if (!NILP (title) && menu_items_n_panes >= 0)
799 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
800
801 keymaps = 1;
802 }
803 else
804 {
805 /* We were given an old-fashioned menu. */
806 title = Fcar (menu);
807 CHECK_STRING (title);
808
809 list_of_panes (Fcdr (menu));
810
811 keymaps = 0;
812 }
813
814 if (NILP (position))
815 {
816 discard_menu_items ();
817 UNGCPRO;
818 return Qnil;
819 }
820
821 #ifdef HAVE_MENUS
822 /* If resources from a previous popup menu exist yet, does nothing
823 until the `menu_free_timer' has freed them (see w32fns.c).
824 */
825 if (current_popup_menu)
826 {
827 discard_menu_items ();
828 UNGCPRO;
829 return Qnil;
830 }
831
832 /* Display them in a menu. */
833 BLOCK_INPUT;
834
835 selection = w32_menu_show (f, xpos, ypos, for_click,
836 keymaps, title, &error_name);
837 UNBLOCK_INPUT;
838
839 discard_menu_items ();
840 #endif /* HAVE_MENUS */
841
842 UNGCPRO;
843
844 if (error_name) error (error_name);
845 return selection;
846 }
847
848 #ifdef HAVE_MENUS
849
850 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
851 doc: /* Pop up a dialog box and return user's selection.
852 POSITION specifies which frame to use.
853 This is normally a mouse button event or a window or frame.
854 If POSITION is t, it means to use the frame the mouse is on.
855 The dialog box appears in the middle of the specified frame.
856
857 CONTENTS specifies the alternatives to display in the dialog box.
858 It is a list of the form (TITLE ITEM1 ITEM2...).
859 Each ITEM is a cons cell (STRING . VALUE).
860 The return value is VALUE from the chosen item.
861
862 An ITEM may also be just a string--that makes a nonselectable item.
863 An ITEM may also be nil--that means to put all preceding items
864 on the left of the dialog box and all following items on the right.
865 \(By default, approximately half appear on each side.)
866
867 If HEADER is non-nil, the frame title for the box is "Information",
868 otherwise it is "Question". */)
869 (position, contents, header)
870 Lisp_Object position, contents, header;
871 {
872 FRAME_PTR f = NULL;
873 Lisp_Object window;
874
875 check_w32 ();
876
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))))
881 {
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;
889
890 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
891
892 if (new_f != 0)
893 XSETFRAME (window, new_f);
894 else
895 window = selected_window;
896 #endif
897 window = selected_window;
898 }
899 else if (CONSP (position))
900 {
901 Lisp_Object tem;
902 tem = Fcar (position);
903 if (CONSP (tem))
904 window = Fcar (Fcdr (position));
905 else
906 {
907 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
908 window = Fcar (tem); /* POSN_WINDOW (tem) */
909 }
910 }
911 else if (WINDOWP (position) || FRAMEP (position))
912 window = position;
913 else
914 window = Qnil;
915
916 /* Decode where to put the menu. */
917
918 if (FRAMEP (window))
919 f = XFRAME (window);
920 else if (WINDOWP (window))
921 {
922 CHECK_LIVE_WINDOW (window);
923 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
924 }
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);
929
930 #ifndef HAVE_DIALOGS
931 /* Display a menu with these alternatives
932 in the middle of frame F. */
933 {
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));
939
940 return Fx_popup_menu (newpos,
941 Fcons (Fcar (contents), Fcons (contents, Qnil)));
942 }
943 #else /* HAVE_DIALOGS */
944 {
945 Lisp_Object title;
946 char *error_name;
947 Lisp_Object selection;
948
949 /* Decode the dialog items from what was specified. */
950 title = Fcar (contents);
951 CHECK_STRING (title);
952
953 list_of_panes (Fcons (contents, Qnil));
954
955 /* Display them in a dialog box. */
956 BLOCK_INPUT;
957 selection = w32_dialog_show (f, 0, title, header, &error_name);
958 UNBLOCK_INPUT;
959
960 discard_menu_items ();
961
962 if (error_name) error (error_name);
963 return selection;
964 }
965 #endif /* HAVE_DIALOGS */
966 }
967
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.
971
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.
975
976 But first we recompute the menu bar contents (the whole tree).
977
978 This way we can safely execute Lisp code. */
979
980 void
981 x_activate_menubar (f)
982 FRAME_PTR f;
983 {
984 set_frame_menubar (f, 0, 1);
985
986 /* Lock out further menubar changes while active. */
987 f->output_data.w32->menubar_active = 1;
988
989 /* Signal input thread to return from WM_INITMENU. */
990 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
991 }
992
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. */
997
998 void
999 menubar_selection_callback (FRAME_PTR f, void * client_data)
1000 {
1001 Lisp_Object prefix, entry;
1002 Lisp_Object vector;
1003 Lisp_Object *subprefix_stack;
1004 int submenu_depth = 0;
1005 int i;
1006
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)
1015 {
1016 if (EQ (AREF (vector, i), Qnil))
1017 {
1018 subprefix_stack[submenu_depth++] = prefix;
1019 prefix = entry;
1020 i++;
1021 }
1022 else if (EQ (AREF (vector, i), Qlambda))
1023 {
1024 prefix = subprefix_stack[--submenu_depth];
1025 i++;
1026 }
1027 else if (EQ (AREF (vector, i), Qt))
1028 {
1029 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1030 i += MENU_ITEMS_PANE_LENGTH;
1031 }
1032 else
1033 {
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)
1038 {
1039 int j;
1040 struct input_event buf;
1041 Lisp_Object frame;
1042 EVENT_INIT (buf);
1043
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);
1049
1050 for (j = 0; j < submenu_depth; j++)
1051 if (!NILP (subprefix_stack[j]))
1052 {
1053 buf.kind = MENU_BAR_EVENT;
1054 buf.frame_or_window = frame;
1055 buf.arg = subprefix_stack[j];
1056 kbd_buffer_store_event (&buf);
1057 }
1058
1059 if (!NILP (prefix))
1060 {
1061 buf.kind = MENU_BAR_EVENT;
1062 buf.frame_or_window = frame;
1063 buf.arg = prefix;
1064 kbd_buffer_store_event (&buf);
1065 }
1066
1067 buf.kind = MENU_BAR_EVENT;
1068 buf.frame_or_window = frame;
1069 buf.arg = entry;
1070 kbd_buffer_store_event (&buf);
1071
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;
1077 }
1078 i += MENU_ITEMS_ITEM_LENGTH;
1079 }
1080 }
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;
1085 }
1086
1087 /* Allocate a widget_value, blocking input. */
1088
1089 widget_value *
1090 xmalloc_widget_value ()
1091 {
1092 widget_value *value;
1093
1094 BLOCK_INPUT;
1095 value = malloc_widget_value ();
1096 UNBLOCK_INPUT;
1097
1098 return value;
1099 }
1100
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. */
1105
1106 void
1107 free_menubar_widget_value_tree (wv)
1108 widget_value *wv;
1109 {
1110 if (! wv) return;
1111
1112 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1113
1114 if (wv->contents && (wv->contents != (widget_value*)1))
1115 {
1116 free_menubar_widget_value_tree (wv->contents);
1117 wv->contents = (widget_value *) 0xDEADBEEF;
1118 }
1119 if (wv->next)
1120 {
1121 free_menubar_widget_value_tree (wv->next);
1122 wv->next = (widget_value *) 0xDEADBEEF;
1123 }
1124 BLOCK_INPUT;
1125 free_widget_value (wv);
1126 UNBLOCK_INPUT;
1127 }
1128 \f
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. */
1132
1133 static int
1134 parse_single_submenu (item_key, item_name, maps)
1135 Lisp_Object item_key, item_name, maps;
1136 {
1137 Lisp_Object length;
1138 int len;
1139 Lisp_Object *mapvec;
1140 int i;
1141 int top_level_items = 0;
1142
1143 length = Flength (maps);
1144 len = XINT (length);
1145
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++)
1149 {
1150 mapvec[i] = Fcar (maps);
1151 maps = Fcdr (maps);
1152 }
1153
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++)
1157 {
1158 if (SYMBOLP (mapvec[i])
1159 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1160 {
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);
1167 }
1168 else
1169 {
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);
1175 }
1176 }
1177
1178 return top_level_items;
1179 }
1180
1181
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. */
1185
1186 static widget_value *
1187 digest_single_submenu (start, end, top_level_items)
1188 int start, end, top_level_items;
1189 {
1190 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1191 int i;
1192 int submenu_depth = 0;
1193 widget_value **submenu_stack;
1194
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;
1206
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)
1213 {
1214 if (EQ (AREF (menu_items, i), Qnil))
1215 {
1216 submenu_stack[submenu_depth++] = save_wv;
1217 save_wv = prev_wv;
1218 prev_wv = 0;
1219 i++;
1220 }
1221 else if (EQ (AREF (menu_items, i), Qlambda))
1222 {
1223 prev_wv = save_wv;
1224 save_wv = submenu_stack[--submenu_depth];
1225 i++;
1226 }
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))
1235 {
1236 /* Create a new pane. */
1237 Lisp_Object pane_name, prefix;
1238 char *pane_string;
1239
1240 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1241 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1242
1243 if (STRINGP (pane_name))
1244 {
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);
1250
1251 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1252 }
1253
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 = "";
1260
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, ""))
1265 {
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;
1277 }
1278 save_wv = wv;
1279 prev_wv = 0;
1280 i += MENU_ITEMS_PANE_LENGTH;
1281 }
1282 else
1283 {
1284 /* Create a new item within current pane. */
1285 Lisp_Object item_name, enable, descrip, def, type, selected;
1286 Lisp_Object help;
1287
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);
1295
1296 if (STRINGP (item_name))
1297 {
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);
1302
1303 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1304 }
1305
1306 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1307 {
1308 descrip = ENCODE_SYSTEM (descrip);
1309 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1310 }
1311
1312 wv = xmalloc_widget_value ();
1313 if (prev_wv)
1314 prev_wv->next = wv;
1315 else
1316 save_wv->contents = wv;
1317
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);
1326
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 ();
1335
1336 wv->selected = !NILP (selected);
1337 if (!STRINGP (help))
1338 help = Qnil;
1339
1340 wv->help = help;
1341
1342 prev_wv = wv;
1343
1344 i += MENU_ITEMS_ITEM_LENGTH;
1345 }
1346 }
1347
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)
1351 {
1352 wv = first_wv->contents;
1353 free_widget_value (first_wv);
1354 return wv;
1355 }
1356
1357 return first_wv;
1358 }
1359
1360
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;
1369 {
1370 widget_value *wv;
1371
1372 for (wv = first_wv; wv; wv = wv->next)
1373 {
1374 if (wv->lname && ! NILP (wv->lname))
1375 {
1376 wv->name = SDATA (wv->lname);
1377
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)
1381 {
1382 if (wv->name[0] == '@')
1383 wv->name++;
1384 wv->value = 0;
1385 }
1386 }
1387
1388 if (wv->lkey && ! NILP (wv->lkey))
1389 wv->key = SDATA (wv->lkey);
1390
1391 if (wv->contents)
1392 update_submenu_strings (wv->contents);
1393 }
1394 }
1395
1396 \f
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. */
1400
1401 void
1402 set_frame_menubar (f, first_time, deep_p)
1403 FRAME_PTR f;
1404 int first_time;
1405 int deep_p;
1406 {
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;
1413
1414 /* We must not change the menubar when actually in use. */
1415 if (f->output_data.w32->menubar_active)
1416 return;
1417
1418 XSETFRAME (Vmenu_updating_frame, f);
1419
1420 if (! menubar_widget)
1421 deep_p = 1;
1422 else if (pending_menu_activation && !deep_p)
1423 deep_p = 1;
1424
1425 if (deep_p)
1426 {
1427 /* Make a widget-value tree representing the entire menu trees. */
1428
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));
1436
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;
1441
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);
1447
1448 record_unwind_save_match_data ();
1449
1450 if (NILP (Voverriding_local_map_menu_flag))
1451 {
1452 specbind (Qoverriding_terminal_local_map, Qnil);
1453 specbind (Qoverriding_local_map, Qnil);
1454 }
1455
1456 set_buffer_internal_1 (XBUFFER (buffer));
1457
1458 /* Run the Lucid hook. */
1459 safe_run_hooks (Qactivate_menubar_hook);
1460 /* If it has changed current-menubar from previous value,
1461 really recompute the menubar from the value. */
1462 if (! NILP (Vlucid_menu_bar_dirty_flag))
1463 call0 (Qrecompute_lucid_menubar);
1464 safe_run_hooks (Qmenu_bar_update_hook);
1465 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1466
1467 items = FRAME_MENU_BAR_ITEMS (f);
1468
1469 /* Save the frame's previous menu bar contents data. */
1470 if (previous_menu_items_used)
1471 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1472 previous_menu_items_used * sizeof (Lisp_Object));
1473
1474 /* Fill in menu_items with the current menu bar contents.
1475 This can evaluate Lisp code. */
1476 menu_items = f->menu_bar_vector;
1477 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1478 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1479 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1480 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1481 submenu_top_level_items
1482 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1483 init_menu_items ();
1484 for (i = 0; i < ASIZE (items); i += 4)
1485 {
1486 Lisp_Object key, string, maps;
1487
1488 last_i = i;
1489
1490 key = AREF (items, i);
1491 string = AREF (items, i + 1);
1492 maps = AREF (items, i + 2);
1493 if (NILP (string))
1494 break;
1495
1496 submenu_start[i] = menu_items_used;
1497
1498 menu_items_n_panes = 0;
1499 submenu_top_level_items[i]
1500 = parse_single_submenu (key, string, maps);
1501 submenu_n_panes[i] = menu_items_n_panes;
1502
1503 submenu_end[i] = menu_items_used;
1504 }
1505
1506 finish_menu_items ();
1507
1508 /* Convert menu_items into widget_value trees
1509 to display the menu. This cannot evaluate Lisp code. */
1510
1511 wv = xmalloc_widget_value ();
1512 wv->name = "menubar";
1513 wv->value = 0;
1514 wv->enabled = 1;
1515 wv->button_type = BUTTON_TYPE_NONE;
1516 wv->help = Qnil;
1517 first_wv = wv;
1518
1519 for (i = 0; i < last_i; i += 4)
1520 {
1521 menu_items_n_panes = submenu_n_panes[i];
1522 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1523 submenu_top_level_items[i]);
1524 if (prev_wv)
1525 prev_wv->next = wv;
1526 else
1527 first_wv->contents = wv;
1528 /* Don't set wv->name here; GC during the loop might relocate it. */
1529 wv->enabled = 1;
1530 wv->button_type = BUTTON_TYPE_NONE;
1531 prev_wv = wv;
1532 }
1533
1534 set_buffer_internal_1 (prev);
1535 unbind_to (specpdl_count, Qnil);
1536
1537 /* If there has been no change in the Lisp-level contents
1538 of the menu bar, skip redisplaying it. Just exit. */
1539
1540 for (i = 0; i < previous_menu_items_used; i++)
1541 if (menu_items_used == i
1542 || (!EQ (previous_items[i], AREF (menu_items, i))))
1543 break;
1544 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1545 {
1546 free_menubar_widget_value_tree (first_wv);
1547 menu_items = Qnil;
1548
1549 return;
1550 }
1551
1552 /* Now GC cannot happen during the lifetime of the widget_value,
1553 so it's safe to store data from a Lisp_String, as long as
1554 local copies are made when the actual menu is created.
1555 Windows takes care of this for normal string items, but
1556 not for owner-drawn items or additional item-info. */
1557 wv = first_wv->contents;
1558 for (i = 0; i < ASIZE (items); i += 4)
1559 {
1560 Lisp_Object string;
1561 string = AREF (items, i + 1);
1562 if (NILP (string))
1563 break;
1564 wv->name = (char *) SDATA (string);
1565 update_submenu_strings (wv->contents);
1566 wv = wv->next;
1567 }
1568
1569 f->menu_bar_vector = menu_items;
1570 f->menu_bar_items_used = menu_items_used;
1571 menu_items = Qnil;
1572 }
1573 else
1574 {
1575 /* Make a widget-value tree containing
1576 just the top level menu bar strings. */
1577
1578 wv = xmalloc_widget_value ();
1579 wv->name = "menubar";
1580 wv->value = 0;
1581 wv->enabled = 1;
1582 wv->button_type = BUTTON_TYPE_NONE;
1583 wv->help = Qnil;
1584 first_wv = wv;
1585
1586 items = FRAME_MENU_BAR_ITEMS (f);
1587 for (i = 0; i < ASIZE (items); i += 4)
1588 {
1589 Lisp_Object string;
1590
1591 string = AREF (items, i + 1);
1592 if (NILP (string))
1593 break;
1594
1595 wv = xmalloc_widget_value ();
1596 wv->name = (char *) SDATA (string);
1597 wv->value = 0;
1598 wv->enabled = 1;
1599 wv->button_type = BUTTON_TYPE_NONE;
1600 wv->help = Qnil;
1601 /* This prevents lwlib from assuming this
1602 menu item is really supposed to be empty. */
1603 /* The EMACS_INT cast avoids a warning.
1604 This value just has to be different from small integers. */
1605 wv->call_data = (void *) (EMACS_INT) (-1);
1606
1607 if (prev_wv)
1608 prev_wv->next = wv;
1609 else
1610 first_wv->contents = wv;
1611 prev_wv = wv;
1612 }
1613
1614 /* Forget what we thought we knew about what is in the
1615 detailed contents of the menu bar menus.
1616 Changing the top level always destroys the contents. */
1617 f->menu_bar_items_used = 0;
1618 }
1619
1620 /* Create or update the menu bar widget. */
1621
1622 BLOCK_INPUT;
1623
1624 if (menubar_widget)
1625 {
1626 /* Empty current menubar, rather than creating a fresh one. */
1627 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1628 ;
1629 }
1630 else
1631 {
1632 menubar_widget = CreateMenu ();
1633 }
1634 fill_in_menu (menubar_widget, first_wv->contents);
1635
1636 free_menubar_widget_value_tree (first_wv);
1637
1638 {
1639 HMENU old_widget = f->output_data.w32->menubar_widget;
1640
1641 f->output_data.w32->menubar_widget = menubar_widget;
1642 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1643 /* Causes flicker when menu bar is updated
1644 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1645
1646 /* Force the window size to be recomputed so that the frame's text
1647 area remains the same, if menubar has just been created. */
1648 if (old_widget == NULL)
1649 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1650 }
1651
1652 UNBLOCK_INPUT;
1653 }
1654
1655 /* Called from Fx_create_frame to create the initial menubar of a frame
1656 before it is mapped, so that the window is mapped with the menubar already
1657 there instead of us tacking it on later and thrashing the window after it
1658 is visible. */
1659
1660 void
1661 initialize_frame_menubar (f)
1662 FRAME_PTR f;
1663 {
1664 /* This function is called before the first chance to redisplay
1665 the frame. It has to be, so the frame will have the right size. */
1666 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1667 set_frame_menubar (f, 1, 1);
1668 }
1669
1670 /* Get rid of the menu bar of frame F, and free its storage.
1671 This is used when deleting a frame, and when turning off the menu bar. */
1672
1673 void
1674 free_frame_menubar (f)
1675 FRAME_PTR f;
1676 {
1677 BLOCK_INPUT;
1678
1679 {
1680 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1681 SetMenu (FRAME_W32_WINDOW (f), NULL);
1682 f->output_data.w32->menubar_widget = NULL;
1683 DestroyMenu (old);
1684 }
1685
1686 UNBLOCK_INPUT;
1687 }
1688
1689 \f
1690 /* w32_menu_show actually displays a menu using the panes and items in
1691 menu_items and returns the value selected from it; we assume input
1692 is blocked by the caller. */
1693
1694 /* F is the frame the menu is for.
1695 X and Y are the frame-relative specified position,
1696 relative to the inside upper left corner of the frame F.
1697 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1698 KEYMAPS is 1 if this menu was specified with keymaps;
1699 in that case, we return a list containing the chosen item's value
1700 and perhaps also the pane's prefix.
1701 TITLE is the specified menu title.
1702 ERROR is a place to store an error message string in case of failure.
1703 (We return nil on failure, but the value doesn't actually matter.) */
1704
1705 static Lisp_Object
1706 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1707 FRAME_PTR f;
1708 int x;
1709 int y;
1710 int for_click;
1711 int keymaps;
1712 Lisp_Object title;
1713 char **error;
1714 {
1715 int i;
1716 int menu_item_selection;
1717 HMENU menu;
1718 POINT pos;
1719 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1720 widget_value **submenu_stack
1721 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1722 Lisp_Object *subprefix_stack
1723 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1724 int submenu_depth = 0;
1725 int first_pane;
1726
1727 *error = NULL;
1728
1729 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1730 {
1731 *error = "Empty menu";
1732 return Qnil;
1733 }
1734
1735 /* Create a tree of widget_value objects
1736 representing the panes and their items. */
1737 wv = xmalloc_widget_value ();
1738 wv->name = "menu";
1739 wv->value = 0;
1740 wv->enabled = 1;
1741 wv->button_type = BUTTON_TYPE_NONE;
1742 wv->help = Qnil;
1743 first_wv = wv;
1744 first_pane = 1;
1745
1746 /* Loop over all panes and items, filling in the tree. */
1747 i = 0;
1748 while (i < menu_items_used)
1749 {
1750 if (EQ (AREF (menu_items, i), Qnil))
1751 {
1752 submenu_stack[submenu_depth++] = save_wv;
1753 save_wv = prev_wv;
1754 prev_wv = 0;
1755 first_pane = 1;
1756 i++;
1757 }
1758 else if (EQ (AREF (menu_items, i), Qlambda))
1759 {
1760 prev_wv = save_wv;
1761 save_wv = submenu_stack[--submenu_depth];
1762 first_pane = 0;
1763 i++;
1764 }
1765 else if (EQ (AREF (menu_items, i), Qt)
1766 && submenu_depth != 0)
1767 i += MENU_ITEMS_PANE_LENGTH;
1768 /* Ignore a nil in the item list.
1769 It's meaningful only for dialog boxes. */
1770 else if (EQ (AREF (menu_items, i), Qquote))
1771 i += 1;
1772 else if (EQ (AREF (menu_items, i), Qt))
1773 {
1774 /* Create a new pane. */
1775 Lisp_Object pane_name, prefix;
1776 char *pane_string;
1777 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1778 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1779
1780 if (STRINGP (pane_name))
1781 {
1782 if (unicode_append_menu)
1783 pane_name = ENCODE_UTF_8 (pane_name);
1784 else if (STRING_MULTIBYTE (pane_name))
1785 pane_name = ENCODE_SYSTEM (pane_name);
1786
1787 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1788 }
1789
1790 pane_string = (NILP (pane_name)
1791 ? "" : (char *) SDATA (pane_name));
1792 /* If there is just one top-level pane, put all its items directly
1793 under the top-level menu. */
1794 if (menu_items_n_panes == 1)
1795 pane_string = "";
1796
1797 /* If the pane has a meaningful name,
1798 make the pane a top-level menu item
1799 with its items as a submenu beneath it. */
1800 if (!keymaps && strcmp (pane_string, ""))
1801 {
1802 wv = xmalloc_widget_value ();
1803 if (save_wv)
1804 save_wv->next = wv;
1805 else
1806 first_wv->contents = wv;
1807 wv->name = pane_string;
1808 if (keymaps && !NILP (prefix))
1809 wv->name++;
1810 wv->value = 0;
1811 wv->enabled = 1;
1812 wv->button_type = BUTTON_TYPE_NONE;
1813 wv->help = Qnil;
1814 save_wv = wv;
1815 prev_wv = 0;
1816 }
1817 else if (first_pane)
1818 {
1819 save_wv = wv;
1820 prev_wv = 0;
1821 }
1822 first_pane = 0;
1823 i += MENU_ITEMS_PANE_LENGTH;
1824 }
1825 else
1826 {
1827 /* Create a new item within current pane. */
1828 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1829
1830 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1831 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1832 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1833 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1834 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1835 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1836 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1837
1838 if (STRINGP (item_name))
1839 {
1840 if (unicode_append_menu)
1841 item_name = ENCODE_UTF_8 (item_name);
1842 else if (STRING_MULTIBYTE (item_name))
1843 item_name = ENCODE_SYSTEM (item_name);
1844
1845 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1846 }
1847
1848 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1849 {
1850 descrip = ENCODE_SYSTEM (descrip);
1851 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1852 }
1853
1854 wv = xmalloc_widget_value ();
1855 if (prev_wv)
1856 prev_wv->next = wv;
1857 else
1858 save_wv->contents = wv;
1859 wv->name = (char *) SDATA (item_name);
1860 if (!NILP (descrip))
1861 wv->key = (char *) SDATA (descrip);
1862 wv->value = 0;
1863 /* Use the contents index as call_data, since we are
1864 restricted to 16-bits. */
1865 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1866 wv->enabled = !NILP (enable);
1867
1868 if (NILP (type))
1869 wv->button_type = BUTTON_TYPE_NONE;
1870 else if (EQ (type, QCtoggle))
1871 wv->button_type = BUTTON_TYPE_TOGGLE;
1872 else if (EQ (type, QCradio))
1873 wv->button_type = BUTTON_TYPE_RADIO;
1874 else
1875 abort ();
1876
1877 wv->selected = !NILP (selected);
1878 if (!STRINGP (help))
1879 help = Qnil;
1880
1881 wv->help = help;
1882
1883 prev_wv = wv;
1884
1885 i += MENU_ITEMS_ITEM_LENGTH;
1886 }
1887 }
1888
1889 /* Deal with the title, if it is non-nil. */
1890 if (!NILP (title))
1891 {
1892 widget_value *wv_title = xmalloc_widget_value ();
1893 widget_value *wv_sep = xmalloc_widget_value ();
1894
1895 /* Maybe replace this separator with a bitmap or owner-draw item
1896 so that it looks better. Having two separators looks odd. */
1897 wv_sep->name = "--";
1898 wv_sep->next = first_wv->contents;
1899 wv_sep->help = Qnil;
1900
1901 if (unicode_append_menu)
1902 title = ENCODE_UTF_8 (title);
1903 else if (STRING_MULTIBYTE (title))
1904 title = ENCODE_SYSTEM (title);
1905
1906 wv_title->name = (char *) SDATA (title);
1907 wv_title->enabled = TRUE;
1908 wv_title->title = TRUE;
1909 wv_title->button_type = BUTTON_TYPE_NONE;
1910 wv_title->help = Qnil;
1911 wv_title->next = wv_sep;
1912 first_wv->contents = wv_title;
1913 }
1914
1915 /* Actually create the menu. */
1916 current_popup_menu = menu = CreatePopupMenu ();
1917 fill_in_menu (menu, first_wv->contents);
1918
1919 /* Adjust coordinates to be root-window-relative. */
1920 pos.x = x;
1921 pos.y = y;
1922 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1923
1924 /* No selection has been chosen yet. */
1925 menu_item_selection = 0;
1926
1927 /* Display the menu. */
1928 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1929 WM_EMACS_TRACKPOPUPMENU,
1930 (WPARAM)menu, (LPARAM)&pos);
1931
1932 /* Clean up extraneous mouse events which might have been generated
1933 during the call. */
1934 discard_mouse_events ();
1935
1936 /* Free the widget_value objects we used to specify the contents. */
1937 free_menubar_widget_value_tree (first_wv);
1938
1939 DestroyMenu (menu);
1940
1941 /* Find the selected item, and its pane, to return
1942 the proper value. */
1943 if (menu_item_selection != 0)
1944 {
1945 Lisp_Object prefix, entry;
1946
1947 prefix = entry = Qnil;
1948 i = 0;
1949 while (i < menu_items_used)
1950 {
1951 if (EQ (AREF (menu_items, i), Qnil))
1952 {
1953 subprefix_stack[submenu_depth++] = prefix;
1954 prefix = entry;
1955 i++;
1956 }
1957 else if (EQ (AREF (menu_items, i), Qlambda))
1958 {
1959 prefix = subprefix_stack[--submenu_depth];
1960 i++;
1961 }
1962 else if (EQ (AREF (menu_items, i), Qt))
1963 {
1964 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1965 i += MENU_ITEMS_PANE_LENGTH;
1966 }
1967 /* Ignore a nil in the item list.
1968 It's meaningful only for dialog boxes. */
1969 else if (EQ (AREF (menu_items, i), Qquote))
1970 i += 1;
1971 else
1972 {
1973 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1974 if (menu_item_selection == i)
1975 {
1976 if (keymaps != 0)
1977 {
1978 int j;
1979
1980 entry = Fcons (entry, Qnil);
1981 if (!NILP (prefix))
1982 entry = Fcons (prefix, entry);
1983 for (j = submenu_depth - 1; j >= 0; j--)
1984 if (!NILP (subprefix_stack[j]))
1985 entry = Fcons (subprefix_stack[j], entry);
1986 }
1987 return entry;
1988 }
1989 i += MENU_ITEMS_ITEM_LENGTH;
1990 }
1991 }
1992 }
1993
1994 return Qnil;
1995 }
1996 \f
1997
1998 #ifdef HAVE_DIALOGS
1999 static char * button_names [] = {
2000 "button1", "button2", "button3", "button4", "button5",
2001 "button6", "button7", "button8", "button9", "button10" };
2002
2003 static Lisp_Object
2004 w32_dialog_show (f, keymaps, title, header, error)
2005 FRAME_PTR f;
2006 int keymaps;
2007 Lisp_Object title, header;
2008 char **error;
2009 {
2010 int i, nb_buttons=0;
2011 char dialog_name[6];
2012 int menu_item_selection;
2013
2014 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2015
2016 /* Number of elements seen so far, before boundary. */
2017 int left_count = 0;
2018 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2019 int boundary_seen = 0;
2020
2021 *error = NULL;
2022
2023 if (menu_items_n_panes > 1)
2024 {
2025 *error = "Multiple panes in dialog box";
2026 return Qnil;
2027 }
2028
2029 /* Create a tree of widget_value objects
2030 representing the text label and buttons. */
2031 {
2032 Lisp_Object pane_name, prefix;
2033 char *pane_string;
2034 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2035 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2036 pane_string = (NILP (pane_name)
2037 ? "" : (char *) SDATA (pane_name));
2038 prev_wv = xmalloc_widget_value ();
2039 prev_wv->value = pane_string;
2040 if (keymaps && !NILP (prefix))
2041 prev_wv->name++;
2042 prev_wv->enabled = 1;
2043 prev_wv->name = "message";
2044 prev_wv->help = Qnil;
2045 first_wv = prev_wv;
2046
2047 /* Loop over all panes and items, filling in the tree. */
2048 i = MENU_ITEMS_PANE_LENGTH;
2049 while (i < menu_items_used)
2050 {
2051
2052 /* Create a new item within current pane. */
2053 Lisp_Object item_name, enable, descrip, help;
2054
2055 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2056 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2057 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2058 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2059
2060 if (NILP (item_name))
2061 {
2062 free_menubar_widget_value_tree (first_wv);
2063 *error = "Submenu in dialog items";
2064 return Qnil;
2065 }
2066 if (EQ (item_name, Qquote))
2067 {
2068 /* This is the boundary between left-side elts
2069 and right-side elts. Stop incrementing right_count. */
2070 boundary_seen = 1;
2071 i++;
2072 continue;
2073 }
2074 if (nb_buttons >= 9)
2075 {
2076 free_menubar_widget_value_tree (first_wv);
2077 *error = "Too many dialog items";
2078 return Qnil;
2079 }
2080
2081 wv = xmalloc_widget_value ();
2082 prev_wv->next = wv;
2083 wv->name = (char *) button_names[nb_buttons];
2084 if (!NILP (descrip))
2085 wv->key = (char *) SDATA (descrip);
2086 wv->value = (char *) SDATA (item_name);
2087 wv->call_data = (void *) &AREF (menu_items, i);
2088 wv->enabled = !NILP (enable);
2089 wv->help = Qnil;
2090 prev_wv = wv;
2091
2092 if (! boundary_seen)
2093 left_count++;
2094
2095 nb_buttons++;
2096 i += MENU_ITEMS_ITEM_LENGTH;
2097 }
2098
2099 /* If the boundary was not specified,
2100 by default put half on the left and half on the right. */
2101 if (! boundary_seen)
2102 left_count = nb_buttons - nb_buttons / 2;
2103
2104 wv = xmalloc_widget_value ();
2105 wv->name = dialog_name;
2106 wv->help = Qnil;
2107
2108 /* Frame title: 'Q' = Question, 'I' = Information.
2109 Can also have 'E' = Error if, one day, we want
2110 a popup for errors. */
2111 if (NILP(header))
2112 dialog_name[0] = 'Q';
2113 else
2114 dialog_name[0] = 'I';
2115
2116 /* Dialog boxes use a really stupid name encoding
2117 which specifies how many buttons to use
2118 and how many buttons are on the right. */
2119 dialog_name[1] = '0' + nb_buttons;
2120 dialog_name[2] = 'B';
2121 dialog_name[3] = 'R';
2122 /* Number of buttons to put on the right. */
2123 dialog_name[4] = '0' + nb_buttons - left_count;
2124 dialog_name[5] = 0;
2125 wv->contents = first_wv;
2126 first_wv = wv;
2127 }
2128
2129 /* Actually create the dialog. */
2130 dialog_id = widget_id_tick++;
2131 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2132 f->output_data.w32->widget, 1, 0,
2133 dialog_selection_callback, 0);
2134 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2135
2136 /* Free the widget_value objects we used to specify the contents. */
2137 free_menubar_widget_value_tree (first_wv);
2138
2139 /* No selection has been chosen yet. */
2140 menu_item_selection = 0;
2141
2142 /* Display the menu. */
2143 lw_pop_up_all_widgets (dialog_id);
2144 popup_activated_flag = 1;
2145
2146 /* Process events that apply to the menu. */
2147 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2148
2149 lw_destroy_all_widgets (dialog_id);
2150
2151 /* Find the selected item, and its pane, to return
2152 the proper value. */
2153 if (menu_item_selection != 0)
2154 {
2155 Lisp_Object prefix;
2156
2157 prefix = Qnil;
2158 i = 0;
2159 while (i < menu_items_used)
2160 {
2161 Lisp_Object entry;
2162
2163 if (EQ (AREF (menu_items, i), Qt))
2164 {
2165 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2166 i += MENU_ITEMS_PANE_LENGTH;
2167 }
2168 else
2169 {
2170 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2171 if (menu_item_selection == i)
2172 {
2173 if (keymaps != 0)
2174 {
2175 entry = Fcons (entry, Qnil);
2176 if (!NILP (prefix))
2177 entry = Fcons (prefix, entry);
2178 }
2179 return entry;
2180 }
2181 i += MENU_ITEMS_ITEM_LENGTH;
2182 }
2183 }
2184 }
2185
2186 return Qnil;
2187 }
2188 #endif /* HAVE_DIALOGS */
2189 \f
2190
2191 /* Is this item a separator? */
2192 static int
2193 name_is_separator (name)
2194 char *name;
2195 {
2196 char *start = name;
2197
2198 /* Check if name string consists of only dashes ('-'). */
2199 while (*name == '-') name++;
2200 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2201 or "--deep-shadow". We don't implement them yet, se we just treat
2202 them like normal separators. */
2203 return (*name == '\0' || start + 2 == name);
2204 }
2205
2206
2207 /* Indicate boundary between left and right. */
2208 static int
2209 add_left_right_boundary (HMENU menu)
2210 {
2211 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2212 }
2213
2214 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2215 static void
2216 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2217 {
2218 while (len > 0)
2219 {
2220 int utf16;
2221 if (*src < 0x80)
2222 {
2223 *dest = (WCHAR) *src;
2224 dest++; src++; len--;
2225 }
2226 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2227 else if (*src < 0xC0)
2228 {
2229 src++; len--;
2230 }
2231 /* 2 char UTF-8 sequence. */
2232 else if (*src < 0xE0)
2233 {
2234 *dest = (WCHAR) (((*src & 0x1f) << 6)
2235 | (*(src + 1) & 0x3f));
2236 src += 2; len -= 2; dest++;
2237 }
2238 else if (*src < 0xF0)
2239 {
2240 *dest = (WCHAR) (((*src & 0x0f) << 12)
2241 | ((*(src + 1) & 0x3f) << 6)
2242 | (*(src + 2) & 0x3f));
2243 src += 3; len -= 3; dest++;
2244 }
2245 else /* Not encodable. Insert Unicode Substitution char. */
2246 {
2247 *dest = (WCHAR) 0xfffd;
2248 src++; len--; dest++;
2249 }
2250 }
2251 *dest = 0;
2252 }
2253
2254 static int
2255 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2256 {
2257 UINT fuFlags;
2258 char *out_string;
2259 int return_value;
2260
2261 if (name_is_separator (wv->name))
2262 {
2263 fuFlags = MF_SEPARATOR;
2264 out_string = NULL;
2265 }
2266 else
2267 {
2268 if (wv->enabled)
2269 fuFlags = MF_STRING;
2270 else
2271 fuFlags = MF_STRING | MF_GRAYED;
2272
2273 if (wv->key != NULL)
2274 {
2275 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2276 strcpy (out_string, wv->name);
2277 strcat (out_string, "\t");
2278 strcat (out_string, wv->key);
2279 }
2280 else
2281 out_string = wv->name;
2282
2283 if (item != NULL)
2284 fuFlags = MF_POPUP;
2285 else if (wv->title || wv->call_data == 0)
2286 {
2287 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2288 we can't deallocate the memory otherwise. */
2289 if (get_menu_item_info)
2290 {
2291 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2292 strcpy (out_string, wv->name);
2293 #ifdef MENU_DEBUG
2294 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2295 #endif
2296 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2297 }
2298 else
2299 fuFlags = MF_DISABLED;
2300 }
2301
2302 /* Draw radio buttons and tickboxes. */
2303 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2304 wv->button_type == BUTTON_TYPE_RADIO))
2305 fuFlags |= MF_CHECKED;
2306 else
2307 fuFlags |= MF_UNCHECKED;
2308 }
2309
2310 if (unicode_append_menu && out_string)
2311 {
2312 /* Convert out_string from UTF-8 to UTF-16-LE. */
2313 int utf8_len = strlen (out_string);
2314 WCHAR * utf16_string;
2315 if (fuFlags & MF_OWNERDRAW)
2316 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2317 else
2318 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2319
2320 utf8to16 (out_string, utf8_len, utf16_string);
2321 return_value = unicode_append_menu (menu, fuFlags,
2322 item != NULL ? (UINT) item
2323 : (UINT) wv->call_data,
2324 utf16_string);
2325 if (!return_value)
2326 {
2327 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2328 apparently does exist at least in some cases and appears to be
2329 stubbed out to do nothing. out_string is UTF-8, but since
2330 our standard menus are in English and this is only going to
2331 happen the first time a menu is used, the encoding is
2332 of minor importance compared with menus not working at all. */
2333 return_value =
2334 AppendMenu (menu, fuFlags,
2335 item != NULL ? (UINT) item: (UINT) wv->call_data,
2336 out_string);
2337 /* Don't use unicode menus in future. */
2338 unicode_append_menu = NULL;
2339 }
2340
2341 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2342 local_free (out_string);
2343 }
2344 else
2345 {
2346 return_value =
2347 AppendMenu (menu,
2348 fuFlags,
2349 item != NULL ? (UINT) item : (UINT) wv->call_data,
2350 out_string );
2351 }
2352
2353 /* This must be done after the menu item is created. */
2354 if (!wv->title && wv->call_data != 0)
2355 {
2356 if (set_menu_item_info)
2357 {
2358 MENUITEMINFO info;
2359 bzero (&info, sizeof (info));
2360 info.cbSize = sizeof (info);
2361 info.fMask = MIIM_DATA;
2362
2363 /* Set help string for menu item. Leave it as a Lisp_Object
2364 until it is ready to be displayed, since GC can happen while
2365 menus are active. */
2366 if (!NILP (wv->help))
2367 #ifdef USE_LISP_UNION_TYPE
2368 info.dwItemData = (DWORD) (wv->help).i;
2369 #else
2370 info.dwItemData = (DWORD) (wv->help);
2371 #endif
2372 if (wv->button_type == BUTTON_TYPE_RADIO)
2373 {
2374 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2375 RADIO items, but is not available on NT 3.51 and earlier. */
2376 info.fMask |= MIIM_TYPE | MIIM_STATE;
2377 info.fType = MFT_RADIOCHECK | MFT_STRING;
2378 info.dwTypeData = out_string;
2379 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2380 }
2381
2382 set_menu_item_info (menu,
2383 item != NULL ? (UINT) item : (UINT) wv->call_data,
2384 FALSE, &info);
2385 }
2386 }
2387 return return_value;
2388 }
2389
2390 /* Construct native Windows menu(bar) based on widget_value tree. */
2391 int
2392 fill_in_menu (HMENU menu, widget_value *wv)
2393 {
2394 int items_added = 0;
2395
2396 for ( ; wv != NULL; wv = wv->next)
2397 {
2398 if (wv->contents)
2399 {
2400 HMENU sub_menu = CreatePopupMenu ();
2401
2402 if (sub_menu == NULL)
2403 return 0;
2404
2405 if (!fill_in_menu (sub_menu, wv->contents) ||
2406 !add_menu_item (menu, wv, sub_menu))
2407 {
2408 DestroyMenu (sub_menu);
2409 return 0;
2410 }
2411 }
2412 else
2413 {
2414 if (!add_menu_item (menu, wv, NULL))
2415 return 0;
2416 }
2417 }
2418 return 1;
2419 }
2420
2421 int
2422 popup_activated ()
2423 {
2424 /* popup_activated_flag not actually used on W32 */
2425 return 0;
2426 }
2427
2428 /* Display help string for currently pointed to menu item. Not
2429 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2430 available. */
2431 void
2432 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2433 {
2434 if (get_menu_item_info)
2435 {
2436 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2437 Lisp_Object frame, help;
2438
2439 /* No help echo on owner-draw menu items, or when the keyboard is used
2440 to navigate the menus, since tooltips are distracting if they pop
2441 up elsewhere. */
2442 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2443 || !(flags & MF_MOUSESELECT))
2444 help = Qnil;
2445 else
2446 {
2447 MENUITEMINFO info;
2448
2449 bzero (&info, sizeof (info));
2450 info.cbSize = sizeof (info);
2451 info.fMask = MIIM_DATA;
2452 get_menu_item_info (menu, item, FALSE, &info);
2453
2454 #ifdef USE_LISP_UNION_TYPE
2455 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2456 : Qnil;
2457 #else
2458 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2459 #endif
2460 }
2461
2462 /* Store the help echo in the keyboard buffer as the X toolkit
2463 version does, rather than directly showing it. This seems to
2464 solve the GC problems that were present when we based the
2465 Windows code on the non-toolkit version. */
2466 if (f)
2467 {
2468 XSETFRAME (frame, f);
2469 kbd_buffer_store_help_event (frame, help);
2470 }
2471 else
2472 /* X version has a loop through frames here, which doesn't
2473 appear to do anything, unless it has some side effect. */
2474 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2475 }
2476 }
2477
2478 /* Free memory used by owner-drawn strings. */
2479 static void
2480 w32_free_submenu_strings (menu)
2481 HMENU menu;
2482 {
2483 int i, num = GetMenuItemCount (menu);
2484 for (i = 0; i < num; i++)
2485 {
2486 MENUITEMINFO info;
2487 bzero (&info, sizeof (info));
2488 info.cbSize = sizeof (info);
2489 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2490
2491 get_menu_item_info (menu, i, TRUE, &info);
2492
2493 /* Owner-drawn names are held in dwItemData. */
2494 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2495 {
2496 #ifdef MENU_DEBUG
2497 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2498 #endif
2499 local_free (info.dwItemData);
2500 }
2501
2502 /* Recurse down submenus. */
2503 if (info.hSubMenu)
2504 w32_free_submenu_strings (info.hSubMenu);
2505 }
2506 }
2507
2508 void
2509 w32_free_menu_strings (hwnd)
2510 HWND hwnd;
2511 {
2512 HMENU menu = current_popup_menu;
2513
2514 if (get_menu_item_info)
2515 {
2516 /* If there is no popup menu active, free the strings from the frame's
2517 menubar. */
2518 if (!menu)
2519 menu = GetMenu (hwnd);
2520
2521 if (menu)
2522 w32_free_submenu_strings (menu);
2523 }
2524
2525 current_popup_menu = NULL;
2526 }
2527
2528 #endif /* HAVE_MENUS */
2529
2530 void syms_of_w32menu ()
2531 {
2532 globals_of_w32menu ();
2533 staticpro (&menu_items);
2534 menu_items = Qnil;
2535
2536 current_popup_menu = NULL;
2537
2538 Qdebug_on_next_call = intern ("debug-on-next-call");
2539 staticpro (&Qdebug_on_next_call);
2540
2541 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2542 doc: /* Frame for which we are updating a menu.
2543 The enable predicate for a menu command should check this variable. */);
2544 Vmenu_updating_frame = Qnil;
2545
2546 defsubr (&Sx_popup_menu);
2547 #ifdef HAVE_MENUS
2548 defsubr (&Sx_popup_dialog);
2549 #endif
2550 }
2551
2552 /*
2553 globals_of_w32menu is used to initialize those global variables that
2554 must always be initialized on startup even when the global variable
2555 initialized is non zero (see the function main in emacs.c).
2556 globals_of_w32menu is called from syms_of_w32menu when the global
2557 variable initialized is 0 and directly from main when initialized
2558 is non zero.
2559 */
2560 void globals_of_w32menu ()
2561 {
2562 /* See if Get/SetMenuItemInfo functions are available. */
2563 HMODULE user32 = GetModuleHandle ("user32.dll");
2564 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2565 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2566 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2567 }
2568
2569 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2570 (do not change this comment) */