.
[emacs.git] / src / w32menu.c
blobaa3ef60d12b7b8e330e90f66c6ff60b577d7acff
1 /* Menu support for GNU Emacs on the Microsoft W32 API.
2 Copyright (C) 1986, 1988, 1993, 1994, 1996, 1998 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 <signal.h>
22 #include <config.h>
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"
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"
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
43 #include "dispextern.h"
45 /******************************************************************/
46 /* Definitions copied from lwlib.h */
48 typedef void * XtPointer;
49 typedef char Boolean;
51 #define True 1
52 #define False 0
54 typedef enum _change_type
56 NO_CHANGE = 0,
57 INVISIBLE_CHANGE = 1,
58 VISIBLE_CHANGE = 2,
59 STRUCTURAL_CHANGE = 3
60 } change_type;
62 typedef struct _widget_value
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;
98 /* we resource the widget_value structures; this points to the next
99 one on the free list if this one has been deallocated.
101 struct _widget_value *free_list;
102 #endif
103 } widget_value;
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)
109 /******************************************************************/
111 #define min(x,y) (((x) < (y)) ? (x) : (y))
112 #define max(x,y) (((x) > (y)) ? (x) : (y))
114 #ifndef TRUE
115 #define TRUE 1
116 #define FALSE 0
117 #endif /* no TRUE */
119 Lisp_Object Vmenu_updating_frame;
121 Lisp_Object Qdebug_on_next_call;
123 extern Lisp_Object Qmenu_bar;
124 extern Lisp_Object Qmouse_click, Qevent_kind;
126 extern Lisp_Object QCtoggle, QCradio;
128 extern Lisp_Object Voverriding_local_map;
129 extern Lisp_Object Voverriding_local_map_menu_flag;
131 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
133 extern Lisp_Object Qmenu_bar_update_hook;
135 void set_frame_menubar ();
137 static Lisp_Object w32_menu_show ();
138 static Lisp_Object w32_dialog_show ();
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 ();
146 /* This holds a Lisp vector that holds the results of decoding
147 the keymaps or alist-of-alists that specify a menu.
149 It describes the panes and items within the panes.
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.
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.
162 A single vector slot containing quote indicates that the
163 following items should appear on the right of a dialog box.
165 Using a Lisp vector to hold this information while we decode it
166 takes care of protecting all the data from GC. */
168 #define MENU_ITEMS_PANE_NAME 1
169 #define MENU_ITEMS_PANE_PREFIX 2
170 #define MENU_ITEMS_PANE_LENGTH 3
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
179 static Lisp_Object menu_items;
181 /* Number of slots currently allocated in menu_items. */
182 static int menu_items_allocated;
184 /* This is the index in menu_items of the first empty slot. */
185 static int menu_items_used;
187 /* The number of panes currently recorded in menu_items,
188 excluding those within submenus. */
189 static int menu_items_n_panes;
191 /* Current depth within submenus. */
192 static int menu_items_submenu_depth;
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;
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.
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>. */
205 int pending_menu_activation;
208 /* Return the frame whose ->output_data.w32->menubar_widget equals
209 MENU, or 0 if none. */
211 static struct frame *
212 menubar_id_to_frame (HMENU menu)
214 Lisp_Object tail, frame;
215 FRAME_PTR f;
217 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
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;
228 return 0;
231 /* Initialize the menu_items structure if we haven't already done so.
232 Also mark it as currently empty. */
234 static void
235 init_menu_items ()
237 if (NILP (menu_items))
239 menu_items_allocated = 60;
240 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
243 menu_items_used = 0;
244 menu_items_n_panes = 0;
245 menu_items_submenu_depth = 0;
248 /* Call at the end of generating the data in menu_items.
249 This fills in the number of items in the last pane. */
251 static void
252 finish_menu_items ()
256 /* Call when finished using the data for the current menu
257 in menu_items. */
259 static void
260 discard_menu_items ()
262 /* Free the structure if it is especially large.
263 Otherwise, hold on to it, to save time. */
264 if (menu_items_allocated > 200)
266 menu_items = Qnil;
267 menu_items_allocated = 0;
271 /* Make the menu_items vector twice as large. */
273 static void
274 grow_menu_items ()
276 Lisp_Object old;
277 int old_size = menu_items_allocated;
278 old = menu_items;
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));
286 /* Begin a submenu. */
288 static void
289 push_submenu_start ()
291 if (menu_items_used + 1 > menu_items_allocated)
292 grow_menu_items ();
294 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
295 menu_items_submenu_depth++;
298 /* End a submenu. */
300 static void
301 push_submenu_end ()
303 if (menu_items_used + 1 > menu_items_allocated)
304 grow_menu_items ();
306 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
307 menu_items_submenu_depth--;
310 /* Indicate boundary between left and right. */
312 static void
313 push_left_right_boundary ()
315 if (menu_items_used + 1 > menu_items_allocated)
316 grow_menu_items ();
318 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
321 /* Start a new menu pane in menu_items..
322 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
324 static void
325 push_menu_pane (name, prefix_vec)
326 Lisp_Object name, prefix_vec;
328 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
329 grow_menu_items ();
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;
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). */
346 static void
347 push_menu_item (name, enable, key, def, equiv)
348 Lisp_Object name, enable, key, def, equiv;
350 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
351 grow_menu_items ();
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;
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. */
365 static void
366 keymap_panes (keymaps, nmaps, notreal)
367 Lisp_Object *keymaps;
368 int nmaps;
369 int notreal;
371 int mapno;
373 init_menu_items ();
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);
381 finish_menu_items ();
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.
391 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
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;
401 Lisp_Object pending_maps = Qnil;
402 Lisp_Object tail, item;
403 struct gcpro gcpro1, gcpro2;
404 int notbuttons = 0;
406 if (maxdepth <= 0)
407 return;
409 push_menu_pane (pane_name, prefix);
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
419 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
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))
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++)
435 Lisp_Object character;
436 XSETFASTINT (character, c);
437 single_menu_item (character, XVECTOR (item)->contents[c],
438 &pending_maps, notreal, maxdepth, &notbuttons);
441 UNGCPRO;
444 /* Process now any submenus which want to be panes at this level. */
445 while (!NILP (pending_maps))
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);
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. */
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;
479 Lisp_Object def, map, item_string, enabled;
480 struct gcpro gcpro1, gcpro2;
481 int res;
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. */
490 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
492 if (notreal)
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;
501 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
502 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
504 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
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;
513 #ifndef HAVE_BOXES
514 /* Simulate radio buttons and toggle boxes by putting a prefix in
515 front of them. */
517 Lisp_Object prefix = Qnil;
518 Lisp_Object type = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE];
519 if (!NILP (type))
521 Lisp_Object selected
522 = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED];
524 if (*notbuttons_ptr)
525 /* The first button. Line up previous items in this menu. */
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)
533 = XVECTOR (menu_items)->contents[index + MENU_ITEMS_ITEM_NAME];
534 if (NILP (tem))
536 index++;
537 submenu++; /* Skip sub menu. */
539 else if (EQ (tem, Qlambda))
541 index++;
542 submenu--; /* End sub menu. */
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
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;
557 *notbuttons_ptr = 0;
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) ? "( ) " : "(*) ");
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 (" ");
571 if (!NILP (prefix))
572 item_string = concat2 (prefix, item_string);
574 #endif /* not HAVE_BOXES */
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
582 push_menu_item (item_string, enabled, key,
583 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
584 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]);
586 #if 1
587 /* Display a submenu using the toolkit. */
588 if (! (NILP (map) || NILP (enabled)))
590 push_submenu_start ();
591 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
592 push_submenu_end ();
594 #endif
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. */
601 static void
602 list_of_panes (menu)
603 Lisp_Object menu;
605 Lisp_Object tail;
607 init_menu_items ();
609 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
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);
621 finish_menu_items ();
624 /* Push the items in a single pane defined by the alist PANE. */
626 static void
627 list_of_items (pane)
628 Lisp_Object pane;
630 Lisp_Object tail, item, item1;
632 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
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
641 CHECK_CONS (item, 0);
642 item1 = Fcar (item);
643 CHECK_STRING (item1, 1);
644 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil);
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\
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\
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\
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\
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;
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;
698 #ifdef HAVE_MENUS
699 if (! NILP (position))
701 check_w32 ();
703 /* Decode the first argument: find the window and the coordinates. */
704 if (EQ (position, Qt)
705 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
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;
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
720 window = selected_window;
721 XSETFASTINT (x, 0);
722 XSETFASTINT (y, 0);
725 else
727 tem = Fcar (position);
728 if (CONSP (tem))
730 window = Fcar (Fcdr (position));
731 x = Fcar (tem);
732 y = Fcar (Fcdr (tem));
734 else
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);
745 CHECK_NUMBER (x, 0);
746 CHECK_NUMBER (y, 0);
748 /* Decode where to put the menu. */
750 if (FRAMEP (window))
752 f = XFRAME (window);
753 xpos = 0;
754 ypos = 0;
756 else if (WINDOWP (window))
758 CHECK_LIVE_WINDOW (window, 0);
759 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
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));
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);
771 xpos += XINT (x);
772 ypos += XINT (y);
774 XSETFRAME (Vmenu_updating_frame, f);
776 Vmenu_updating_frame = Qnil;
777 #endif /* HAVE_MENUS */
779 title = Qnil;
780 GCPRO1 (title);
782 /* Decode the menu items from what was specified. */
784 keymap = Fkeymapp (menu);
785 tem = Qnil;
786 if (CONSP (menu))
787 tem = Fkeymapp (Fcar (menu));
788 if (!NILP (keymap))
790 /* We were given a keymap. Extract menu info from the keymap. */
791 Lisp_Object prompt;
792 keymap = get_keymap (menu);
794 /* Extract the detailed info to make one pane. */
795 keymap_panes (&menu, 1, NILP (position));
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;
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;
807 keymaps = 1;
809 else if (!NILP (tem))
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;
817 title = Qnil;
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))
823 Lisp_Object prompt;
825 maps[i++] = keymap = get_keymap (Fcar (tem));
827 prompt = map_prompt (keymap);
828 if (NILP (title) && !NILP (prompt))
829 title = prompt;
832 /* Extract the detailed info to make one pane. */
833 keymap_panes (maps, nmaps, NILP (position));
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;
839 keymaps = 1;
841 else
843 /* We were given an old-fashioned menu. */
844 title = Fcar (menu);
845 CHECK_STRING (title, 1);
847 list_of_panes (Fcdr (menu));
849 keymaps = 0;
852 if (NILP (position))
854 discard_menu_items ();
855 UNGCPRO;
856 return Qnil;
859 #ifdef HAVE_MENUS
860 /* Display them in a menu. */
861 BLOCK_INPUT;
863 selection = w32_menu_show (f, xpos, ypos, for_click,
864 keymaps, title, &error_name);
865 UNBLOCK_INPUT;
867 discard_menu_items ();
869 UNGCPRO;
870 #endif /* HAVE_MENUS */
872 if (error_name) error (error_name);
873 return selection;
876 #ifdef HAVE_MENUS
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\
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;
896 FRAME_PTR f;
897 Lisp_Object window;
899 check_w32 ();
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)))
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;
913 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
915 if (new_f != 0)
916 XSETFRAME (window, new_f);
917 else
918 window = selected_window;
919 #endif
920 window = selected_window;
922 else if (CONSP (position))
924 Lisp_Object tem;
925 tem = Fcar (position);
926 if (CONSP (tem))
927 window = Fcar (Fcdr (position));
928 else
930 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
931 window = Fcar (tem); /* POSN_WINDOW (tem) */
934 else if (WINDOWP (position) || FRAMEP (position))
935 window = position;
936 else
937 window = Qnil;
939 /* Decode where to put the menu. */
941 if (FRAMEP (window))
942 f = XFRAME (window);
943 else if (WINDOWP (window))
945 CHECK_LIVE_WINDOW (window, 0);
946 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
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);
953 #if 1
954 /* Display a menu with these alternatives
955 in the middle of frame F. */
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));
963 return Fx_popup_menu (newpos,
964 Fcons (Fcar (contents), Fcons (contents, Qnil)));
966 #else
968 Lisp_Object title;
969 char *error_name;
970 Lisp_Object selection;
972 /* Decode the dialog items from what was specified. */
973 title = Fcar (contents);
974 CHECK_STRING (title, 1);
976 list_of_panes (Fcons (contents, Qnil));
978 /* Display them in a dialog box. */
979 BLOCK_INPUT;
980 selection = w32_dialog_show (f, 0, title, &error_name);
981 UNBLOCK_INPUT;
983 discard_menu_items ();
985 if (error_name) error (error_name);
986 return selection;
988 #endif
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.
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.
999 But first we recompute the menu bar contents (the whole tree).
1001 This way we can safely execute Lisp code. */
1003 x_activate_menubar (f)
1004 FRAME_PTR f;
1006 set_frame_menubar (f, 0, 1);
1008 /* Lock out further menubar changes while active. */
1009 f->output_data.w32->menubar_active = 1;
1011 /* Signal input thread to return from WM_INITMENU. */
1012 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
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. */
1020 void
1021 menubar_selection_callback (FRAME_PTR f, void * client_data)
1023 Lisp_Object prefix, entry;
1024 Lisp_Object vector;
1025 Lisp_Object *subprefix_stack;
1026 int submenu_depth = 0;
1027 int i;
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)
1037 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1039 subprefix_stack[submenu_depth++] = prefix;
1040 prefix = entry;
1041 i++;
1043 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1045 prefix = subprefix_stack[--submenu_depth];
1046 i++;
1048 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1050 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1051 i += MENU_ITEMS_PANE_LENGTH;
1053 else
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)
1060 int j;
1061 struct input_event buf;
1062 Lisp_Object frame;
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);
1069 for (j = 0; j < submenu_depth; j++)
1070 if (!NILP (subprefix_stack[j]))
1072 buf.kind = menu_bar_event;
1073 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1074 kbd_buffer_store_event (&buf);
1077 if (!NILP (prefix))
1079 buf.kind = menu_bar_event;
1080 buf.frame_or_window = Fcons (frame, prefix);
1081 kbd_buffer_store_event (&buf);
1084 buf.kind = menu_bar_event;
1085 buf.frame_or_window = Fcons (frame, entry);
1086 kbd_buffer_store_event (&buf);
1088 return;
1090 i += MENU_ITEMS_ITEM_LENGTH;
1095 /* Allocate a widget_value, blocking input. */
1097 widget_value *
1098 xmalloc_widget_value ()
1100 widget_value *value;
1102 BLOCK_INPUT;
1103 value = malloc_widget_value ();
1104 UNBLOCK_INPUT;
1106 return value;
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. */
1114 void
1115 free_menubar_widget_value_tree (wv)
1116 widget_value *wv;
1118 if (! wv) return;
1120 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1122 if (wv->contents && (wv->contents != (widget_value*)1))
1124 free_menubar_widget_value_tree (wv->contents);
1125 wv->contents = (widget_value *) 0xDEADBEEF;
1127 if (wv->next)
1129 free_menubar_widget_value_tree (wv->next);
1130 wv->next = (widget_value *) 0xDEADBEEF;
1132 BLOCK_INPUT;
1133 free_widget_value (wv);
1134 UNBLOCK_INPUT;
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. */
1141 static widget_value *
1142 single_submenu (item_key, item_name, maps)
1143 Lisp_Object item_key, item_name, maps;
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;
1156 length = Flength (maps);
1157 len = XINT (length);
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++)
1163 mapvec[i] = Fcar (maps);
1164 maps = Fcdr (maps);
1167 menu_items_n_panes = 0;
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++)
1173 if (SYMBOLP (mapvec[i])
1174 || (CONSP (mapvec[i])
1175 && NILP (Fkeymapp (mapvec[i]))))
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);
1183 else
1184 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1187 /* Create a tree of widget_value objects
1188 representing the panes and their items. */
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;
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)
1207 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1209 submenu_stack[submenu_depth++] = save_wv;
1210 save_wv = prev_wv;
1211 prev_wv = 0;
1212 i++;
1214 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1216 prev_wv = save_wv;
1217 save_wv = submenu_stack[--submenu_depth];
1218 i++;
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))
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 = "";
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, ""))
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;
1259 save_wv = wv;
1260 prev_wv = 0;
1261 i += MENU_ITEMS_PANE_LENGTH;
1263 else
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];
1273 wv = xmalloc_widget_value ();
1274 if (prev_wv)
1275 prev_wv->next = wv;
1276 else
1277 save_wv->contents = wv;
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;
1289 i += MENU_ITEMS_ITEM_LENGTH;
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)
1297 wv = first_wv->contents;
1298 free_widget_value (first_wv);
1299 return wv;
1302 return first_wv;
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. */
1309 void
1310 set_frame_menubar (f, first_time, deep_p)
1311 FRAME_PTR f;
1312 int first_time;
1313 int deep_p;
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;
1320 /* We must not change the menubar when actually in use. */
1321 if (f->output_data.w32->menubar_active)
1322 return;
1324 XSETFRAME (Vmenu_updating_frame, f);
1326 if (! menubar_widget)
1327 deep_p = 1;
1328 else if (pending_menu_activation && !deep_p)
1329 deep_p = 1;
1331 wv = xmalloc_widget_value ();
1332 wv->name = "menubar";
1333 wv->value = 0;
1334 wv->enabled = 1;
1335 first_wv = wv;
1337 if (deep_p)
1339 /* Make a widget-value tree representing the entire menu trees. */
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));
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;
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);
1360 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1361 if (NILP (Voverriding_local_map_menu_flag))
1363 specbind (Qoverriding_terminal_local_map, Qnil);
1364 specbind (Qoverriding_local_map, Qnil);
1367 set_buffer_internal_1 (XBUFFER (buffer));
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));
1378 items = FRAME_MENU_BAR_ITEMS (f);
1380 inhibit_garbage_collection ();
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));
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)
1392 Lisp_Object key, string, maps;
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;
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;
1410 finish_menu_items ();
1412 set_buffer_internal_1 (prev);
1413 unbind_to (specpdl_count, Qnil);
1415 /* If there has been no change in the Lisp-level contents
1416 of the menu bar, skip redisplaying it. Just exit. */
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)
1424 free_menubar_widget_value_tree (first_wv);
1425 menu_items = Qnil;
1427 return;
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)
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;
1443 f->menu_bar_vector = menu_items;
1444 f->menu_bar_items_used = menu_items_used;
1445 menu_items = Qnil;
1447 else
1449 /* Make a widget-value tree containing
1450 just the top level menu bar strings.
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.
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. */
1462 items = FRAME_MENU_BAR_ITEMS (f);
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;
1474 for (i = 0; i < XVECTOR (items)->size; i += 4)
1476 Lisp_Object string;
1478 string = XVECTOR (items)->contents[i + 1];
1479 if (NILP (string))
1480 break;
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);
1492 if (prev_wv)
1493 prev_wv->next = wv;
1494 else
1495 first_wv->contents = wv;
1496 prev_wv = wv;
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;
1511 /* Create or update the menu bar widget. */
1513 BLOCK_INPUT;
1515 if (menubar_widget)
1517 /* Empty current menubar, rather than creating a fresh one. */
1518 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1521 else
1523 menubar_widget = CreateMenu ();
1525 fill_in_menu (menubar_widget, first_wv->contents);
1527 free_menubar_widget_value_tree (first_wv);
1530 HMENU old_widget = f->output_data.w32->menubar_widget;
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)); */
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));
1543 UNBLOCK_INPUT;
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. */
1551 void
1552 initialize_frame_menubar (f)
1553 FRAME_PTR f;
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);
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. */
1564 void
1565 free_frame_menubar (f)
1566 FRAME_PTR f;
1568 BLOCK_INPUT;
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);
1577 UNBLOCK_INPUT;
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. */
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.) */
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;
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;
1617 int first_pane;
1618 int next_release_must_exit = 0;
1620 *error = NULL;
1622 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1624 *error = "Empty menu";
1625 return Qnil;
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;
1637 /* Loop over all panes and items, filling in the tree. */
1638 i = 0;
1639 while (i < menu_items_used)
1641 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1643 submenu_stack[submenu_depth++] = save_wv;
1644 save_wv = prev_wv;
1645 prev_wv = 0;
1646 first_pane = 1;
1647 i++;
1649 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1651 prev_wv = save_wv;
1652 save_wv = submenu_stack[--submenu_depth];
1653 first_pane = 0;
1654 i++;
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))
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 = "";
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, ""))
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;
1695 else if (first_pane)
1697 save_wv = wv;
1698 prev_wv = 0;
1700 first_pane = 0;
1701 i += MENU_ITEMS_PANE_LENGTH;
1703 else
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];
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;
1728 i += MENU_ITEMS_ITEM_LENGTH;
1732 /* Deal with the title, if it is non-nil. */
1733 if (!NILP (title))
1735 widget_value *wv_title = xmalloc_widget_value ();
1736 widget_value *wv_sep = xmalloc_widget_value ();
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;
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;
1750 /* Actually create the menu. */
1751 menu = CreatePopupMenu ();
1752 fill_in_menu (menu, first_wv->contents);
1754 /* Adjust coordinates to be root-window-relative. */
1755 pos.x = x;
1756 pos.y = y;
1757 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1759 /* Free the widget_value objects we used to specify the contents. */
1760 free_menubar_widget_value_tree (first_wv);
1762 /* No selection has been chosen yet. */
1763 menu_item_selection = 0;
1765 /* Display the menu. */
1766 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1767 WM_EMACS_TRACKPOPUPMENU,
1768 (WPARAM)menu, (LPARAM)&pos);
1770 /* Clean up extraneous mouse events which might have been generated
1771 during the call. */
1772 discard_mouse_events ();
1774 DestroyMenu (menu);
1776 /* Find the selected item, and its pane, to return
1777 the proper value. */
1778 if (menu_item_selection != 0)
1780 Lisp_Object prefix, entry;
1782 prefix = Qnil;
1783 i = 0;
1784 while (i < menu_items_used)
1786 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1788 subprefix_stack[submenu_depth++] = prefix;
1789 prefix = entry;
1790 i++;
1792 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1794 prefix = subprefix_stack[--submenu_depth];
1795 i++;
1797 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1799 prefix
1800 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1801 i += MENU_ITEMS_PANE_LENGTH;
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
1809 entry
1810 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1811 if (menu_item_selection == i)
1813 if (keymaps != 0)
1815 int j;
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);
1824 return entry;
1826 i += MENU_ITEMS_ITEM_LENGTH;
1831 return Qnil;
1835 static char * button_names [] = {
1836 "button1", "button2", "button3", "button4", "button5",
1837 "button6", "button7", "button8", "button9", "button10" };
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;
1846 int i, nb_buttons=0;
1847 char dialog_name[6];
1848 int menu_item_selection;
1850 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
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;
1857 *error = NULL;
1859 if (menu_items_n_panes > 1)
1861 *error = "Multiple panes in dialog box";
1862 return Qnil;
1865 /* Create a tree of widget_value objects
1866 representing the text label and buttons. */
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;
1882 /* Loop over all panes and items, filling in the tree. */
1883 i = MENU_ITEMS_PANE_LENGTH;
1884 while (i < menu_items_used)
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];
1894 if (NILP (item_name))
1896 free_menubar_widget_value_tree (first_wv);
1897 *error = "Submenu in dialog items";
1898 return Qnil;
1900 if (EQ (item_name, Qquote))
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;
1908 if (nb_buttons >= 9)
1910 free_menubar_widget_value_tree (first_wv);
1911 *error = "Too many dialog items";
1912 return Qnil;
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;
1925 if (! boundary_seen)
1926 left_count++;
1928 nb_buttons++;
1929 i += MENU_ITEMS_ITEM_LENGTH;
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;
1937 wv = xmalloc_widget_value ();
1938 wv->name = dialog_name;
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;
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
1964 /* Free the widget_value objects we used to specify the contents. */
1965 free_menubar_widget_value_tree (first_wv);
1967 /* No selection has been chosen yet. */
1968 menu_item_selection = 0;
1970 /* Display the menu. */
1971 #if 0
1972 lw_pop_up_all_widgets (dialog_id);
1973 popup_activated_flag = 1;
1975 /* Process events that apply to the menu. */
1976 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1978 lw_destroy_all_widgets (dialog_id);
1979 #endif
1981 /* Find the selected item, and its pane, to return
1982 the proper value. */
1983 if (menu_item_selection != 0)
1985 Lisp_Object prefix;
1987 prefix = Qnil;
1988 i = 0;
1989 while (i < menu_items_used)
1991 Lisp_Object entry;
1993 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1995 prefix
1996 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1997 i += MENU_ITEMS_PANE_LENGTH;
1999 else
2001 entry
2002 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2003 if (menu_item_selection == i)
2005 if (keymaps != 0)
2007 entry = Fcons (entry, Qnil);
2008 if (!NILP (prefix))
2009 entry = Fcons (prefix, entry);
2011 return entry;
2013 i += MENU_ITEMS_ITEM_LENGTH;
2018 return Qnil;
2022 /* Is this item a separator? */
2023 static int
2024 name_is_separator (name)
2025 char *name;
2027 /* Check if name string consists of only dashes ('-') */
2028 while (*name == '-') name++;
2029 return (*name == '\0');
2033 /* Indicate boundary between left and right. */
2034 static int
2035 add_left_right_boundary (HMENU menu)
2037 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2040 static int
2041 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2043 UINT fuFlags;
2044 char *out_string;
2046 if (name_is_separator (wv->name))
2047 fuFlags = MF_SEPARATOR;
2048 else
2050 if (wv->enabled)
2051 fuFlags = MF_STRING;
2052 else
2053 fuFlags = MF_STRING | MF_GRAYED;
2055 if (wv->key != NULL)
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);
2062 else
2063 out_string = wv->name;
2065 if (wv->title || wv->call_data == 0)
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;
2075 if (item != NULL)
2076 fuFlags = MF_POPUP;
2078 return AppendMenu (menu,
2079 fuFlags,
2080 item != NULL ? (UINT) item : (UINT) wv->call_data,
2081 (fuFlags == MF_SEPARATOR) ? NULL: out_string );
2084 /* Construct native Windows menu(bar) based on widget_value tree. */
2085 static int
2086 fill_in_menu (HMENU menu, widget_value *wv)
2088 int items_added = 0;
2090 for ( ; wv != NULL; wv = wv->next)
2092 if (wv->contents)
2094 HMENU sub_menu = CreatePopupMenu ();
2096 if (sub_menu == NULL)
2097 return 0;
2099 if (!fill_in_menu (sub_menu, wv->contents) ||
2100 !add_menu_item (menu, wv, sub_menu))
2102 DestroyMenu (sub_menu);
2103 return 0;
2106 else
2108 if (!add_menu_item (menu, wv, NULL))
2109 return 0;
2112 return 1;
2115 #endif /* HAVE_MENUS */
2117 syms_of_w32menu ()
2119 staticpro (&menu_items);
2120 menu_items = Qnil;
2122 Qdebug_on_next_call = intern ("debug-on-next-call");
2123 staticpro (&Qdebug_on_next_call);
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;
2130 defsubr (&Sx_popup_menu);
2131 #ifdef HAVE_MENUS
2132 defsubr (&Sx_popup_dialog);
2133 #endif