Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-91
[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 Vmenu_updating_frame = Qnil;
742 #endif /* HAVE_MENUS */
743
744 title = Qnil;
745 GCPRO1 (title);
746
747 /* Decode the menu items from what was specified. */
748
749 keymap = get_keymap (menu, 0, 0);
750 if (CONSP (keymap))
751 {
752 /* We were given a keymap. Extract menu info from the keymap. */
753 Lisp_Object prompt;
754
755 /* Extract the detailed info to make one pane. */
756 keymap_panes (&menu, 1, NILP (position));
757
758 /* Search for a string appearing directly as an element of the keymap.
759 That string is the title of the menu. */
760 prompt = Fkeymap_prompt (keymap);
761 if (NILP (title) && !NILP (prompt))
762 title = prompt;
763
764 /* Make that be the pane title of the first pane. */
765 if (!NILP (prompt) && menu_items_n_panes >= 0)
766 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
767
768 keymaps = 1;
769 }
770 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
771 {
772 /* We were given a list of keymaps. */
773 int nmaps = XFASTINT (Flength (menu));
774 Lisp_Object *maps
775 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
776 int i;
777
778 title = Qnil;
779
780 /* The first keymap that has a prompt string
781 supplies the menu title. */
782 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
783 {
784 Lisp_Object prompt;
785
786 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
787
788 prompt = Fkeymap_prompt (keymap);
789 if (NILP (title) && !NILP (prompt))
790 title = prompt;
791 }
792
793 /* Extract the detailed info to make one pane. */
794 keymap_panes (maps, nmaps, NILP (position));
795
796 /* Make the title be the pane title of the first pane. */
797 if (!NILP (title) && menu_items_n_panes >= 0)
798 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
799
800 keymaps = 1;
801 }
802 else
803 {
804 /* We were given an old-fashioned menu. */
805 title = Fcar (menu);
806 CHECK_STRING (title);
807
808 list_of_panes (Fcdr (menu));
809
810 keymaps = 0;
811 }
812
813 if (NILP (position))
814 {
815 discard_menu_items ();
816 UNGCPRO;
817 return Qnil;
818 }
819
820 #ifdef HAVE_MENUS
821 /* If resources from a previous popup menu exist yet, does nothing
822 until the `menu_free_timer' has freed them (see w32fns.c).
823 */
824 if (current_popup_menu)
825 {
826 discard_menu_items ();
827 UNGCPRO;
828 return Qnil;
829 }
830
831 /* Display them in a menu. */
832 BLOCK_INPUT;
833
834 selection = w32_menu_show (f, xpos, ypos, for_click,
835 keymaps, title, &error_name);
836 UNBLOCK_INPUT;
837
838 discard_menu_items ();
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 kbd_buffer_store_event (&buf);
1070
1071 /* Free memory used by owner-drawn and help-echo strings. */
1072 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1073 f->output_data.w32->menu_command_in_progress = 0;
1074 f->output_data.w32->menubar_active = 0;
1075 return;
1076 }
1077 i += MENU_ITEMS_ITEM_LENGTH;
1078 }
1079 }
1080 /* Free memory used by owner-drawn and help-echo strings. */
1081 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1082 f->output_data.w32->menu_command_in_progress = 0;
1083 f->output_data.w32->menubar_active = 0;
1084 }
1085
1086 /* Allocate a widget_value, blocking input. */
1087
1088 widget_value *
1089 xmalloc_widget_value ()
1090 {
1091 widget_value *value;
1092
1093 BLOCK_INPUT;
1094 value = malloc_widget_value ();
1095 UNBLOCK_INPUT;
1096
1097 return value;
1098 }
1099
1100 /* This recursively calls free_widget_value on the tree of widgets.
1101 It must free all data that was malloc'ed for these widget_values.
1102 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1103 must be left alone. */
1104
1105 void
1106 free_menubar_widget_value_tree (wv)
1107 widget_value *wv;
1108 {
1109 if (! wv) return;
1110
1111 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1112
1113 if (wv->contents && (wv->contents != (widget_value*)1))
1114 {
1115 free_menubar_widget_value_tree (wv->contents);
1116 wv->contents = (widget_value *) 0xDEADBEEF;
1117 }
1118 if (wv->next)
1119 {
1120 free_menubar_widget_value_tree (wv->next);
1121 wv->next = (widget_value *) 0xDEADBEEF;
1122 }
1123 BLOCK_INPUT;
1124 free_widget_value (wv);
1125 UNBLOCK_INPUT;
1126 }
1127 \f
1128 /* Set up data i menu_items for a menu bar item
1129 whose event type is ITEM_KEY (with string ITEM_NAME)
1130 and whose contents come from the list of keymaps MAPS. */
1131
1132 static int
1133 parse_single_submenu (item_key, item_name, maps)
1134 Lisp_Object item_key, item_name, maps;
1135 {
1136 Lisp_Object length;
1137 int len;
1138 Lisp_Object *mapvec;
1139 int i;
1140 int top_level_items = 0;
1141
1142 length = Flength (maps);
1143 len = XINT (length);
1144
1145 /* Convert the list MAPS into a vector MAPVEC. */
1146 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1147 for (i = 0; i < len; i++)
1148 {
1149 mapvec[i] = Fcar (maps);
1150 maps = Fcdr (maps);
1151 }
1152
1153 /* Loop over the given keymaps, making a pane for each map.
1154 But don't make a pane that is empty--ignore that map instead. */
1155 for (i = 0; i < len; i++)
1156 {
1157 if (SYMBOLP (mapvec[i])
1158 || (CONSP (mapvec[i]) && !KEYMAPP (mapvec[i])))
1159 {
1160 /* Here we have a command at top level in the menu bar
1161 as opposed to a submenu. */
1162 top_level_items = 1;
1163 push_menu_pane (Qnil, Qnil);
1164 push_menu_item (item_name, Qt, item_key, mapvec[i],
1165 Qnil, Qnil, Qnil, Qnil);
1166 }
1167 else
1168 {
1169 Lisp_Object prompt;
1170 prompt = Fkeymap_prompt (mapvec[i]);
1171 single_keymap_panes (mapvec[i],
1172 !NILP (prompt) ? prompt : item_name,
1173 item_key, 0, 10);
1174 }
1175 }
1176
1177 return top_level_items;
1178 }
1179
1180
1181 /* Create a tree of widget_value objects
1182 representing the panes and items
1183 in menu_items starting at index START, up to index END. */
1184
1185 static widget_value *
1186 digest_single_submenu (start, end, top_level_items)
1187 int start, end, top_level_items;
1188 {
1189 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1190 int i;
1191 int submenu_depth = 0;
1192 widget_value **submenu_stack;
1193
1194 submenu_stack
1195 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1196 wv = xmalloc_widget_value ();
1197 wv->name = "menu";
1198 wv->value = 0;
1199 wv->enabled = 1;
1200 wv->button_type = BUTTON_TYPE_NONE;
1201 wv->help = Qnil;
1202 first_wv = wv;
1203 save_wv = 0;
1204 prev_wv = 0;
1205
1206 /* Loop over all panes and items made by the preceding call
1207 to parse_single_submenu and construct a tree of widget_value objects.
1208 Ignore the panes and items used by previous calls to
1209 digest_single_submenu, even though those are also in menu_items. */
1210 i = start;
1211 while (i < end)
1212 {
1213 if (EQ (AREF (menu_items, i), Qnil))
1214 {
1215 submenu_stack[submenu_depth++] = save_wv;
1216 save_wv = prev_wv;
1217 prev_wv = 0;
1218 i++;
1219 }
1220 else if (EQ (AREF (menu_items, i), Qlambda))
1221 {
1222 prev_wv = save_wv;
1223 save_wv = submenu_stack[--submenu_depth];
1224 i++;
1225 }
1226 else if (EQ (AREF (menu_items, i), Qt)
1227 && submenu_depth != 0)
1228 i += MENU_ITEMS_PANE_LENGTH;
1229 /* Ignore a nil in the item list.
1230 It's meaningful only for dialog boxes. */
1231 else if (EQ (AREF (menu_items, i), Qquote))
1232 i += 1;
1233 else if (EQ (AREF (menu_items, i), Qt))
1234 {
1235 /* Create a new pane. */
1236 Lisp_Object pane_name, prefix;
1237 char *pane_string;
1238
1239 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1240 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1241
1242 if (STRINGP (pane_name))
1243 {
1244 if (unicode_append_menu)
1245 /* Encode as UTF-8 for now. */
1246 pane_name = ENCODE_UTF_8 (pane_name);
1247 else if (STRING_MULTIBYTE (pane_name))
1248 pane_name = ENCODE_SYSTEM (pane_name);
1249
1250 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1251 }
1252
1253 pane_string = (NILP (pane_name)
1254 ? "" : (char *) SDATA (pane_name));
1255 /* If there is just one top-level pane, put all its items directly
1256 under the top-level menu. */
1257 if (menu_items_n_panes == 1)
1258 pane_string = "";
1259
1260 /* If the pane has a meaningful name,
1261 make the pane a top-level menu item
1262 with its items as a submenu beneath it. */
1263 if (strcmp (pane_string, ""))
1264 {
1265 wv = xmalloc_widget_value ();
1266 if (save_wv)
1267 save_wv->next = wv;
1268 else
1269 first_wv->contents = wv;
1270 wv->lname = pane_name;
1271 /* Set value to 1 so update_submenu_strings can handle '@' */
1272 wv->value = (char *) 1;
1273 wv->enabled = 1;
1274 wv->button_type = BUTTON_TYPE_NONE;
1275 wv->help = Qnil;
1276 }
1277 save_wv = wv;
1278 prev_wv = 0;
1279 i += MENU_ITEMS_PANE_LENGTH;
1280 }
1281 else
1282 {
1283 /* Create a new item within current pane. */
1284 Lisp_Object item_name, enable, descrip, def, type, selected;
1285 Lisp_Object help;
1286
1287 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1288 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1289 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1290 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1291 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1292 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1293 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1294
1295 if (STRINGP (item_name))
1296 {
1297 if (unicode_append_menu)
1298 item_name = ENCODE_UTF_8 (item_name);
1299 else if (STRING_MULTIBYTE (item_name))
1300 item_name = ENCODE_SYSTEM (item_name);
1301
1302 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1303 }
1304
1305 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1306 {
1307 descrip = ENCODE_SYSTEM (descrip);
1308 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1309 }
1310
1311 wv = xmalloc_widget_value ();
1312 if (prev_wv)
1313 prev_wv->next = wv;
1314 else
1315 save_wv->contents = wv;
1316
1317 wv->lname = item_name;
1318 if (!NILP (descrip))
1319 wv->lkey = descrip;
1320 wv->value = 0;
1321 /* The EMACS_INT cast avoids a warning. There's no problem
1322 as long as pointers have enough bits to hold small integers. */
1323 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1324 wv->enabled = !NILP (enable);
1325
1326 if (NILP (type))
1327 wv->button_type = BUTTON_TYPE_NONE;
1328 else if (EQ (type, QCradio))
1329 wv->button_type = BUTTON_TYPE_RADIO;
1330 else if (EQ (type, QCtoggle))
1331 wv->button_type = BUTTON_TYPE_TOGGLE;
1332 else
1333 abort ();
1334
1335 wv->selected = !NILP (selected);
1336 if (!STRINGP (help))
1337 help = Qnil;
1338
1339 wv->help = help;
1340
1341 prev_wv = wv;
1342
1343 i += MENU_ITEMS_ITEM_LENGTH;
1344 }
1345 }
1346
1347 /* If we have just one "menu item"
1348 that was originally a button, return it by itself. */
1349 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1350 {
1351 wv = first_wv->contents;
1352 free_widget_value (first_wv);
1353 return wv;
1354 }
1355
1356 return first_wv;
1357 }
1358
1359
1360 /* Walk through the widget_value tree starting at FIRST_WV and update
1361 the char * pointers from the corresponding lisp values.
1362 We do this after building the whole tree, since GC may happen while the
1363 tree is constructed, and small strings are relocated. So we must wait
1364 until no GC can happen before storing pointers into lisp values. */
1365 static void
1366 update_submenu_strings (first_wv)
1367 widget_value *first_wv;
1368 {
1369 widget_value *wv;
1370
1371 for (wv = first_wv; wv; wv = wv->next)
1372 {
1373 if (wv->lname && ! NILP (wv->lname))
1374 {
1375 wv->name = SDATA (wv->lname);
1376
1377 /* Ignore the @ that means "separate pane".
1378 This is a kludge, but this isn't worth more time. */
1379 if (wv->value == (char *)1)
1380 {
1381 if (wv->name[0] == '@')
1382 wv->name++;
1383 wv->value = 0;
1384 }
1385 }
1386
1387 if (wv->lkey && ! NILP (wv->lkey))
1388 wv->key = SDATA (wv->lkey);
1389
1390 if (wv->contents)
1391 update_submenu_strings (wv->contents);
1392 }
1393 }
1394
1395 \f
1396 /* Set the contents of the menubar widgets of frame F.
1397 The argument FIRST_TIME is currently ignored;
1398 it is set the first time this is called, from initialize_frame_menubar. */
1399
1400 void
1401 set_frame_menubar (f, first_time, deep_p)
1402 FRAME_PTR f;
1403 int first_time;
1404 int deep_p;
1405 {
1406 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1407 Lisp_Object items;
1408 widget_value *wv, *first_wv, *prev_wv = 0;
1409 int i, last_i;
1410 int *submenu_start, *submenu_end;
1411 int *submenu_top_level_items, *submenu_n_panes;
1412
1413 /* We must not change the menubar when actually in use. */
1414 if (f->output_data.w32->menubar_active)
1415 return;
1416
1417 XSETFRAME (Vmenu_updating_frame, f);
1418
1419 if (! menubar_widget)
1420 deep_p = 1;
1421 else if (pending_menu_activation && !deep_p)
1422 deep_p = 1;
1423
1424 if (deep_p)
1425 {
1426 /* Make a widget-value tree representing the entire menu trees. */
1427
1428 struct buffer *prev = current_buffer;
1429 Lisp_Object buffer;
1430 int specpdl_count = SPECPDL_INDEX ();
1431 int previous_menu_items_used = f->menu_bar_items_used;
1432 Lisp_Object *previous_items
1433 = (Lisp_Object *) alloca (previous_menu_items_used
1434 * sizeof (Lisp_Object));
1435
1436 /* If we are making a new widget, its contents are empty,
1437 do always reinitialize them. */
1438 if (! menubar_widget)
1439 previous_menu_items_used = 0;
1440
1441 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1442 specbind (Qinhibit_quit, Qt);
1443 /* Don't let the debugger step into this code
1444 because it is not reentrant. */
1445 specbind (Qdebug_on_next_call, Qnil);
1446
1447 record_unwind_save_match_data ();
1448
1449 if (NILP (Voverriding_local_map_menu_flag))
1450 {
1451 specbind (Qoverriding_terminal_local_map, Qnil);
1452 specbind (Qoverriding_local_map, Qnil);
1453 }
1454
1455 set_buffer_internal_1 (XBUFFER (buffer));
1456
1457 /* Run the Lucid hook. */
1458 safe_run_hooks (Qactivate_menubar_hook);
1459 /* If it has changed current-menubar from previous value,
1460 really recompute the menubar from the value. */
1461 if (! NILP (Vlucid_menu_bar_dirty_flag))
1462 call0 (Qrecompute_lucid_menubar);
1463 safe_run_hooks (Qmenu_bar_update_hook);
1464 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1465
1466 items = FRAME_MENU_BAR_ITEMS (f);
1467
1468 /* Save the frame's previous menu bar contents data. */
1469 if (previous_menu_items_used)
1470 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1471 previous_menu_items_used * sizeof (Lisp_Object));
1472
1473 /* Fill in menu_items with the current menu bar contents.
1474 This can evaluate Lisp code. */
1475 menu_items = f->menu_bar_vector;
1476 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1477 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1478 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1479 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1480 submenu_top_level_items
1481 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1482 init_menu_items ();
1483 for (i = 0; i < ASIZE (items); i += 4)
1484 {
1485 Lisp_Object key, string, maps;
1486
1487 last_i = i;
1488
1489 key = AREF (items, i);
1490 string = AREF (items, i + 1);
1491 maps = AREF (items, i + 2);
1492 if (NILP (string))
1493 break;
1494
1495 submenu_start[i] = menu_items_used;
1496
1497 menu_items_n_panes = 0;
1498 submenu_top_level_items[i]
1499 = parse_single_submenu (key, string, maps);
1500 submenu_n_panes[i] = menu_items_n_panes;
1501
1502 submenu_end[i] = menu_items_used;
1503 }
1504
1505 finish_menu_items ();
1506
1507 /* Convert menu_items into widget_value trees
1508 to display the menu. This cannot evaluate Lisp code. */
1509
1510 wv = xmalloc_widget_value ();
1511 wv->name = "menubar";
1512 wv->value = 0;
1513 wv->enabled = 1;
1514 wv->button_type = BUTTON_TYPE_NONE;
1515 wv->help = Qnil;
1516 first_wv = wv;
1517
1518 for (i = 0; i < last_i; i += 4)
1519 {
1520 menu_items_n_panes = submenu_n_panes[i];
1521 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1522 submenu_top_level_items[i]);
1523 if (prev_wv)
1524 prev_wv->next = wv;
1525 else
1526 first_wv->contents = wv;
1527 /* Don't set wv->name here; GC during the loop might relocate it. */
1528 wv->enabled = 1;
1529 wv->button_type = BUTTON_TYPE_NONE;
1530 prev_wv = wv;
1531 }
1532
1533 set_buffer_internal_1 (prev);
1534 unbind_to (specpdl_count, Qnil);
1535
1536 /* If there has been no change in the Lisp-level contents
1537 of the menu bar, skip redisplaying it. Just exit. */
1538
1539 for (i = 0; i < previous_menu_items_used; i++)
1540 if (menu_items_used == i
1541 || (!EQ (previous_items[i], AREF (menu_items, i))))
1542 break;
1543 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1544 {
1545 free_menubar_widget_value_tree (first_wv);
1546 menu_items = Qnil;
1547
1548 return;
1549 }
1550
1551 /* Now GC cannot happen during the lifetime of the widget_value,
1552 so it's safe to store data from a Lisp_String, as long as
1553 local copies are made when the actual menu is created.
1554 Windows takes care of this for normal string items, but
1555 not for owner-drawn items or additional item-info. */
1556 wv = first_wv->contents;
1557 for (i = 0; i < ASIZE (items); i += 4)
1558 {
1559 Lisp_Object string;
1560 string = AREF (items, i + 1);
1561 if (NILP (string))
1562 break;
1563 wv->name = (char *) SDATA (string);
1564 update_submenu_strings (wv->contents);
1565 wv = wv->next;
1566 }
1567
1568 f->menu_bar_vector = menu_items;
1569 f->menu_bar_items_used = menu_items_used;
1570 menu_items = Qnil;
1571 }
1572 else
1573 {
1574 /* Make a widget-value tree containing
1575 just the top level menu bar strings. */
1576
1577 wv = xmalloc_widget_value ();
1578 wv->name = "menubar";
1579 wv->value = 0;
1580 wv->enabled = 1;
1581 wv->button_type = BUTTON_TYPE_NONE;
1582 wv->help = Qnil;
1583 first_wv = wv;
1584
1585 items = FRAME_MENU_BAR_ITEMS (f);
1586 for (i = 0; i < ASIZE (items); i += 4)
1587 {
1588 Lisp_Object string;
1589
1590 string = AREF (items, i + 1);
1591 if (NILP (string))
1592 break;
1593
1594 wv = xmalloc_widget_value ();
1595 wv->name = (char *) SDATA (string);
1596 wv->value = 0;
1597 wv->enabled = 1;
1598 wv->button_type = BUTTON_TYPE_NONE;
1599 wv->help = Qnil;
1600 /* This prevents lwlib from assuming this
1601 menu item is really supposed to be empty. */
1602 /* The EMACS_INT cast avoids a warning.
1603 This value just has to be different from small integers. */
1604 wv->call_data = (void *) (EMACS_INT) (-1);
1605
1606 if (prev_wv)
1607 prev_wv->next = wv;
1608 else
1609 first_wv->contents = wv;
1610 prev_wv = wv;
1611 }
1612
1613 /* Forget what we thought we knew about what is in the
1614 detailed contents of the menu bar menus.
1615 Changing the top level always destroys the contents. */
1616 f->menu_bar_items_used = 0;
1617 }
1618
1619 /* Create or update the menu bar widget. */
1620
1621 BLOCK_INPUT;
1622
1623 if (menubar_widget)
1624 {
1625 /* Empty current menubar, rather than creating a fresh one. */
1626 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1627 ;
1628 }
1629 else
1630 {
1631 menubar_widget = CreateMenu ();
1632 }
1633 fill_in_menu (menubar_widget, first_wv->contents);
1634
1635 free_menubar_widget_value_tree (first_wv);
1636
1637 {
1638 HMENU old_widget = f->output_data.w32->menubar_widget;
1639
1640 f->output_data.w32->menubar_widget = menubar_widget;
1641 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1642 /* Causes flicker when menu bar is updated
1643 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1644
1645 /* Force the window size to be recomputed so that the frame's text
1646 area remains the same, if menubar has just been created. */
1647 if (old_widget == NULL)
1648 x_set_window_size (f, 0, FRAME_COLS (f), FRAME_LINES (f));
1649 }
1650
1651 UNBLOCK_INPUT;
1652 }
1653
1654 /* Called from Fx_create_frame to create the initial menubar of a frame
1655 before it is mapped, so that the window is mapped with the menubar already
1656 there instead of us tacking it on later and thrashing the window after it
1657 is visible. */
1658
1659 void
1660 initialize_frame_menubar (f)
1661 FRAME_PTR f;
1662 {
1663 /* This function is called before the first chance to redisplay
1664 the frame. It has to be, so the frame will have the right size. */
1665 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1666 set_frame_menubar (f, 1, 1);
1667 }
1668
1669 /* Get rid of the menu bar of frame F, and free its storage.
1670 This is used when deleting a frame, and when turning off the menu bar. */
1671
1672 void
1673 free_frame_menubar (f)
1674 FRAME_PTR f;
1675 {
1676 BLOCK_INPUT;
1677
1678 {
1679 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1680 SetMenu (FRAME_W32_WINDOW (f), NULL);
1681 f->output_data.w32->menubar_widget = NULL;
1682 DestroyMenu (old);
1683 }
1684
1685 UNBLOCK_INPUT;
1686 }
1687
1688 \f
1689 /* w32_menu_show actually displays a menu using the panes and items in
1690 menu_items and returns the value selected from it; we assume input
1691 is blocked by the caller. */
1692
1693 /* F is the frame the menu is for.
1694 X and Y are the frame-relative specified position,
1695 relative to the inside upper left corner of the frame F.
1696 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1697 KEYMAPS is 1 if this menu was specified with keymaps;
1698 in that case, we return a list containing the chosen item's value
1699 and perhaps also the pane's prefix.
1700 TITLE is the specified menu title.
1701 ERROR is a place to store an error message string in case of failure.
1702 (We return nil on failure, but the value doesn't actually matter.) */
1703
1704 static Lisp_Object
1705 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1706 FRAME_PTR f;
1707 int x;
1708 int y;
1709 int for_click;
1710 int keymaps;
1711 Lisp_Object title;
1712 char **error;
1713 {
1714 int i;
1715 int menu_item_selection;
1716 HMENU menu;
1717 POINT pos;
1718 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1719 widget_value **submenu_stack
1720 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1721 Lisp_Object *subprefix_stack
1722 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1723 int submenu_depth = 0;
1724 int first_pane;
1725
1726 *error = NULL;
1727
1728 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1729 {
1730 *error = "Empty menu";
1731 return Qnil;
1732 }
1733
1734 /* Create a tree of widget_value objects
1735 representing the panes and their items. */
1736 wv = xmalloc_widget_value ();
1737 wv->name = "menu";
1738 wv->value = 0;
1739 wv->enabled = 1;
1740 wv->button_type = BUTTON_TYPE_NONE;
1741 wv->help = Qnil;
1742 first_wv = wv;
1743 first_pane = 1;
1744
1745 /* Loop over all panes and items, filling in the tree. */
1746 i = 0;
1747 while (i < menu_items_used)
1748 {
1749 if (EQ (AREF (menu_items, i), Qnil))
1750 {
1751 submenu_stack[submenu_depth++] = save_wv;
1752 save_wv = prev_wv;
1753 prev_wv = 0;
1754 first_pane = 1;
1755 i++;
1756 }
1757 else if (EQ (AREF (menu_items, i), Qlambda))
1758 {
1759 prev_wv = save_wv;
1760 save_wv = submenu_stack[--submenu_depth];
1761 first_pane = 0;
1762 i++;
1763 }
1764 else if (EQ (AREF (menu_items, i), Qt)
1765 && submenu_depth != 0)
1766 i += MENU_ITEMS_PANE_LENGTH;
1767 /* Ignore a nil in the item list.
1768 It's meaningful only for dialog boxes. */
1769 else if (EQ (AREF (menu_items, i), Qquote))
1770 i += 1;
1771 else if (EQ (AREF (menu_items, i), Qt))
1772 {
1773 /* Create a new pane. */
1774 Lisp_Object pane_name, prefix;
1775 char *pane_string;
1776 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1777 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1778
1779 if (STRINGP (pane_name))
1780 {
1781 if (unicode_append_menu)
1782 pane_name = ENCODE_UTF_8 (pane_name);
1783 else if (STRING_MULTIBYTE (pane_name))
1784 pane_name = ENCODE_SYSTEM (pane_name);
1785
1786 ASET (menu_items, i + MENU_ITEMS_PANE_NAME, pane_name);
1787 }
1788
1789 pane_string = (NILP (pane_name)
1790 ? "" : (char *) SDATA (pane_name));
1791 /* If there is just one top-level pane, put all its items directly
1792 under the top-level menu. */
1793 if (menu_items_n_panes == 1)
1794 pane_string = "";
1795
1796 /* If the pane has a meaningful name,
1797 make the pane a top-level menu item
1798 with its items as a submenu beneath it. */
1799 if (!keymaps && strcmp (pane_string, ""))
1800 {
1801 wv = xmalloc_widget_value ();
1802 if (save_wv)
1803 save_wv->next = wv;
1804 else
1805 first_wv->contents = wv;
1806 wv->name = pane_string;
1807 if (keymaps && !NILP (prefix))
1808 wv->name++;
1809 wv->value = 0;
1810 wv->enabled = 1;
1811 wv->button_type = BUTTON_TYPE_NONE;
1812 wv->help = Qnil;
1813 save_wv = wv;
1814 prev_wv = 0;
1815 }
1816 else if (first_pane)
1817 {
1818 save_wv = wv;
1819 prev_wv = 0;
1820 }
1821 first_pane = 0;
1822 i += MENU_ITEMS_PANE_LENGTH;
1823 }
1824 else
1825 {
1826 /* Create a new item within current pane. */
1827 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1828
1829 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1830 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1831 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1832 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1833 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1834 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1835 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1836
1837 if (STRINGP (item_name))
1838 {
1839 if (unicode_append_menu)
1840 item_name = ENCODE_UTF_8 (item_name);
1841 else if (STRING_MULTIBYTE (item_name))
1842 item_name = ENCODE_SYSTEM (item_name);
1843
1844 ASET (menu_items, i + MENU_ITEMS_ITEM_NAME, item_name);
1845 }
1846
1847 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1848 {
1849 descrip = ENCODE_SYSTEM (descrip);
1850 ASET (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY, descrip);
1851 }
1852
1853 wv = xmalloc_widget_value ();
1854 if (prev_wv)
1855 prev_wv->next = wv;
1856 else
1857 save_wv->contents = wv;
1858 wv->name = (char *) SDATA (item_name);
1859 if (!NILP (descrip))
1860 wv->key = (char *) SDATA (descrip);
1861 wv->value = 0;
1862 /* Use the contents index as call_data, since we are
1863 restricted to 16-bits. */
1864 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1865 wv->enabled = !NILP (enable);
1866
1867 if (NILP (type))
1868 wv->button_type = BUTTON_TYPE_NONE;
1869 else if (EQ (type, QCtoggle))
1870 wv->button_type = BUTTON_TYPE_TOGGLE;
1871 else if (EQ (type, QCradio))
1872 wv->button_type = BUTTON_TYPE_RADIO;
1873 else
1874 abort ();
1875
1876 wv->selected = !NILP (selected);
1877 if (!STRINGP (help))
1878 help = Qnil;
1879
1880 wv->help = help;
1881
1882 prev_wv = wv;
1883
1884 i += MENU_ITEMS_ITEM_LENGTH;
1885 }
1886 }
1887
1888 /* Deal with the title, if it is non-nil. */
1889 if (!NILP (title))
1890 {
1891 widget_value *wv_title = xmalloc_widget_value ();
1892 widget_value *wv_sep = xmalloc_widget_value ();
1893
1894 /* Maybe replace this separator with a bitmap or owner-draw item
1895 so that it looks better. Having two separators looks odd. */
1896 wv_sep->name = "--";
1897 wv_sep->next = first_wv->contents;
1898 wv_sep->help = Qnil;
1899
1900 if (unicode_append_menu)
1901 title = ENCODE_UTF_8 (title);
1902 else if (STRING_MULTIBYTE (title))
1903 title = ENCODE_SYSTEM (title);
1904
1905 wv_title->name = (char *) SDATA (title);
1906 wv_title->enabled = TRUE;
1907 wv_title->title = TRUE;
1908 wv_title->button_type = BUTTON_TYPE_NONE;
1909 wv_title->help = Qnil;
1910 wv_title->next = wv_sep;
1911 first_wv->contents = wv_title;
1912 }
1913
1914 /* Actually create the menu. */
1915 current_popup_menu = menu = CreatePopupMenu ();
1916 fill_in_menu (menu, first_wv->contents);
1917
1918 /* Adjust coordinates to be root-window-relative. */
1919 pos.x = x;
1920 pos.y = y;
1921 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1922
1923 /* No selection has been chosen yet. */
1924 menu_item_selection = 0;
1925
1926 /* Display the menu. */
1927 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1928 WM_EMACS_TRACKPOPUPMENU,
1929 (WPARAM)menu, (LPARAM)&pos);
1930
1931 /* Clean up extraneous mouse events which might have been generated
1932 during the call. */
1933 discard_mouse_events ();
1934
1935 /* Free the widget_value objects we used to specify the contents. */
1936 free_menubar_widget_value_tree (first_wv);
1937
1938 DestroyMenu (menu);
1939
1940 /* Find the selected item, and its pane, to return
1941 the proper value. */
1942 if (menu_item_selection != 0)
1943 {
1944 Lisp_Object prefix, entry;
1945
1946 prefix = entry = Qnil;
1947 i = 0;
1948 while (i < menu_items_used)
1949 {
1950 if (EQ (AREF (menu_items, i), Qnil))
1951 {
1952 subprefix_stack[submenu_depth++] = prefix;
1953 prefix = entry;
1954 i++;
1955 }
1956 else if (EQ (AREF (menu_items, i), Qlambda))
1957 {
1958 prefix = subprefix_stack[--submenu_depth];
1959 i++;
1960 }
1961 else if (EQ (AREF (menu_items, i), Qt))
1962 {
1963 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1964 i += MENU_ITEMS_PANE_LENGTH;
1965 }
1966 /* Ignore a nil in the item list.
1967 It's meaningful only for dialog boxes. */
1968 else if (EQ (AREF (menu_items, i), Qquote))
1969 i += 1;
1970 else
1971 {
1972 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1973 if (menu_item_selection == i)
1974 {
1975 if (keymaps != 0)
1976 {
1977 int j;
1978
1979 entry = Fcons (entry, Qnil);
1980 if (!NILP (prefix))
1981 entry = Fcons (prefix, entry);
1982 for (j = submenu_depth - 1; j >= 0; j--)
1983 if (!NILP (subprefix_stack[j]))
1984 entry = Fcons (subprefix_stack[j], entry);
1985 }
1986 return entry;
1987 }
1988 i += MENU_ITEMS_ITEM_LENGTH;
1989 }
1990 }
1991 }
1992
1993 return Qnil;
1994 }
1995 \f
1996
1997 #ifdef HAVE_DIALOGS
1998 static char * button_names [] = {
1999 "button1", "button2", "button3", "button4", "button5",
2000 "button6", "button7", "button8", "button9", "button10" };
2001
2002 static Lisp_Object
2003 w32_dialog_show (f, keymaps, title, header, error)
2004 FRAME_PTR f;
2005 int keymaps;
2006 Lisp_Object title, header;
2007 char **error;
2008 {
2009 int i, nb_buttons=0;
2010 char dialog_name[6];
2011 int menu_item_selection;
2012
2013 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2014
2015 /* Number of elements seen so far, before boundary. */
2016 int left_count = 0;
2017 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2018 int boundary_seen = 0;
2019
2020 *error = NULL;
2021
2022 if (menu_items_n_panes > 1)
2023 {
2024 *error = "Multiple panes in dialog box";
2025 return Qnil;
2026 }
2027
2028 /* Create a tree of widget_value objects
2029 representing the text label and buttons. */
2030 {
2031 Lisp_Object pane_name, prefix;
2032 char *pane_string;
2033 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2034 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2035 pane_string = (NILP (pane_name)
2036 ? "" : (char *) SDATA (pane_name));
2037 prev_wv = xmalloc_widget_value ();
2038 prev_wv->value = pane_string;
2039 if (keymaps && !NILP (prefix))
2040 prev_wv->name++;
2041 prev_wv->enabled = 1;
2042 prev_wv->name = "message";
2043 prev_wv->help = Qnil;
2044 first_wv = prev_wv;
2045
2046 /* Loop over all panes and items, filling in the tree. */
2047 i = MENU_ITEMS_PANE_LENGTH;
2048 while (i < menu_items_used)
2049 {
2050
2051 /* Create a new item within current pane. */
2052 Lisp_Object item_name, enable, descrip, help;
2053
2054 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2055 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2056 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2057 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2058
2059 if (NILP (item_name))
2060 {
2061 free_menubar_widget_value_tree (first_wv);
2062 *error = "Submenu in dialog items";
2063 return Qnil;
2064 }
2065 if (EQ (item_name, Qquote))
2066 {
2067 /* This is the boundary between left-side elts
2068 and right-side elts. Stop incrementing right_count. */
2069 boundary_seen = 1;
2070 i++;
2071 continue;
2072 }
2073 if (nb_buttons >= 9)
2074 {
2075 free_menubar_widget_value_tree (first_wv);
2076 *error = "Too many dialog items";
2077 return Qnil;
2078 }
2079
2080 wv = xmalloc_widget_value ();
2081 prev_wv->next = wv;
2082 wv->name = (char *) button_names[nb_buttons];
2083 if (!NILP (descrip))
2084 wv->key = (char *) SDATA (descrip);
2085 wv->value = (char *) SDATA (item_name);
2086 wv->call_data = (void *) &AREF (menu_items, i);
2087 wv->enabled = !NILP (enable);
2088 wv->help = Qnil;
2089 prev_wv = wv;
2090
2091 if (! boundary_seen)
2092 left_count++;
2093
2094 nb_buttons++;
2095 i += MENU_ITEMS_ITEM_LENGTH;
2096 }
2097
2098 /* If the boundary was not specified,
2099 by default put half on the left and half on the right. */
2100 if (! boundary_seen)
2101 left_count = nb_buttons - nb_buttons / 2;
2102
2103 wv = xmalloc_widget_value ();
2104 wv->name = dialog_name;
2105 wv->help = Qnil;
2106
2107 /* Frame title: 'Q' = Question, 'I' = Information.
2108 Can also have 'E' = Error if, one day, we want
2109 a popup for errors. */
2110 if (NILP(header))
2111 dialog_name[0] = 'Q';
2112 else
2113 dialog_name[0] = 'I';
2114
2115 /* Dialog boxes use a really stupid name encoding
2116 which specifies how many buttons to use
2117 and how many buttons are on the right. */
2118 dialog_name[1] = '0' + nb_buttons;
2119 dialog_name[2] = 'B';
2120 dialog_name[3] = 'R';
2121 /* Number of buttons to put on the right. */
2122 dialog_name[4] = '0' + nb_buttons - left_count;
2123 dialog_name[5] = 0;
2124 wv->contents = first_wv;
2125 first_wv = wv;
2126 }
2127
2128 /* Actually create the dialog. */
2129 dialog_id = widget_id_tick++;
2130 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2131 f->output_data.w32->widget, 1, 0,
2132 dialog_selection_callback, 0);
2133 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2134
2135 /* Free the widget_value objects we used to specify the contents. */
2136 free_menubar_widget_value_tree (first_wv);
2137
2138 /* No selection has been chosen yet. */
2139 menu_item_selection = 0;
2140
2141 /* Display the menu. */
2142 lw_pop_up_all_widgets (dialog_id);
2143 popup_activated_flag = 1;
2144
2145 /* Process events that apply to the menu. */
2146 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2147
2148 lw_destroy_all_widgets (dialog_id);
2149
2150 /* Find the selected item, and its pane, to return
2151 the proper value. */
2152 if (menu_item_selection != 0)
2153 {
2154 Lisp_Object prefix;
2155
2156 prefix = Qnil;
2157 i = 0;
2158 while (i < menu_items_used)
2159 {
2160 Lisp_Object entry;
2161
2162 if (EQ (AREF (menu_items, i), Qt))
2163 {
2164 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2165 i += MENU_ITEMS_PANE_LENGTH;
2166 }
2167 else
2168 {
2169 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2170 if (menu_item_selection == i)
2171 {
2172 if (keymaps != 0)
2173 {
2174 entry = Fcons (entry, Qnil);
2175 if (!NILP (prefix))
2176 entry = Fcons (prefix, entry);
2177 }
2178 return entry;
2179 }
2180 i += MENU_ITEMS_ITEM_LENGTH;
2181 }
2182 }
2183 }
2184
2185 return Qnil;
2186 }
2187 #endif /* HAVE_DIALOGS */
2188 \f
2189
2190 /* Is this item a separator? */
2191 static int
2192 name_is_separator (name)
2193 char *name;
2194 {
2195 char *start = name;
2196
2197 /* Check if name string consists of only dashes ('-'). */
2198 while (*name == '-') name++;
2199 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2200 or "--deep-shadow". We don't implement them yet, se we just treat
2201 them like normal separators. */
2202 return (*name == '\0' || start + 2 == name);
2203 }
2204
2205
2206 /* Indicate boundary between left and right. */
2207 static int
2208 add_left_right_boundary (HMENU menu)
2209 {
2210 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2211 }
2212
2213 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2214 static void
2215 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2216 {
2217 while (len > 0)
2218 {
2219 int utf16;
2220 if (*src < 0x80)
2221 {
2222 *dest = (WCHAR) *src;
2223 dest++; src++; len--;
2224 }
2225 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2226 else if (*src < 0xC0)
2227 {
2228 src++; len--;
2229 }
2230 /* 2 char UTF-8 sequence. */
2231 else if (*src < 0xE0)
2232 {
2233 *dest = (WCHAR) (((*src & 0x1f) << 6)
2234 | (*(src + 1) & 0x3f));
2235 src += 2; len -= 2; dest++;
2236 }
2237 else if (*src < 0xF0)
2238 {
2239 *dest = (WCHAR) (((*src & 0x0f) << 12)
2240 | ((*(src + 1) & 0x3f) << 6)
2241 | (*(src + 2) & 0x3f));
2242 src += 3; len -= 3; dest++;
2243 }
2244 else /* Not encodable. Insert Unicode Substitution char. */
2245 {
2246 *dest = (WCHAR) 0xfffd;
2247 src++; len--; dest++;
2248 }
2249 }
2250 *dest = 0;
2251 }
2252
2253 static int
2254 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2255 {
2256 UINT fuFlags;
2257 char *out_string;
2258 int return_value;
2259
2260 if (name_is_separator (wv->name))
2261 {
2262 fuFlags = MF_SEPARATOR;
2263 out_string = NULL;
2264 }
2265 else
2266 {
2267 if (wv->enabled)
2268 fuFlags = MF_STRING;
2269 else
2270 fuFlags = MF_STRING | MF_GRAYED;
2271
2272 if (wv->key != NULL)
2273 {
2274 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2275 strcpy (out_string, wv->name);
2276 strcat (out_string, "\t");
2277 strcat (out_string, wv->key);
2278 }
2279 else
2280 out_string = wv->name;
2281
2282 if (item != NULL)
2283 fuFlags = MF_POPUP;
2284 else if (wv->title || wv->call_data == 0)
2285 {
2286 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2287 we can't deallocate the memory otherwise. */
2288 if (get_menu_item_info)
2289 {
2290 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2291 strcpy (out_string, wv->name);
2292 #ifdef MENU_DEBUG
2293 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2294 #endif
2295 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2296 }
2297 else
2298 fuFlags = MF_DISABLED;
2299 }
2300
2301 /* Draw radio buttons and tickboxes. */
2302 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2303 wv->button_type == BUTTON_TYPE_RADIO))
2304 fuFlags |= MF_CHECKED;
2305 else
2306 fuFlags |= MF_UNCHECKED;
2307 }
2308
2309 if (unicode_append_menu && out_string)
2310 {
2311 /* Convert out_string from UTF-8 to UTF-16-LE. */
2312 int utf8_len = strlen (out_string);
2313 WCHAR * utf16_string;
2314 if (fuFlags & MF_OWNERDRAW)
2315 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2316 else
2317 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2318
2319 utf8to16 (out_string, utf8_len, utf16_string);
2320 return_value = unicode_append_menu (menu, fuFlags,
2321 item != NULL ? (UINT) item
2322 : (UINT) wv->call_data,
2323 utf16_string);
2324 if (!return_value)
2325 {
2326 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2327 apparently does exist at least in some cases and appears to be
2328 stubbed out to do nothing. out_string is UTF-8, but since
2329 our standard menus are in English and this is only going to
2330 happen the first time a menu is used, the encoding is
2331 of minor importance compared with menus not working at all. */
2332 return_value =
2333 AppendMenu (menu, fuFlags,
2334 item != NULL ? (UINT) item: (UINT) wv->call_data,
2335 out_string);
2336 /* Don't use unicode menus in future. */
2337 unicode_append_menu = NULL;
2338 }
2339
2340 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2341 local_free (out_string);
2342 }
2343 else
2344 {
2345 return_value =
2346 AppendMenu (menu,
2347 fuFlags,
2348 item != NULL ? (UINT) item : (UINT) wv->call_data,
2349 out_string );
2350 }
2351
2352 /* This must be done after the menu item is created. */
2353 if (!wv->title && wv->call_data != 0)
2354 {
2355 if (set_menu_item_info)
2356 {
2357 MENUITEMINFO info;
2358 bzero (&info, sizeof (info));
2359 info.cbSize = sizeof (info);
2360 info.fMask = MIIM_DATA;
2361
2362 /* Set help string for menu item. Leave it as a Lisp_Object
2363 until it is ready to be displayed, since GC can happen while
2364 menus are active. */
2365 if (!NILP (wv->help))
2366 #ifdef USE_LISP_UNION_TYPE
2367 info.dwItemData = (DWORD) (wv->help).i;
2368 #else
2369 info.dwItemData = (DWORD) (wv->help);
2370 #endif
2371 if (wv->button_type == BUTTON_TYPE_RADIO)
2372 {
2373 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2374 RADIO items, but is not available on NT 3.51 and earlier. */
2375 info.fMask |= MIIM_TYPE | MIIM_STATE;
2376 info.fType = MFT_RADIOCHECK | MFT_STRING;
2377 info.dwTypeData = out_string;
2378 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2379 }
2380
2381 set_menu_item_info (menu,
2382 item != NULL ? (UINT) item : (UINT) wv->call_data,
2383 FALSE, &info);
2384 }
2385 }
2386 return return_value;
2387 }
2388
2389 /* Construct native Windows menu(bar) based on widget_value tree. */
2390 int
2391 fill_in_menu (HMENU menu, widget_value *wv)
2392 {
2393 int items_added = 0;
2394
2395 for ( ; wv != NULL; wv = wv->next)
2396 {
2397 if (wv->contents)
2398 {
2399 HMENU sub_menu = CreatePopupMenu ();
2400
2401 if (sub_menu == NULL)
2402 return 0;
2403
2404 if (!fill_in_menu (sub_menu, wv->contents) ||
2405 !add_menu_item (menu, wv, sub_menu))
2406 {
2407 DestroyMenu (sub_menu);
2408 return 0;
2409 }
2410 }
2411 else
2412 {
2413 if (!add_menu_item (menu, wv, NULL))
2414 return 0;
2415 }
2416 }
2417 return 1;
2418 }
2419
2420 int
2421 popup_activated ()
2422 {
2423 /* popup_activated_flag not actually used on W32 */
2424 return 0;
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 void syms_of_w32menu ()
2530 {
2531 globals_of_w32menu ();
2532 staticpro (&menu_items);
2533 menu_items = Qnil;
2534
2535 current_popup_menu = NULL;
2536
2537 Qdebug_on_next_call = intern ("debug-on-next-call");
2538 staticpro (&Qdebug_on_next_call);
2539
2540 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2541 doc: /* Frame for which we are updating a menu.
2542 The enable predicate for a menu command should check this variable. */);
2543 Vmenu_updating_frame = Qnil;
2544
2545 defsubr (&Sx_popup_menu);
2546 #ifdef HAVE_MENUS
2547 defsubr (&Sx_popup_dialog);
2548 #endif
2549 }
2550
2551 /*
2552 globals_of_w32menu is used to initialize those global variables that
2553 must always be initialized on startup even when the global variable
2554 initialized is non zero (see the function main in emacs.c).
2555 globals_of_w32menu is called from syms_of_w32menu when the global
2556 variable initialized is 0 and directly from main when initialized
2557 is non zero.
2558 */
2559 void globals_of_w32menu ()
2560 {
2561 /* See if Get/SetMenuItemInfo functions are available. */
2562 HMODULE user32 = GetModuleHandle ("user32.dll");
2563 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2564 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2565 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2566 }
2567
2568 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2569 (do not change this comment) */