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