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