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