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