Replace uses of GC_* macros with the non-GC_ versions.
[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 <mbstring.h>
27 #include "lisp.h"
28 #include "termhooks.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "frame.h"
32 #include "window.h"
33 #include "blockinput.h"
34 #include "buffer.h"
35 #include "charset.h"
36 #include "character.h"
37 #include "coding.h"
38
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
41 #include "w32term.h"
42
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
45 #ifndef makedev
46 #include <sys/types.h>
47 #endif
48
49 #include "dispextern.h"
50
51 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
52
53 /******************************************************************/
54 /* Definitions copied from lwlib.h */
55
56 typedef void * XtPointer;
57 typedef char Boolean;
58
59 enum button_type
60 {
61 BUTTON_TYPE_NONE,
62 BUTTON_TYPE_TOGGLE,
63 BUTTON_TYPE_RADIO
64 };
65
66 /* This structure is based on the one in ../lwlib/lwlib.h, modified
67 for Windows. */
68 typedef struct _widget_value
69 {
70 /* name of widget */
71 Lisp_Object lname;
72 char* name;
73 /* value (meaning depend on widget type) */
74 char* value;
75 /* keyboard equivalent. no implications for XtTranslations */
76 Lisp_Object lkey;
77 char* key;
78 /* Help string or nil if none.
79 GC finds this string through the frame's menu_bar_vector
80 or through menu_items. */
81 Lisp_Object help;
82 /* true if enabled */
83 Boolean enabled;
84 /* true if selected */
85 Boolean selected;
86 /* The type of a button. */
87 enum button_type button_type;
88 /* true if menu title */
89 Boolean title;
90 #if 0
91 /* true if was edited (maintained by get_value) */
92 Boolean edited;
93 /* true if has changed (maintained by lw library) */
94 change_type change;
95 /* true if this widget itself has changed,
96 but not counting the other widgets found in the `next' field. */
97 change_type this_one_change;
98 #endif
99 /* Contents of the sub-widgets, also selected slot for checkbox */
100 struct _widget_value* contents;
101 /* data passed to callback */
102 XtPointer call_data;
103 /* next one in the list */
104 struct _widget_value* next;
105 #if 0
106 /* slot for the toolkit dependent part. Always initialize to NULL. */
107 void* toolkit_data;
108 /* tell us if we should free the toolkit data slot when freeing the
109 widget_value itself. */
110 Boolean free_toolkit_data;
111
112 /* we resource the widget_value structures; this points to the next
113 one on the free list if this one has been deallocated.
114 */
115 struct _widget_value *free_list;
116 #endif
117 } widget_value;
118
119 /* Local memory management */
120 #define local_heap (GetProcessHeap ())
121 #define local_alloc(n) (HeapAlloc (local_heap, HEAP_ZERO_MEMORY, (n)))
122 #define local_free(p) (HeapFree (local_heap, 0, ((LPVOID) (p))))
123
124 #define malloc_widget_value() ((widget_value *) local_alloc (sizeof (widget_value)))
125 #define free_widget_value(wv) (local_free ((wv)))
126
127 /******************************************************************/
128
129 #ifndef TRUE
130 #define TRUE 1
131 #define FALSE 0
132 #endif /* no TRUE */
133
134 HMENU current_popup_menu;
135
136 void syms_of_w32menu ();
137 void globals_of_w32menu ();
138
139 typedef BOOL (WINAPI * GetMenuItemInfoA_Proc) (
140 IN HMENU,
141 IN UINT,
142 IN BOOL,
143 IN OUT LPMENUITEMINFOA);
144 typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) (
145 IN HMENU,
146 IN UINT,
147 IN BOOL,
148 IN LPCMENUITEMINFOA);
149
150 GetMenuItemInfoA_Proc get_menu_item_info = NULL;
151 SetMenuItemInfoA_Proc set_menu_item_info = NULL;
152 AppendMenuW_Proc unicode_append_menu = NULL;
153
154 Lisp_Object Qdebug_on_next_call;
155
156 extern Lisp_Object Vmenu_updating_frame;
157
158 extern Lisp_Object Qmenu_bar;
159
160 extern Lisp_Object QCtoggle, QCradio;
161
162 extern Lisp_Object Voverriding_local_map;
163 extern Lisp_Object Voverriding_local_map_menu_flag;
164
165 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
166
167 extern Lisp_Object Qmenu_bar_update_hook;
168
169 void set_frame_menubar ();
170
171 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
172 Lisp_Object, Lisp_Object, Lisp_Object,
173 Lisp_Object, Lisp_Object));
174 #ifdef HAVE_DIALOGS
175 static Lisp_Object w32_dialog_show ();
176 #endif
177 static Lisp_Object w32_menu_show ();
178
179 static void keymap_panes ();
180 static void single_keymap_panes ();
181 static void single_menu_item ();
182 static void list_of_panes ();
183 static void list_of_items ();
184 void w32_free_menu_strings (HWND);
185 \f
186 /* This holds a Lisp vector that holds the results of decoding
187 the keymaps or alist-of-alists that specify a menu.
188
189 It describes the panes and items within the panes.
190
191 Each pane is described by 3 elements in the vector:
192 t, the pane name, the pane's prefix key.
193 Then follow the pane's items, with 5 elements per item:
194 the item string, the enable flag, the item's value,
195 the definition, and the equivalent keyboard key's description string.
196
197 In some cases, multiple levels of menus may be described.
198 A single vector slot containing nil indicates the start of a submenu.
199 A single vector slot containing lambda indicates the end of a submenu.
200 The submenu follows a menu item which is the way to reach the submenu.
201
202 A single vector slot containing quote indicates that the
203 following items should appear on the right of a dialog box.
204
205 Using a Lisp vector to hold this information while we decode it
206 takes care of protecting all the data from GC. */
207
208 #define MENU_ITEMS_PANE_NAME 1
209 #define MENU_ITEMS_PANE_PREFIX 2
210 #define MENU_ITEMS_PANE_LENGTH 3
211
212 enum menu_item_idx
213 {
214 MENU_ITEMS_ITEM_NAME = 0,
215 MENU_ITEMS_ITEM_ENABLE,
216 MENU_ITEMS_ITEM_VALUE,
217 MENU_ITEMS_ITEM_EQUIV_KEY,
218 MENU_ITEMS_ITEM_DEFINITION,
219 MENU_ITEMS_ITEM_TYPE,
220 MENU_ITEMS_ITEM_SELECTED,
221 MENU_ITEMS_ITEM_HELP,
222 MENU_ITEMS_ITEM_LENGTH
223 };
224
225 static Lisp_Object menu_items;
226
227 /* Number of slots currently allocated in menu_items. */
228 static int menu_items_allocated;
229
230 /* This is the index in menu_items of the first empty slot. */
231 static int menu_items_used;
232
233 /* The number of panes currently recorded in menu_items,
234 excluding those within submenus. */
235 static int menu_items_n_panes;
236
237 /* Current depth within submenus. */
238 static int menu_items_submenu_depth;
239
240 static int next_menubar_widget_id;
241
242 /* This is set nonzero after the user activates the menu bar, and set
243 to zero again after the menu bars are redisplayed by prepare_menu_bar.
244 While it is nonzero, all calls to set_frame_menubar go deep.
245
246 I don't understand why this is needed, but it does seem to be
247 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
248
249 int pending_menu_activation;
250 \f
251
252 /* Return the frame whose ->output_data.w32->menubar_widget equals
253 ID, or 0 if none. */
254
255 static struct frame *
256 menubar_id_to_frame (id)
257 HMENU id;
258 {
259 Lisp_Object tail, frame;
260 FRAME_PTR f;
261
262 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
263 {
264 frame = XCAR (tail);
265 if (!FRAMEP (frame))
266 continue;
267 f = XFRAME (frame);
268 if (!FRAME_WINDOW_P (f))
269 continue;
270 if (f->output_data.w32->menubar_widget == id)
271 return f;
272 }
273 return 0;
274 }
275 \f
276 /* Initialize the menu_items structure if we haven't already done so.
277 Also mark it as currently empty. */
278
279 static void
280 init_menu_items ()
281 {
282 if (NILP (menu_items))
283 {
284 menu_items_allocated = 60;
285 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
286 }
287
288 menu_items_used = 0;
289 menu_items_n_panes = 0;
290 menu_items_submenu_depth = 0;
291 }
292
293 /* Call at the end of generating the data in menu_items.
294 This fills in the number of items in the last pane. */
295
296 static void
297 finish_menu_items ()
298 {
299 }
300
301 /* Call when finished using the data for the current menu
302 in menu_items. */
303
304 static void
305 discard_menu_items ()
306 {
307 /* Free the structure if it is especially large.
308 Otherwise, hold on to it, to save time. */
309 if (menu_items_allocated > 200)
310 {
311 menu_items = Qnil;
312 menu_items_allocated = 0;
313 }
314 }
315
316 /* Make the menu_items vector twice as large. */
317
318 static void
319 grow_menu_items ()
320 {
321 Lisp_Object old;
322 int old_size = menu_items_allocated;
323 old = menu_items;
324
325 menu_items_allocated *= 2;
326 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
327 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
328 old_size * sizeof (Lisp_Object));
329 }
330
331 /* Begin a submenu. */
332
333 static void
334 push_submenu_start ()
335 {
336 if (menu_items_used + 1 > menu_items_allocated)
337 grow_menu_items ();
338
339 ASET (menu_items, menu_items_used++, Qnil);
340 menu_items_submenu_depth++;
341 }
342
343 /* End a submenu. */
344
345 static void
346 push_submenu_end ()
347 {
348 if (menu_items_used + 1 > menu_items_allocated)
349 grow_menu_items ();
350
351 ASET (menu_items, menu_items_used++, Qlambda);
352 menu_items_submenu_depth--;
353 }
354
355 /* Indicate boundary between left and right. */
356
357 static void
358 push_left_right_boundary ()
359 {
360 if (menu_items_used + 1 > menu_items_allocated)
361 grow_menu_items ();
362
363 ASET (menu_items, menu_items_used++, Qquote);
364 }
365
366 /* Start a new menu pane in menu_items.
367 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
368
369 static void
370 push_menu_pane (name, prefix_vec)
371 Lisp_Object name, prefix_vec;
372 {
373 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
374 grow_menu_items ();
375
376 if (menu_items_submenu_depth == 0)
377 menu_items_n_panes++;
378 ASET (menu_items, menu_items_used++, Qt);
379 ASET (menu_items, menu_items_used++, name);
380 ASET (menu_items, menu_items_used++, prefix_vec);
381 }
382
383 /* Push one menu item into the current pane. NAME is the string to
384 display. ENABLE if non-nil means this item can be selected. KEY
385 is the key generated by choosing this item, or nil if this item
386 doesn't really have a definition. DEF is the definition of this
387 item. EQUIV is the textual description of the keyboard equivalent
388 for this item (or nil if none). TYPE is the type of this menu
389 item, one of nil, `toggle' or `radio'. */
390
391 static void
392 push_menu_item (name, enable, key, def, equiv, type, selected, help)
393 Lisp_Object name, enable, key, def, equiv, type, selected, help;
394 {
395 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
396 grow_menu_items ();
397
398 ASET (menu_items, menu_items_used++, name);
399 ASET (menu_items, menu_items_used++, enable);
400 ASET (menu_items, menu_items_used++, key);
401 ASET (menu_items, menu_items_used++, equiv);
402 ASET (menu_items, menu_items_used++, def);
403 ASET (menu_items, menu_items_used++, type);
404 ASET (menu_items, menu_items_used++, selected);
405 ASET (menu_items, menu_items_used++, help);
406 }
407 \f
408 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
409 and generate menu panes for them in menu_items.
410 If NOTREAL is nonzero,
411 don't bother really computing whether an item is enabled. */
412
413 static void
414 keymap_panes (keymaps, nmaps, notreal)
415 Lisp_Object *keymaps;
416 int nmaps;
417 int notreal;
418 {
419 int mapno;
420
421 init_menu_items ();
422
423 /* Loop over the given keymaps, making a pane for each map.
424 But don't make a pane that is empty--ignore that map instead.
425 P is the number of panes we have made so far. */
426 for (mapno = 0; mapno < nmaps; mapno++)
427 single_keymap_panes (keymaps[mapno],
428 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
429
430 finish_menu_items ();
431 }
432
433 /* This is a recursive subroutine of keymap_panes.
434 It handles one keymap, KEYMAP.
435 The other arguments are passed along
436 or point to local variables of the previous function.
437 If NOTREAL is nonzero, only check for equivalent key bindings, don't
438 evaluate expressions in menu items and don't make any menu.
439
440 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
441
442 static void
443 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
444 Lisp_Object keymap;
445 Lisp_Object pane_name;
446 Lisp_Object prefix;
447 int notreal;
448 int maxdepth;
449 {
450 Lisp_Object pending_maps = Qnil;
451 Lisp_Object tail, item;
452 struct gcpro gcpro1, gcpro2;
453
454 if (maxdepth <= 0)
455 return;
456
457 push_menu_pane (pane_name, prefix);
458
459 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
460 {
461 GCPRO2 (keymap, pending_maps);
462 /* Look at each key binding, and if it is a menu item add it
463 to this menu. */
464 item = XCAR (tail);
465 if (CONSP (item))
466 single_menu_item (XCAR (item), XCDR (item),
467 &pending_maps, notreal, maxdepth);
468 else if (VECTORP (item))
469 {
470 /* Loop over the char values represented in the vector. */
471 int len = ASIZE (item);
472 int c;
473 for (c = 0; c < len; c++)
474 {
475 Lisp_Object character;
476 XSETFASTINT (character, c);
477 single_menu_item (character, AREF (item, c),
478 &pending_maps, notreal, maxdepth);
479 }
480 }
481 UNGCPRO;
482 }
483
484 /* Process now any submenus which want to be panes at this level. */
485 while (!NILP (pending_maps))
486 {
487 Lisp_Object elt, eltcdr, string;
488 elt = Fcar (pending_maps);
489 eltcdr = XCDR (elt);
490 string = XCAR (eltcdr);
491 /* We no longer discard the @ from the beginning of the string here.
492 Instead, we do this in w32_menu_show. */
493 single_keymap_panes (Fcar (elt), string,
494 XCDR (eltcdr), notreal, maxdepth - 1);
495 pending_maps = Fcdr (pending_maps);
496 }
497 }
498 \f
499 /* This is a subroutine of single_keymap_panes that handles one
500 keymap entry.
501 KEY is a key in a keymap and ITEM is its binding.
502 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
503 separate panes.
504 If NOTREAL is nonzero, only check for equivalent key bindings, don't
505 evaluate expressions in menu items and don't make any menu.
506 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
507
508 static void
509 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
510 Lisp_Object key, item;
511 Lisp_Object *pending_maps_ptr;
512 int maxdepth, notreal;
513 {
514 Lisp_Object map, item_string, enabled;
515 struct gcpro gcpro1, gcpro2;
516 int res;
517
518 /* Parse the menu item and leave the result in item_properties. */
519 GCPRO2 (key, item);
520 res = parse_menu_item (item, notreal, 0);
521 UNGCPRO;
522 if (!res)
523 return; /* Not a menu item. */
524
525 map = AREF (item_properties, ITEM_PROPERTY_MAP);
526
527 if (notreal)
528 {
529 /* We don't want to make a menu, just traverse the keymaps to
530 precompute equivalent key bindings. */
531 if (!NILP (map))
532 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
533 return;
534 }
535
536 enabled = AREF (item_properties, ITEM_PROPERTY_ENABLE);
537 item_string = AREF (item_properties, ITEM_PROPERTY_NAME);
538
539 if (!NILP (map) && SREF (item_string, 0) == '@')
540 {
541 if (!NILP (enabled))
542 /* An enabled separate pane. Remember this to handle it later. */
543 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
544 *pending_maps_ptr);
545 return;
546 }
547
548 push_menu_item (item_string, enabled, key,
549 AREF (item_properties, ITEM_PROPERTY_DEF),
550 AREF (item_properties, ITEM_PROPERTY_KEYEQ),
551 AREF (item_properties, ITEM_PROPERTY_TYPE),
552 AREF (item_properties, ITEM_PROPERTY_SELECTED),
553 AREF (item_properties, ITEM_PROPERTY_HELP));
554
555 /* Display a submenu using the toolkit. */
556 if (! (NILP (map) || NILP (enabled)))
557 {
558 push_submenu_start ();
559 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
560 push_submenu_end ();
561 }
562 }
563 \f
564 /* Push all the panes and items of a menu described by the
565 alist-of-alists MENU.
566 This handles old-fashioned calls to x-popup-menu. */
567
568 static void
569 list_of_panes (menu)
570 Lisp_Object menu;
571 {
572 Lisp_Object tail;
573
574 init_menu_items ();
575
576 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
577 {
578 Lisp_Object elt, pane_name, pane_data;
579 elt = Fcar (tail);
580 pane_name = Fcar (elt);
581 CHECK_STRING (pane_name);
582 push_menu_pane (pane_name, Qnil);
583 pane_data = Fcdr (elt);
584 CHECK_CONS (pane_data);
585 list_of_items (pane_data);
586 }
587
588 finish_menu_items ();
589 }
590
591 /* Push the items in a single pane defined by the alist PANE. */
592
593 static void
594 list_of_items (pane)
595 Lisp_Object pane;
596 {
597 Lisp_Object tail, item, item1;
598
599 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
600 {
601 item = Fcar (tail);
602 if (STRINGP (item))
603 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
604 else if (NILP (item))
605 push_left_right_boundary ();
606 else
607 {
608 CHECK_CONS (item);
609 item1 = Fcar (item);
610 CHECK_STRING (item1);
611 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
612 }
613 }
614 }
615 \f
616 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
617 doc: /* Pop up a deck-of-cards menu and return user's selection.
618 POSITION is a position specification. This is either a mouse button
619 event or a list ((XOFFSET YOFFSET) WINDOW) where XOFFSET and YOFFSET
620 are positions in pixels from the top left corner of WINDOW's frame
621 \(WINDOW may be a frame object instead of a window). This controls the
622 position of the center of the first line in the first pane of the
623 menu, not the top left of the menu as a whole. If POSITION is t, it
624 means to use the current mouse position.
625
626 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
627 The menu items come from key bindings that have a menu string as well as
628 a definition; actually, the \"definition\" in such a key binding looks like
629 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
630 the keymap as a top-level element.
631
632 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
633 Otherwise, REAL-DEFINITION should be a valid key binding definition.
634
635 You can also use a list of keymaps as MENU. Then each keymap makes a
636 separate pane. When MENU is a keymap or a list of keymaps, the return
637 value is a list of events.
638
639 Alternatively, you can specify a menu of multiple panes with a list of
640 the form (TITLE PANE1 PANE2...), where each pane is a list of
641 form (TITLE ITEM1 ITEM2...).
642 Each ITEM is normally a cons cell (STRING . VALUE); but a string can
643 appear as an item--that makes a nonselectable line in the menu.
644 With this form of menu, the return value is VALUE from the chosen item.
645
646 If POSITION is nil, don't display the menu at all, just precalculate the
647 cached information about equivalent key sequences. */)
648 (position, menu)
649 Lisp_Object position, menu;
650 {
651 Lisp_Object keymap, tem;
652 int xpos = 0, ypos = 0;
653 Lisp_Object title;
654 char *error_name;
655 Lisp_Object selection;
656 FRAME_PTR f = NULL;
657 Lisp_Object x, y, window;
658 int keymaps = 0;
659 int for_click = 0;
660 struct gcpro gcpro1;
661
662 #ifdef HAVE_MENUS
663 if (! NILP (position))
664 {
665 check_w32 ();
666
667 /* Decode the first argument: find the window and the coordinates. */
668 if (EQ (position, Qt)
669 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
670 || EQ (XCAR (position), Qtool_bar))))
671 {
672 /* Use the mouse's current position. */
673 FRAME_PTR new_f = SELECTED_FRAME ();
674 Lisp_Object bar_window;
675 enum scroll_bar_part part;
676 unsigned long time;
677
678 if (mouse_position_hook)
679 (*mouse_position_hook) (&new_f, 1, &bar_window,
680 &part, &x, &y, &time);
681 if (new_f != 0)
682 XSETFRAME (window, new_f);
683 else
684 {
685 window = selected_window;
686 XSETFASTINT (x, 0);
687 XSETFASTINT (y, 0);
688 }
689 }
690 else
691 {
692 tem = Fcar (position);
693 if (CONSP (tem))
694 {
695 window = Fcar (Fcdr (position));
696 x = Fcar (tem);
697 y = Fcar (Fcdr (tem));
698 }
699 else
700 {
701 for_click = 1;
702 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
703 window = Fcar (tem); /* POSN_WINDOW (tem) */
704 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
705 x = Fcar (tem);
706 y = Fcdr (tem);
707 }
708 }
709
710 CHECK_NUMBER (x);
711 CHECK_NUMBER (y);
712
713 /* Decode where to put the menu. */
714
715 if (FRAMEP (window))
716 {
717 f = XFRAME (window);
718 xpos = 0;
719 ypos = 0;
720 }
721 else if (WINDOWP (window))
722 {
723 CHECK_LIVE_WINDOW (window);
724 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
725
726 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
727 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
728 }
729 else
730 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
731 but I don't want to make one now. */
732 CHECK_WINDOW (window);
733
734 xpos += XINT (x);
735 ypos += XINT (y);
736
737 XSETFRAME (Vmenu_updating_frame, f);
738 }
739 else
740 Vmenu_updating_frame = Qnil;
741 #endif /* HAVE_MENUS */
742
743 title = Qnil;
744 GCPRO1 (title);
745
746 /* Decode the menu items from what was specified. */
747
748 keymap = get_keymap (menu, 0, 0);
749 if (CONSP (keymap))
750 {
751 /* We were given a keymap. Extract menu info from the keymap. */
752 Lisp_Object prompt;
753
754 /* Extract the detailed info to make one pane. */
755 keymap_panes (&menu, 1, NILP (position));
756
757 /* Search for a string appearing directly as an element of the keymap.
758 That string is the title of the menu. */
759 prompt = Fkeymap_prompt (keymap);
760 if (NILP (title) && !NILP (prompt))
761 title = prompt;
762
763 /* Make that be the pane title of the first pane. */
764 if (!NILP (prompt) && menu_items_n_panes >= 0)
765 ASET (menu_items, MENU_ITEMS_PANE_NAME, prompt);
766
767 keymaps = 1;
768 }
769 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
770 {
771 /* We were given a list of keymaps. */
772 int nmaps = XFASTINT (Flength (menu));
773 Lisp_Object *maps
774 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
775 int i;
776
777 title = Qnil;
778
779 /* The first keymap that has a prompt string
780 supplies the menu title. */
781 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
782 {
783 Lisp_Object prompt;
784
785 maps[i++] = keymap = get_keymap (Fcar (tem), 1, 0);
786
787 prompt = Fkeymap_prompt (keymap);
788 if (NILP (title) && !NILP (prompt))
789 title = prompt;
790 }
791
792 /* Extract the detailed info to make one pane. */
793 keymap_panes (maps, nmaps, NILP (position));
794
795 /* Make the title be the pane title of the first pane. */
796 if (!NILP (title) && menu_items_n_panes >= 0)
797 ASET (menu_items, MENU_ITEMS_PANE_NAME, title);
798
799 keymaps = 1;
800 }
801 else
802 {
803 /* We were given an old-fashioned menu. */
804 title = Fcar (menu);
805 CHECK_STRING (title);
806
807 list_of_panes (Fcdr (menu));
808
809 keymaps = 0;
810 }
811
812 if (NILP (position))
813 {
814 discard_menu_items ();
815 UNGCPRO;
816 return Qnil;
817 }
818
819 #ifdef HAVE_MENUS
820 /* If resources from a previous popup menu still exist, does nothing
821 until the `menu_free_timer' has freed them (see w32fns.c). This
822 can occur if you press ESC or click outside a menu without selecting
823 a menu item.
824 */
825 if (current_popup_menu)
826 {
827 discard_menu_items ();
828 UNGCPRO;
829 return Qnil;
830 }
831
832 /* Display them in a menu. */
833 BLOCK_INPUT;
834
835 selection = w32_menu_show (f, xpos, ypos, for_click,
836 keymaps, title, &error_name);
837 UNBLOCK_INPUT;
838
839 discard_menu_items ();
840
841 #endif /* HAVE_MENUS */
842
843 UNGCPRO;
844
845 if (error_name) error (error_name);
846 return selection;
847 }
848
849 #ifdef HAVE_MENUS
850
851 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
852 doc: /* Pop up a dialog box and return user's selection.
853 POSITION specifies which frame to use.
854 This is normally a mouse button event or a window or frame.
855 If POSITION is t, it means to use the frame the mouse is on.
856 The dialog box appears in the middle of the specified frame.
857
858 CONTENTS specifies the alternatives to display in the dialog box.
859 It is a list of the form (TITLE ITEM1 ITEM2...).
860 Each ITEM is a cons cell (STRING . VALUE).
861 The return value is VALUE from the chosen item.
862
863 An ITEM may also be just a string--that makes a nonselectable item.
864 An ITEM may also be nil--that means to put all preceding items
865 on the left of the dialog box and all following items on the right.
866 \(By default, approximately half appear on each side.)
867
868 If HEADER is non-nil, the frame title for the box is "Information",
869 otherwise it is "Question". */)
870 (position, contents, header)
871 Lisp_Object position, contents, header;
872 {
873 FRAME_PTR f = NULL;
874 Lisp_Object window;
875
876 check_w32 ();
877
878 /* Decode the first argument: find the window or frame to use. */
879 if (EQ (position, Qt)
880 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
881 || EQ (XCAR (position), Qtool_bar))))
882 {
883 #if 0 /* Using the frame the mouse is on may not be right. */
884 /* Use the mouse's current position. */
885 FRAME_PTR new_f = SELECTED_FRAME ();
886 Lisp_Object bar_window;
887 enum scroll_bar_part part;
888 unsigned long time;
889 Lisp_Object x, y;
890
891 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
892
893 if (new_f != 0)
894 XSETFRAME (window, new_f);
895 else
896 window = selected_window;
897 #endif
898 window = selected_window;
899 }
900 else if (CONSP (position))
901 {
902 Lisp_Object tem;
903 tem = Fcar (position);
904 if (CONSP (tem))
905 window = Fcar (Fcdr (position));
906 else
907 {
908 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
909 window = Fcar (tem); /* POSN_WINDOW (tem) */
910 }
911 }
912 else if (WINDOWP (position) || FRAMEP (position))
913 window = position;
914 else
915 window = Qnil;
916
917 /* Decode where to put the menu. */
918
919 if (FRAMEP (window))
920 f = XFRAME (window);
921 else if (WINDOWP (window))
922 {
923 CHECK_LIVE_WINDOW (window);
924 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
925 }
926 else
927 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
928 but I don't want to make one now. */
929 CHECK_WINDOW (window);
930
931 #ifndef HAVE_DIALOGS
932 /* Display a menu with these alternatives
933 in the middle of frame F. */
934 {
935 Lisp_Object x, y, frame, newpos;
936 XSETFRAME (frame, f);
937 XSETINT (x, x_pixel_width (f) / 2);
938 XSETINT (y, x_pixel_height (f) / 2);
939 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
940
941 return Fx_popup_menu (newpos,
942 Fcons (Fcar (contents), Fcons (contents, Qnil)));
943 }
944 #else /* HAVE_DIALOGS */
945 {
946 Lisp_Object title;
947 char *error_name;
948 Lisp_Object selection;
949
950 /* Decode the dialog items from what was specified. */
951 title = Fcar (contents);
952 CHECK_STRING (title);
953
954 list_of_panes (Fcons (contents, Qnil));
955
956 /* Display them in a dialog box. */
957 BLOCK_INPUT;
958 selection = w32_dialog_show (f, 0, title, header, &error_name);
959 UNBLOCK_INPUT;
960
961 discard_menu_items ();
962
963 if (error_name) error (error_name);
964 return selection;
965 }
966 #endif /* HAVE_DIALOGS */
967 }
968
969 /* Activate the menu bar of frame F.
970 This is called from keyboard.c when it gets the
971 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
972
973 To activate the menu bar, we signal to the input thread that it can
974 return from the WM_INITMENU message, allowing the normal Windows
975 processing of the menus.
976
977 But first we recompute the menu bar contents (the whole tree).
978
979 This way we can safely execute Lisp code. */
980
981 void
982 x_activate_menubar (f)
983 FRAME_PTR f;
984 {
985 set_frame_menubar (f, 0, 1);
986
987 /* Lock out further menubar changes while active. */
988 f->output_data.w32->menubar_active = 1;
989
990 /* Signal input thread to return from WM_INITMENU. */
991 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
992 }
993
994 /* This callback is called from the menu bar pulldown menu
995 when the user makes a selection.
996 Figure out what the user chose
997 and put the appropriate events into the keyboard buffer. */
998
999 void
1000 menubar_selection_callback (FRAME_PTR f, void * client_data)
1001 {
1002 Lisp_Object prefix, entry;
1003 Lisp_Object vector;
1004 Lisp_Object *subprefix_stack;
1005 int submenu_depth = 0;
1006 int i;
1007
1008 if (!f)
1009 return;
1010 entry = Qnil;
1011 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1012 vector = f->menu_bar_vector;
1013 prefix = Qnil;
1014 i = 0;
1015 while (i < f->menu_bar_items_used)
1016 {
1017 if (EQ (AREF (vector, i), Qnil))
1018 {
1019 subprefix_stack[submenu_depth++] = prefix;
1020 prefix = entry;
1021 i++;
1022 }
1023 else if (EQ (AREF (vector, i), Qlambda))
1024 {
1025 prefix = subprefix_stack[--submenu_depth];
1026 i++;
1027 }
1028 else if (EQ (AREF (vector, i), Qt))
1029 {
1030 prefix = AREF (vector, i + MENU_ITEMS_PANE_PREFIX);
1031 i += MENU_ITEMS_PANE_LENGTH;
1032 }
1033 else
1034 {
1035 entry = AREF (vector, i + MENU_ITEMS_ITEM_VALUE);
1036 /* The EMACS_INT cast avoids a warning. There's no problem
1037 as long as pointers have enough bits to hold small integers. */
1038 if ((int) (EMACS_INT) client_data == i)
1039 {
1040 int j;
1041 struct input_event buf;
1042 Lisp_Object frame;
1043 EVENT_INIT (buf);
1044
1045 XSETFRAME (frame, f);
1046 buf.kind = MENU_BAR_EVENT;
1047 buf.frame_or_window = frame;
1048 buf.arg = frame;
1049 kbd_buffer_store_event (&buf);
1050
1051 for (j = 0; j < submenu_depth; j++)
1052 if (!NILP (subprefix_stack[j]))
1053 {
1054 buf.kind = MENU_BAR_EVENT;
1055 buf.frame_or_window = frame;
1056 buf.arg = subprefix_stack[j];
1057 kbd_buffer_store_event (&buf);
1058 }
1059
1060 if (!NILP (prefix))
1061 {
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = prefix;
1065 kbd_buffer_store_event (&buf);
1066 }
1067
1068 buf.kind = MENU_BAR_EVENT;
1069 buf.frame_or_window = frame;
1070 buf.arg = entry;
1071 /* Free memory used by owner-drawn and help-echo strings. */
1072 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1073 kbd_buffer_store_event (&buf);
1074
1075 f->output_data.w32->menubar_active = 0;
1076 return;
1077 }
1078 i += MENU_ITEMS_ITEM_LENGTH;
1079 }
1080 }
1081 /* Free memory used by owner-drawn and help-echo strings. */
1082 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1083 f->output_data.w32->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 /* Free the owner-drawn and help-echo menu strings. */
1941 w32_free_menu_strings (FRAME_W32_WINDOW (f));
1942 f->output_data.w32->menubar_active = 0;
1943
1944 /* Find the selected item, and its pane, to return
1945 the proper value. */
1946 if (menu_item_selection != 0)
1947 {
1948 Lisp_Object prefix, entry;
1949
1950 prefix = entry = Qnil;
1951 i = 0;
1952 while (i < menu_items_used)
1953 {
1954 if (EQ (AREF (menu_items, i), Qnil))
1955 {
1956 subprefix_stack[submenu_depth++] = prefix;
1957 prefix = entry;
1958 i++;
1959 }
1960 else if (EQ (AREF (menu_items, i), Qlambda))
1961 {
1962 prefix = subprefix_stack[--submenu_depth];
1963 i++;
1964 }
1965 else if (EQ (AREF (menu_items, i), Qt))
1966 {
1967 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1968 i += MENU_ITEMS_PANE_LENGTH;
1969 }
1970 /* Ignore a nil in the item list.
1971 It's meaningful only for dialog boxes. */
1972 else if (EQ (AREF (menu_items, i), Qquote))
1973 i += 1;
1974 else
1975 {
1976 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
1977 if (menu_item_selection == i)
1978 {
1979 if (keymaps != 0)
1980 {
1981 int j;
1982
1983 entry = Fcons (entry, Qnil);
1984 if (!NILP (prefix))
1985 entry = Fcons (prefix, entry);
1986 for (j = submenu_depth - 1; j >= 0; j--)
1987 if (!NILP (subprefix_stack[j]))
1988 entry = Fcons (subprefix_stack[j], entry);
1989 }
1990 return entry;
1991 }
1992 i += MENU_ITEMS_ITEM_LENGTH;
1993 }
1994 }
1995 }
1996 else if (!for_click)
1997 /* Make "Cancel" equivalent to C-g. */
1998 Fsignal (Qquit, Qnil);
1999
2000 return Qnil;
2001 }
2002 \f
2003
2004 #ifdef HAVE_DIALOGS
2005 static char * button_names [] = {
2006 "button1", "button2", "button3", "button4", "button5",
2007 "button6", "button7", "button8", "button9", "button10" };
2008
2009 static Lisp_Object
2010 w32_dialog_show (f, keymaps, title, header, error)
2011 FRAME_PTR f;
2012 int keymaps;
2013 Lisp_Object title, header;
2014 char **error;
2015 {
2016 int i, nb_buttons=0;
2017 char dialog_name[6];
2018 int menu_item_selection;
2019
2020 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2021
2022 /* Number of elements seen so far, before boundary. */
2023 int left_count = 0;
2024 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2025 int boundary_seen = 0;
2026
2027 *error = NULL;
2028
2029 if (menu_items_n_panes > 1)
2030 {
2031 *error = "Multiple panes in dialog box";
2032 return Qnil;
2033 }
2034
2035 /* Create a tree of widget_value objects
2036 representing the text label and buttons. */
2037 {
2038 Lisp_Object pane_name, prefix;
2039 char *pane_string;
2040 pane_name = AREF (menu_items, MENU_ITEMS_PANE_NAME);
2041 prefix = AREF (menu_items, MENU_ITEMS_PANE_PREFIX);
2042 pane_string = (NILP (pane_name)
2043 ? "" : (char *) SDATA (pane_name));
2044 prev_wv = xmalloc_widget_value ();
2045 prev_wv->value = pane_string;
2046 if (keymaps && !NILP (prefix))
2047 prev_wv->name++;
2048 prev_wv->enabled = 1;
2049 prev_wv->name = "message";
2050 prev_wv->help = Qnil;
2051 first_wv = prev_wv;
2052
2053 /* Loop over all panes and items, filling in the tree. */
2054 i = MENU_ITEMS_PANE_LENGTH;
2055 while (i < menu_items_used)
2056 {
2057
2058 /* Create a new item within current pane. */
2059 Lisp_Object item_name, enable, descrip, help;
2060
2061 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
2062 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
2063 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
2064 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
2065
2066 if (NILP (item_name))
2067 {
2068 free_menubar_widget_value_tree (first_wv);
2069 *error = "Submenu in dialog items";
2070 return Qnil;
2071 }
2072 if (EQ (item_name, Qquote))
2073 {
2074 /* This is the boundary between left-side elts
2075 and right-side elts. Stop incrementing right_count. */
2076 boundary_seen = 1;
2077 i++;
2078 continue;
2079 }
2080 if (nb_buttons >= 9)
2081 {
2082 free_menubar_widget_value_tree (first_wv);
2083 *error = "Too many dialog items";
2084 return Qnil;
2085 }
2086
2087 wv = xmalloc_widget_value ();
2088 prev_wv->next = wv;
2089 wv->name = (char *) button_names[nb_buttons];
2090 if (!NILP (descrip))
2091 wv->key = (char *) SDATA (descrip);
2092 wv->value = (char *) SDATA (item_name);
2093 wv->call_data = (void *) &AREF (menu_items, i);
2094 wv->enabled = !NILP (enable);
2095 wv->help = Qnil;
2096 prev_wv = wv;
2097
2098 if (! boundary_seen)
2099 left_count++;
2100
2101 nb_buttons++;
2102 i += MENU_ITEMS_ITEM_LENGTH;
2103 }
2104
2105 /* If the boundary was not specified,
2106 by default put half on the left and half on the right. */
2107 if (! boundary_seen)
2108 left_count = nb_buttons - nb_buttons / 2;
2109
2110 wv = xmalloc_widget_value ();
2111 wv->name = dialog_name;
2112 wv->help = Qnil;
2113
2114 /* Frame title: 'Q' = Question, 'I' = Information.
2115 Can also have 'E' = Error if, one day, we want
2116 a popup for errors. */
2117 if (NILP(header))
2118 dialog_name[0] = 'Q';
2119 else
2120 dialog_name[0] = 'I';
2121
2122 /* Dialog boxes use a really stupid name encoding
2123 which specifies how many buttons to use
2124 and how many buttons are on the right. */
2125 dialog_name[1] = '0' + nb_buttons;
2126 dialog_name[2] = 'B';
2127 dialog_name[3] = 'R';
2128 /* Number of buttons to put on the right. */
2129 dialog_name[4] = '0' + nb_buttons - left_count;
2130 dialog_name[5] = 0;
2131 wv->contents = first_wv;
2132 first_wv = wv;
2133 }
2134
2135 /* Actually create the dialog. */
2136 dialog_id = widget_id_tick++;
2137 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
2138 f->output_data.w32->widget, 1, 0,
2139 dialog_selection_callback, 0);
2140 lw_modify_all_widgets (dialog_id, first_wv->contents, TRUE);
2141
2142 /* Free the widget_value objects we used to specify the contents. */
2143 free_menubar_widget_value_tree (first_wv);
2144
2145 /* No selection has been chosen yet. */
2146 menu_item_selection = 0;
2147
2148 /* Display the menu. */
2149 lw_pop_up_all_widgets (dialog_id);
2150
2151 /* Process events that apply to the menu. */
2152 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
2153
2154 lw_destroy_all_widgets (dialog_id);
2155
2156 /* Find the selected item, and its pane, to return
2157 the proper value. */
2158 if (menu_item_selection != 0)
2159 {
2160 Lisp_Object prefix;
2161
2162 prefix = Qnil;
2163 i = 0;
2164 while (i < menu_items_used)
2165 {
2166 Lisp_Object entry;
2167
2168 if (EQ (AREF (menu_items, i), Qt))
2169 {
2170 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
2171 i += MENU_ITEMS_PANE_LENGTH;
2172 }
2173 else
2174 {
2175 entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE);
2176 if (menu_item_selection == i)
2177 {
2178 if (keymaps != 0)
2179 {
2180 entry = Fcons (entry, Qnil);
2181 if (!NILP (prefix))
2182 entry = Fcons (prefix, entry);
2183 }
2184 return entry;
2185 }
2186 i += MENU_ITEMS_ITEM_LENGTH;
2187 }
2188 }
2189 }
2190 else
2191 /* Make "Cancel" equivalent to C-g. */
2192 Fsignal (Qquit, Qnil);
2193
2194 return Qnil;
2195 }
2196 #endif /* HAVE_DIALOGS */
2197 \f
2198
2199 /* Is this item a separator? */
2200 static int
2201 name_is_separator (name)
2202 char *name;
2203 {
2204 char *start = name;
2205
2206 /* Check if name string consists of only dashes ('-'). */
2207 while (*name == '-') name++;
2208 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2209 or "--deep-shadow". We don't implement them yet, se we just treat
2210 them like normal separators. */
2211 return (*name == '\0' || start + 2 == name);
2212 }
2213
2214
2215 /* Indicate boundary between left and right. */
2216 static int
2217 add_left_right_boundary (HMENU menu)
2218 {
2219 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2220 }
2221
2222 /* UTF8: 0xxxxxxx, 110xxxxx 10xxxxxx, 1110xxxx, 10xxxxxx, 10xxxxxx */
2223 static void
2224 utf8to16 (unsigned char * src, int len, WCHAR * dest)
2225 {
2226 while (len > 0)
2227 {
2228 int utf16;
2229 if (*src < 0x80)
2230 {
2231 *dest = (WCHAR) *src;
2232 dest++; src++; len--;
2233 }
2234 /* Since we might get >3 byte sequences which we don't handle, ignore the extra parts. */
2235 else if (*src < 0xC0)
2236 {
2237 src++; len--;
2238 }
2239 /* 2 char UTF-8 sequence. */
2240 else if (*src < 0xE0)
2241 {
2242 *dest = (WCHAR) (((*src & 0x1f) << 6)
2243 | (*(src + 1) & 0x3f));
2244 src += 2; len -= 2; dest++;
2245 }
2246 else if (*src < 0xF0)
2247 {
2248 *dest = (WCHAR) (((*src & 0x0f) << 12)
2249 | ((*(src + 1) & 0x3f) << 6)
2250 | (*(src + 2) & 0x3f));
2251 src += 3; len -= 3; dest++;
2252 }
2253 else /* Not encodable. Insert Unicode Substitution char. */
2254 {
2255 *dest = (WCHAR) 0xfffd;
2256 src++; len--; dest++;
2257 }
2258 }
2259 *dest = 0;
2260 }
2261
2262 static int
2263 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2264 {
2265 UINT fuFlags;
2266 char *out_string, *p, *q;
2267 int return_value;
2268 size_t nlen, orig_len;
2269
2270 if (name_is_separator (wv->name))
2271 {
2272 fuFlags = MF_SEPARATOR;
2273 out_string = NULL;
2274 }
2275 else
2276 {
2277 if (wv->enabled)
2278 fuFlags = MF_STRING;
2279 else
2280 fuFlags = MF_STRING | MF_GRAYED;
2281
2282 if (wv->key != NULL)
2283 {
2284 out_string = alloca (strlen (wv->name) + strlen (wv->key) + 2);
2285 strcpy (out_string, wv->name);
2286 strcat (out_string, "\t");
2287 strcat (out_string, wv->key);
2288 }
2289 else
2290 out_string = wv->name;
2291
2292 /* Quote any special characters within the menu item's text and
2293 key binding. */
2294 nlen = orig_len = strlen (out_string);
2295 for (p = out_string; *p; p = _mbsinc (p))
2296 {
2297 if (_mbsnextc (p) == '&')
2298 nlen++;
2299 }
2300 if (nlen > orig_len)
2301 {
2302 p = out_string;
2303 out_string = alloca (nlen + 1);
2304 q = out_string;
2305 while (*p)
2306 {
2307 if (_mbsnextc (p) == '&')
2308 {
2309 _mbsncpy (q, p, 1);
2310 q = _mbsinc (q);
2311 }
2312 _mbsncpy (q, p, 1);
2313 p = _mbsinc (p);
2314 q = _mbsinc (q);
2315 }
2316 *q = '\0';
2317 }
2318
2319 if (item != NULL)
2320 fuFlags = MF_POPUP;
2321 else if (wv->title || wv->call_data == 0)
2322 {
2323 /* Only use MF_OWNERDRAW if GetMenuItemInfo is usable, since
2324 we can't deallocate the memory otherwise. */
2325 if (get_menu_item_info)
2326 {
2327 out_string = (char *) local_alloc (strlen (wv->name) + 1);
2328 strcpy (out_string, wv->name);
2329 #ifdef MENU_DEBUG
2330 DebPrint ("Menu: allocing %ld for owner-draw", out_string);
2331 #endif
2332 fuFlags = MF_OWNERDRAW | MF_DISABLED;
2333 }
2334 else
2335 fuFlags = MF_DISABLED;
2336 }
2337
2338 /* Draw radio buttons and tickboxes. */
2339 else if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2340 wv->button_type == BUTTON_TYPE_RADIO))
2341 fuFlags |= MF_CHECKED;
2342 else
2343 fuFlags |= MF_UNCHECKED;
2344 }
2345
2346 if (unicode_append_menu && out_string)
2347 {
2348 /* Convert out_string from UTF-8 to UTF-16-LE. */
2349 int utf8_len = strlen (out_string);
2350 WCHAR * utf16_string;
2351 if (fuFlags & MF_OWNERDRAW)
2352 utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR));
2353 else
2354 utf16_string = alloca ((utf8_len + 1) * sizeof (WCHAR));
2355
2356 utf8to16 (out_string, utf8_len, utf16_string);
2357 return_value = unicode_append_menu (menu, fuFlags,
2358 item != NULL ? (UINT) item
2359 : (UINT) wv->call_data,
2360 utf16_string);
2361 if (!return_value)
2362 {
2363 /* On W9x/ME, unicode menus are not supported, though AppendMenuW
2364 apparently does exist at least in some cases and appears to be
2365 stubbed out to do nothing. out_string is UTF-8, but since
2366 our standard menus are in English and this is only going to
2367 happen the first time a menu is used, the encoding is
2368 of minor importance compared with menus not working at all. */
2369 return_value =
2370 AppendMenu (menu, fuFlags,
2371 item != NULL ? (UINT) item: (UINT) wv->call_data,
2372 out_string);
2373 /* Don't use unicode menus in future. */
2374 unicode_append_menu = NULL;
2375 }
2376
2377 if (unicode_append_menu && (fuFlags & MF_OWNERDRAW))
2378 local_free (out_string);
2379 }
2380 else
2381 {
2382 return_value =
2383 AppendMenu (menu,
2384 fuFlags,
2385 item != NULL ? (UINT) item : (UINT) wv->call_data,
2386 out_string );
2387 }
2388
2389 /* This must be done after the menu item is created. */
2390 if (!wv->title && wv->call_data != 0)
2391 {
2392 if (set_menu_item_info)
2393 {
2394 MENUITEMINFO info;
2395 bzero (&info, sizeof (info));
2396 info.cbSize = sizeof (info);
2397 info.fMask = MIIM_DATA;
2398
2399 /* Set help string for menu item. Leave it as a Lisp_Object
2400 until it is ready to be displayed, since GC can happen while
2401 menus are active. */
2402 if (!NILP (wv->help))
2403 #ifdef USE_LISP_UNION_TYPE
2404 info.dwItemData = (DWORD) (wv->help).i;
2405 #else
2406 info.dwItemData = (DWORD) (wv->help);
2407 #endif
2408 if (wv->button_type == BUTTON_TYPE_RADIO)
2409 {
2410 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2411 RADIO items, but is not available on NT 3.51 and earlier. */
2412 info.fMask |= MIIM_TYPE | MIIM_STATE;
2413 info.fType = MFT_RADIOCHECK | MFT_STRING;
2414 info.dwTypeData = out_string;
2415 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2416 }
2417
2418 set_menu_item_info (menu,
2419 item != NULL ? (UINT) item : (UINT) wv->call_data,
2420 FALSE, &info);
2421 }
2422 }
2423 return return_value;
2424 }
2425
2426 /* Construct native Windows menu(bar) based on widget_value tree. */
2427 int
2428 fill_in_menu (HMENU menu, widget_value *wv)
2429 {
2430 int items_added = 0;
2431
2432 for ( ; wv != NULL; wv = wv->next)
2433 {
2434 if (wv->contents)
2435 {
2436 HMENU sub_menu = CreatePopupMenu ();
2437
2438 if (sub_menu == NULL)
2439 return 0;
2440
2441 if (!fill_in_menu (sub_menu, wv->contents) ||
2442 !add_menu_item (menu, wv, sub_menu))
2443 {
2444 DestroyMenu (sub_menu);
2445 return 0;
2446 }
2447 }
2448 else
2449 {
2450 if (!add_menu_item (menu, wv, NULL))
2451 return 0;
2452 }
2453 }
2454 return 1;
2455 }
2456
2457 /* Display help string for currently pointed to menu item. Not
2458 supported on NT 3.51 and earlier, as GetMenuItemInfo is not
2459 available. */
2460 void
2461 w32_menu_display_help (HWND owner, HMENU menu, UINT item, UINT flags)
2462 {
2463 if (get_menu_item_info)
2464 {
2465 struct frame *f = x_window_to_frame (&one_w32_display_info, owner);
2466 Lisp_Object frame, help;
2467
2468 /* No help echo on owner-draw menu items, or when the keyboard is used
2469 to navigate the menus, since tooltips are distracting if they pop
2470 up elsewhere. */
2471 if (flags & MF_OWNERDRAW || flags & MF_POPUP
2472 || !(flags & MF_MOUSESELECT))
2473 help = Qnil;
2474 else
2475 {
2476 MENUITEMINFO info;
2477
2478 bzero (&info, sizeof (info));
2479 info.cbSize = sizeof (info);
2480 info.fMask = MIIM_DATA;
2481 get_menu_item_info (menu, item, FALSE, &info);
2482
2483 #ifdef USE_LISP_UNION_TYPE
2484 help = info.dwItemData ? (Lisp_Object) ((EMACS_INT) info.dwItemData)
2485 : Qnil;
2486 #else
2487 help = info.dwItemData ? (Lisp_Object) info.dwItemData : Qnil;
2488 #endif
2489 }
2490
2491 /* Store the help echo in the keyboard buffer as the X toolkit
2492 version does, rather than directly showing it. This seems to
2493 solve the GC problems that were present when we based the
2494 Windows code on the non-toolkit version. */
2495 if (f)
2496 {
2497 XSETFRAME (frame, f);
2498 kbd_buffer_store_help_event (frame, help);
2499 }
2500 else
2501 /* X version has a loop through frames here, which doesn't
2502 appear to do anything, unless it has some side effect. */
2503 show_help_echo (help, Qnil, Qnil, Qnil, 1);
2504 }
2505 }
2506
2507 /* Free memory used by owner-drawn strings. */
2508 static void
2509 w32_free_submenu_strings (menu)
2510 HMENU menu;
2511 {
2512 int i, num = GetMenuItemCount (menu);
2513 for (i = 0; i < num; i++)
2514 {
2515 MENUITEMINFO info;
2516 bzero (&info, sizeof (info));
2517 info.cbSize = sizeof (info);
2518 info.fMask = MIIM_DATA | MIIM_TYPE | MIIM_SUBMENU;
2519
2520 get_menu_item_info (menu, i, TRUE, &info);
2521
2522 /* Owner-drawn names are held in dwItemData. */
2523 if ((info.fType & MF_OWNERDRAW) && info.dwItemData)
2524 {
2525 #ifdef MENU_DEBUG
2526 DebPrint ("Menu: freeing %ld for owner-draw", info.dwItemData);
2527 #endif
2528 local_free (info.dwItemData);
2529 }
2530
2531 /* Recurse down submenus. */
2532 if (info.hSubMenu)
2533 w32_free_submenu_strings (info.hSubMenu);
2534 }
2535 }
2536
2537 void
2538 w32_free_menu_strings (hwnd)
2539 HWND hwnd;
2540 {
2541 HMENU menu = current_popup_menu;
2542
2543 if (get_menu_item_info)
2544 {
2545 /* If there is no popup menu active, free the strings from the frame's
2546 menubar. */
2547 if (!menu)
2548 menu = GetMenu (hwnd);
2549
2550 if (menu)
2551 w32_free_submenu_strings (menu);
2552 }
2553
2554 current_popup_menu = NULL;
2555 }
2556
2557 #endif /* HAVE_MENUS */
2558
2559 /* The following is used by delayed window autoselection. */
2560
2561 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2562 doc: /* Return t if a menu or popup dialog is active on selected frame. */)
2563 ()
2564 {
2565 #ifdef HAVE_MENUS
2566 FRAME_PTR f;
2567 f = SELECTED_FRAME ();
2568 return (f->output_data.w32->menubar_active > 0) ? Qt : Qnil;
2569 #else
2570 return Qnil;
2571 #endif /* HAVE_MENUS */
2572 }
2573
2574 void syms_of_w32menu ()
2575 {
2576 globals_of_w32menu ();
2577 staticpro (&menu_items);
2578 menu_items = Qnil;
2579
2580 current_popup_menu = NULL;
2581
2582 DEFSYM (Qdebug_on_next_call, "debug-on-next-call");
2583
2584 defsubr (&Sx_popup_menu);
2585 defsubr (&Smenu_or_popup_active_p);
2586 #ifdef HAVE_MENUS
2587 defsubr (&Sx_popup_dialog);
2588 #endif
2589 }
2590
2591 /*
2592 globals_of_w32menu is used to initialize those global variables that
2593 must always be initialized on startup even when the global variable
2594 initialized is non zero (see the function main in emacs.c).
2595 globals_of_w32menu is called from syms_of_w32menu when the global
2596 variable initialized is 0 and directly from main when initialized
2597 is non zero.
2598 */
2599 void globals_of_w32menu ()
2600 {
2601 /* See if Get/SetMenuItemInfo functions are available. */
2602 HMODULE user32 = GetModuleHandle ("user32.dll");
2603 get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA");
2604 set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA");
2605 unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW");
2606 }
2607
2608 /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0
2609 (do not change this comment) */