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