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