Don't set C_OPTIMIZE_SWITCH.
[emacs.git] / src / w32menu.c
blob73a2af6a5e466e970376d6e7d065562586454fee
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>
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 #undef HAVE_MULTILINGUAL_MENU
46 #undef HAVE_DIALOGS /* NTEMACS_TODO: Implement native dialogs. */
48 /******************************************************************/
49 /* Definitions copied from lwlib.h */
51 typedef void * XtPointer;
52 typedef char Boolean;
54 #define True 1
55 #define False 0
57 #if 0 /* Not used below. */
58 typedef enum _change_type
60 NO_CHANGE = 0,
61 INVISIBLE_CHANGE = 1,
62 VISIBLE_CHANGE = 2,
63 STRUCTURAL_CHANGE = 3
64 } change_type;
65 #endif
67 enum button_type
69 BUTTON_TYPE_NONE,
70 BUTTON_TYPE_TOGGLE,
71 BUTTON_TYPE_RADIO
74 typedef struct _widget_value
76 /* name of widget */
77 char* name;
78 /* value (meaning depend on widget type) */
79 char* value;
80 /* keyboard equivalent. no implications for XtTranslations */
81 char* key;
82 /* Help string or null if none. */
83 char *help;
84 /* true if enabled */
85 Boolean enabled;
86 /* true if selected */
87 Boolean selected;
88 /* The type of a button. */
89 enum button_type button_type;
90 /* true if menu title */
91 Boolean title;
92 #if 0
93 /* true if was edited (maintained by get_value) */
94 Boolean edited;
95 /* true if has changed (maintained by lw library) */
96 change_type change;
97 /* true if this widget itself has changed,
98 but not counting the other widgets found in the `next' field. */
99 change_type this_one_change;
100 #endif
101 /* Contents of the sub-widgets, also selected slot for checkbox */
102 struct _widget_value* contents;
103 /* data passed to callback */
104 XtPointer call_data;
105 /* next one in the list */
106 struct _widget_value* next;
107 #if 0
108 /* slot for the toolkit dependent part. Always initialize to NULL. */
109 void* toolkit_data;
110 /* tell us if we should free the toolkit data slot when freeing the
111 widget_value itself. */
112 Boolean free_toolkit_data;
114 /* we resource the widget_value structures; this points to the next
115 one on the free list if this one has been deallocated.
117 struct _widget_value *free_list;
118 #endif
119 } widget_value;
121 /* LocalAlloc/Free is a reasonably good allocator. */
122 #define malloc_widget_value() (void*)LocalAlloc (LMEM_ZEROINIT, sizeof (widget_value))
123 #define free_widget_value(wv) LocalFree (wv)
125 /******************************************************************/
127 #define min(x,y) (((x) < (y)) ? (x) : (y))
128 #define max(x,y) (((x) > (y)) ? (x) : (y))
130 #ifndef TRUE
131 #define TRUE 1
132 #define FALSE 0
133 #endif /* no TRUE */
135 Lisp_Object Vmenu_updating_frame;
137 Lisp_Object Qdebug_on_next_call;
139 extern Lisp_Object Qmenu_bar;
140 extern Lisp_Object Qmouse_click, Qevent_kind;
142 extern Lisp_Object QCtoggle, QCradio;
144 extern Lisp_Object Voverriding_local_map;
145 extern Lisp_Object Voverriding_local_map_menu_flag;
147 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
149 extern Lisp_Object Qmenu_bar_update_hook;
151 void set_frame_menubar ();
153 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
154 Lisp_Object, Lisp_Object, Lisp_Object,
155 Lisp_Object, Lisp_Object));
156 static Lisp_Object w32_dialog_show ();
157 static Lisp_Object w32_menu_show ();
159 static void keymap_panes ();
160 static void single_keymap_panes ();
161 static void single_menu_item ();
162 static void list_of_panes ();
163 static void list_of_items ();
165 /* This holds a Lisp vector that holds the results of decoding
166 the keymaps or alist-of-alists that specify a menu.
168 It describes the panes and items within the panes.
170 Each pane is described by 3 elements in the vector:
171 t, the pane name, the pane's prefix key.
172 Then follow the pane's items, with 5 elements per item:
173 the item string, the enable flag, the item's value,
174 the definition, and the equivalent keyboard key's description string.
176 In some cases, multiple levels of menus may be described.
177 A single vector slot containing nil indicates the start of a submenu.
178 A single vector slot containing lambda indicates the end of a submenu.
179 The submenu follows a menu item which is the way to reach the submenu.
181 A single vector slot containing quote indicates that the
182 following items should appear on the right of a dialog box.
184 Using a Lisp vector to hold this information while we decode it
185 takes care of protecting all the data from GC. */
187 #define MENU_ITEMS_PANE_NAME 1
188 #define MENU_ITEMS_PANE_PREFIX 2
189 #define MENU_ITEMS_PANE_LENGTH 3
191 enum menu_item_idx
193 MENU_ITEMS_ITEM_NAME = 0,
194 MENU_ITEMS_ITEM_ENABLE,
195 MENU_ITEMS_ITEM_VALUE,
196 MENU_ITEMS_ITEM_EQUIV_KEY,
197 MENU_ITEMS_ITEM_DEFINITION,
198 MENU_ITEMS_ITEM_TYPE,
199 MENU_ITEMS_ITEM_SELECTED,
200 MENU_ITEMS_ITEM_HELP,
201 MENU_ITEMS_ITEM_LENGTH
204 static Lisp_Object menu_items;
206 /* Number of slots currently allocated in menu_items. */
207 static int menu_items_allocated;
209 /* This is the index in menu_items of the first empty slot. */
210 static int menu_items_used;
212 /* The number of panes currently recorded in menu_items,
213 excluding those within submenus. */
214 static int menu_items_n_panes;
216 /* Current depth within submenus. */
217 static int menu_items_submenu_depth;
219 /* Flag which when set indicates a dialog or menu has been posted by
220 Xt on behalf of one of the widget sets. */
221 static int popup_activated_flag;
223 static int next_menubar_widget_id;
225 /* This is set nonzero after the user activates the menu bar, and set
226 to zero again after the menu bars are redisplayed by prepare_menu_bar.
227 While it is nonzero, all calls to set_frame_menubar go deep.
229 I don't understand why this is needed, but it does seem to be
230 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
232 int pending_menu_activation;
235 /* Return the frame whose ->output_data.w32->menubar_widget equals
236 ID, or 0 if none. */
238 static struct frame *
239 menubar_id_to_frame (id)
240 HMENU id;
242 Lisp_Object tail, frame;
243 FRAME_PTR f;
245 for (tail = Vframe_list; GC_CONSP (tail); tail = XCDR (tail))
247 frame = XCAR (tail);
248 if (!GC_FRAMEP (frame))
249 continue;
250 f = XFRAME (frame);
251 if (!FRAME_WINDOW_P (f))
252 continue;
253 if (f->output_data.w32->menubar_widget == id)
254 return f;
256 return 0;
259 /* Initialize the menu_items structure if we haven't already done so.
260 Also mark it as currently empty. */
262 static void
263 init_menu_items ()
265 if (NILP (menu_items))
267 menu_items_allocated = 60;
268 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
271 menu_items_used = 0;
272 menu_items_n_panes = 0;
273 menu_items_submenu_depth = 0;
276 /* Call at the end of generating the data in menu_items.
277 This fills in the number of items in the last pane. */
279 static void
280 finish_menu_items ()
284 /* Call when finished using the data for the current menu
285 in menu_items. */
287 static void
288 discard_menu_items ()
290 /* Free the structure if it is especially large.
291 Otherwise, hold on to it, to save time. */
292 if (menu_items_allocated > 200)
294 menu_items = Qnil;
295 menu_items_allocated = 0;
299 /* Make the menu_items vector twice as large. */
301 static void
302 grow_menu_items ()
304 Lisp_Object old;
305 int old_size = menu_items_allocated;
306 old = menu_items;
308 menu_items_allocated *= 2;
309 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
310 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
311 old_size * sizeof (Lisp_Object));
314 /* Begin a submenu. */
316 static void
317 push_submenu_start ()
319 if (menu_items_used + 1 > menu_items_allocated)
320 grow_menu_items ();
322 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
323 menu_items_submenu_depth++;
326 /* End a submenu. */
328 static void
329 push_submenu_end ()
331 if (menu_items_used + 1 > menu_items_allocated)
332 grow_menu_items ();
334 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
335 menu_items_submenu_depth--;
338 /* Indicate boundary between left and right. */
340 static void
341 push_left_right_boundary ()
343 if (menu_items_used + 1 > menu_items_allocated)
344 grow_menu_items ();
346 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
349 /* Start a new menu pane in menu_items..
350 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
352 static void
353 push_menu_pane (name, prefix_vec)
354 Lisp_Object name, prefix_vec;
356 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
357 grow_menu_items ();
359 if (menu_items_submenu_depth == 0)
360 menu_items_n_panes++;
361 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
362 XVECTOR (menu_items)->contents[menu_items_used++] = name;
363 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
366 /* Push one menu item into the current pane. NAME is the string to
367 display. ENABLE if non-nil means this item can be selected. KEY
368 is the key generated by choosing this item, or nil if this item
369 doesn't really have a definition. DEF is the definition of this
370 item. EQUIV is the textual description of the keyboard equivalent
371 for this item (or nil if none). TYPE is the type of this menu
372 item, one of nil, `toggle' or `radio'. */
374 static void
375 push_menu_item (name, enable, key, def, equiv, type, selected, help)
376 Lisp_Object name, enable, key, def, equiv, type, selected, help;
378 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
379 grow_menu_items ();
381 XVECTOR (menu_items)->contents[menu_items_used++] = name;
382 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
383 XVECTOR (menu_items)->contents[menu_items_used++] = key;
384 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
385 XVECTOR (menu_items)->contents[menu_items_used++] = def;
386 XVECTOR (menu_items)->contents[menu_items_used++] = type;
387 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
388 XVECTOR (menu_items)->contents[menu_items_used++] = help;
391 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
392 and generate menu panes for them in menu_items.
393 If NOTREAL is nonzero,
394 don't bother really computing whether an item is enabled. */
396 static void
397 keymap_panes (keymaps, nmaps, notreal)
398 Lisp_Object *keymaps;
399 int nmaps;
400 int notreal;
402 int mapno;
404 init_menu_items ();
406 /* Loop over the given keymaps, making a pane for each map.
407 But don't make a pane that is empty--ignore that map instead.
408 P is the number of panes we have made so far. */
409 for (mapno = 0; mapno < nmaps; mapno++)
410 single_keymap_panes (keymaps[mapno], Qnil, Qnil, notreal, 10);
412 finish_menu_items ();
415 /* This is a recursive subroutine of keymap_panes.
416 It handles one keymap, KEYMAP.
417 The other arguments are passed along
418 or point to local variables of the previous function.
419 If NOTREAL is nonzero, only check for equivalent key bindings, don't
420 evaluate expressions in menu items and don't make any menu.
422 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
424 static void
425 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
426 Lisp_Object keymap;
427 Lisp_Object pane_name;
428 Lisp_Object prefix;
429 int notreal;
430 int maxdepth;
432 Lisp_Object pending_maps = Qnil;
433 Lisp_Object tail, item;
434 struct gcpro gcpro1, gcpro2;
436 if (maxdepth <= 0)
437 return;
439 push_menu_pane (pane_name, prefix);
441 for (tail = keymap; CONSP (tail); tail = XCDR (tail))
443 GCPRO2 (keymap, pending_maps);
444 /* Look at each key binding, and if it is a menu item add it
445 to this menu. */
446 item = XCAR (tail);
447 if (CONSP (item))
448 single_menu_item (XCAR (item), XCDR (item),
449 &pending_maps, notreal, maxdepth);
450 else if (VECTORP (item))
452 /* Loop over the char values represented in the vector. */
453 int len = XVECTOR (item)->size;
454 int c;
455 for (c = 0; c < len; c++)
457 Lisp_Object character;
458 XSETFASTINT (character, c);
459 single_menu_item (character, XVECTOR (item)->contents[c],
460 &pending_maps, notreal, maxdepth);
463 UNGCPRO;
466 /* Process now any submenus which want to be panes at this level. */
467 while (!NILP (pending_maps))
469 Lisp_Object elt, eltcdr, string;
470 elt = Fcar (pending_maps);
471 eltcdr = XCDR (elt);
472 string = XCAR (eltcdr);
473 /* We no longer discard the @ from the beginning of the string here.
474 Instead, we do this in w32_menu_show. */
475 single_keymap_panes (Fcar (elt), string,
476 XCDR (eltcdr), notreal, maxdepth - 1);
477 pending_maps = Fcdr (pending_maps);
481 /* This is a subroutine of single_keymap_panes that handles one
482 keymap entry.
483 KEY is a key in a keymap and ITEM is its binding.
484 PENDING_MAPS_PTR points to a list of keymaps waiting to be made into
485 separate panes.
486 If NOTREAL is nonzero, only check for equivalent key bindings, don't
487 evaluate expressions in menu items and don't make any menu.
488 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
490 static void
491 single_menu_item (key, item, pending_maps_ptr, notreal, maxdepth)
492 Lisp_Object key, item;
493 Lisp_Object *pending_maps_ptr;
494 int maxdepth, notreal;
496 Lisp_Object map, item_string, enabled;
497 struct gcpro gcpro1, gcpro2;
498 int res;
500 /* Parse the menu item and leave the result in item_properties. */
501 GCPRO2 (key, item);
502 res = parse_menu_item (item, notreal, 0);
503 UNGCPRO;
504 if (!res)
505 return; /* Not a menu item. */
507 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
509 if (notreal)
511 /* We don't want to make a menu, just traverse the keymaps to
512 precompute equivalent key bindings. */
513 if (!NILP (map))
514 single_keymap_panes (map, Qnil, key, 1, maxdepth - 1);
515 return;
518 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
519 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
521 if (!NILP (map) && XSTRING (item_string)->data[0] == '@')
523 if (!NILP (enabled))
524 /* An enabled separate pane. Remember this to handle it later. */
525 *pending_maps_ptr = Fcons (Fcons (map, Fcons (item_string, key)),
526 *pending_maps_ptr);
527 return;
530 push_menu_item (item_string, enabled, key,
531 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
532 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
533 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
534 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
535 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
537 /* Display a submenu using the toolkit. */
538 if (! (NILP (map) || NILP (enabled)))
540 push_submenu_start ();
541 single_keymap_panes (map, Qnil, key, 0, maxdepth - 1);
542 push_submenu_end ();
546 /* Push all the panes and items of a menu described by the
547 alist-of-alists MENU.
548 This handles old-fashioned calls to x-popup-menu. */
550 static void
551 list_of_panes (menu)
552 Lisp_Object menu;
554 Lisp_Object tail;
556 init_menu_items ();
558 for (tail = menu; !NILP (tail); tail = Fcdr (tail))
560 Lisp_Object elt, pane_name, pane_data;
561 elt = Fcar (tail);
562 pane_name = Fcar (elt);
563 CHECK_STRING (pane_name, 0);
564 push_menu_pane (pane_name, Qnil);
565 pane_data = Fcdr (elt);
566 CHECK_CONS (pane_data, 0);
567 list_of_items (pane_data);
570 finish_menu_items ();
573 /* Push the items in a single pane defined by the alist PANE. */
575 static void
576 list_of_items (pane)
577 Lisp_Object pane;
579 Lisp_Object tail, item, item1;
581 for (tail = pane; !NILP (tail); tail = Fcdr (tail))
583 item = Fcar (tail);
584 if (STRINGP (item))
585 push_menu_item (item, Qnil, Qnil, Qt, Qnil, Qnil, Qnil, Qnil);
586 else if (NILP (item))
587 push_left_right_boundary ();
588 else
590 CHECK_CONS (item, 0);
591 item1 = Fcar (item);
592 CHECK_STRING (item1, 1);
593 push_menu_item (item1, Qt, Fcdr (item), Qt, Qnil, Qnil, Qnil, Qnil);
598 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
599 "Pop up a deck-of-cards menu and return user's selection.\n\
600 POSITION is a position specification. This is either a mouse button event\n\
601 or a list ((XOFFSET YOFFSET) WINDOW)\n\
602 where XOFFSET and YOFFSET are positions in pixels from the top left\n\
603 corner of WINDOW's frame. (WINDOW may be a frame object instead of a window.)\n\
604 This controls the position of the center of the first line\n\
605 in the first pane of the menu, not the top left of the menu as a whole.\n\
606 If POSITION is t, it means to use the current mouse position.\n\
608 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.\n\
609 The menu items come from key bindings that have a menu string as well as\n\
610 a definition; actually, the \"definition\" in such a key binding looks like\n\
611 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into\n\
612 the keymap as a top-level element.\n\n\
613 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.\n\
614 Otherwise, REAL-DEFINITION should be a valid key binding definition.\n\
616 You can also use a list of keymaps as MENU.\n\
617 Then each keymap makes a separate pane.\n\
618 When MENU is a keymap or a list of keymaps, the return value\n\
619 is a list of events.\n\n\
621 Alternatively, you can specify a menu of multiple panes\n\
622 with a list of the form (TITLE PANE1 PANE2...),\n\
623 where each pane is a list of form (TITLE ITEM1 ITEM2...).\n\
624 Each ITEM is normally a cons cell (STRING . VALUE);\n\
625 but a string can appear as an item--that makes a nonselectable line\n\
626 in the menu.\n\
627 With this form of menu, the return value is VALUE from the chosen item.\n\
629 If POSITION is nil, don't display the menu at all, just precalculate the\n\
630 cached information about equivalent key sequences.")
631 (position, menu)
632 Lisp_Object position, menu;
634 Lisp_Object keymap, tem;
635 int xpos, ypos;
636 Lisp_Object title;
637 char *error_name;
638 Lisp_Object selection;
639 FRAME_PTR f;
640 Lisp_Object x, y, window;
641 int keymaps = 0;
642 int for_click = 0;
643 struct gcpro gcpro1;
645 #ifdef HAVE_MENUS
646 if (! NILP (position))
648 check_w32 ();
650 /* Decode the first argument: find the window and the coordinates. */
651 if (EQ (position, Qt)
652 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
654 /* Use the mouse's current position. */
655 FRAME_PTR new_f = SELECTED_FRAME ();
656 Lisp_Object bar_window;
657 enum scroll_bar_part part;
658 unsigned long time;
660 if (mouse_position_hook)
661 (*mouse_position_hook) (&new_f, 1, &bar_window,
662 &part, &x, &y, &time);
663 if (new_f != 0)
664 XSETFRAME (window, new_f);
665 else
667 window = selected_window;
668 XSETFASTINT (x, 0);
669 XSETFASTINT (y, 0);
672 else
674 tem = Fcar (position);
675 if (CONSP (tem))
677 window = Fcar (Fcdr (position));
678 x = Fcar (tem);
679 y = Fcar (Fcdr (tem));
681 else
683 for_click = 1;
684 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
685 window = Fcar (tem); /* POSN_WINDOW (tem) */
686 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
687 x = Fcar (tem);
688 y = Fcdr (tem);
692 CHECK_NUMBER (x, 0);
693 CHECK_NUMBER (y, 0);
695 /* Decode where to put the menu. */
697 if (FRAMEP (window))
699 f = XFRAME (window);
700 xpos = 0;
701 ypos = 0;
703 else if (WINDOWP (window))
705 CHECK_LIVE_WINDOW (window, 0);
706 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
708 xpos = (FONT_WIDTH (FRAME_FONT (f))
709 * XFASTINT (XWINDOW (window)->left));
710 ypos = (FRAME_LINE_HEIGHT (f)
711 * XFASTINT (XWINDOW (window)->top));
713 else
714 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
715 but I don't want to make one now. */
716 CHECK_WINDOW (window, 0);
718 xpos += XINT (x);
719 ypos += XINT (y);
721 XSETFRAME (Vmenu_updating_frame, f);
723 Vmenu_updating_frame = Qnil;
724 #endif /* HAVE_MENUS */
726 title = Qnil;
727 GCPRO1 (title);
729 /* Decode the menu items from what was specified. */
731 keymap = Fkeymapp (menu);
732 tem = Qnil;
733 if (CONSP (menu))
734 tem = Fkeymapp (Fcar (menu));
735 if (!NILP (keymap))
737 /* We were given a keymap. Extract menu info from the keymap. */
738 Lisp_Object prompt;
739 keymap = get_keymap (menu);
741 /* Extract the detailed info to make one pane. */
742 keymap_panes (&menu, 1, NILP (position));
744 /* Search for a string appearing directly as an element of the keymap.
745 That string is the title of the menu. */
746 prompt = map_prompt (keymap);
747 if (NILP (title) && !NILP (prompt))
748 title = prompt;
750 /* Make that be the pane title of the first pane. */
751 if (!NILP (prompt) && menu_items_n_panes >= 0)
752 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
754 keymaps = 1;
756 else if (!NILP (tem))
758 /* We were given a list of keymaps. */
759 int nmaps = XFASTINT (Flength (menu));
760 Lisp_Object *maps
761 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
762 int i;
764 title = Qnil;
766 /* The first keymap that has a prompt string
767 supplies the menu title. */
768 for (tem = menu, i = 0; CONSP (tem); tem = Fcdr (tem))
770 Lisp_Object prompt;
772 maps[i++] = keymap = get_keymap (Fcar (tem));
774 prompt = map_prompt (keymap);
775 if (NILP (title) && !NILP (prompt))
776 title = prompt;
779 /* Extract the detailed info to make one pane. */
780 keymap_panes (maps, nmaps, NILP (position));
782 /* Make the title be the pane title of the first pane. */
783 if (!NILP (title) && menu_items_n_panes >= 0)
784 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
786 keymaps = 1;
788 else
790 /* We were given an old-fashioned menu. */
791 title = Fcar (menu);
792 CHECK_STRING (title, 1);
794 list_of_panes (Fcdr (menu));
796 keymaps = 0;
799 if (NILP (position))
801 discard_menu_items ();
802 UNGCPRO;
803 return Qnil;
806 #ifdef HAVE_MENUS
807 /* Display them in a menu. */
808 BLOCK_INPUT;
810 selection = w32_menu_show (f, xpos, ypos, for_click,
811 keymaps, title, &error_name);
812 UNBLOCK_INPUT;
814 discard_menu_items ();
816 UNGCPRO;
817 #endif /* HAVE_MENUS */
819 if (error_name) error (error_name);
820 return selection;
823 #ifdef HAVE_MENUS
825 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 2, 0,
826 "Pop up a dialog box and return user's selection.\n\
827 POSITION specifies which frame to use.\n\
828 This is normally a mouse button event or a window or frame.\n\
829 If POSITION is t, it means to use the frame the mouse is on.\n\
830 The dialog box appears in the middle of the specified frame.\n\
832 CONTENTS specifies the alternatives to display in the dialog box.\n\
833 It is a list of the form (TITLE ITEM1 ITEM2...).\n\
834 Each ITEM is a cons cell (STRING . VALUE).\n\
835 The return value is VALUE from the chosen item.\n\n\
836 An ITEM may also be just a string--that makes a nonselectable item.\n\
837 An ITEM may also be nil--that means to put all preceding items\n\
838 on the left of the dialog box and all following items on the right.\n\
839 \(By default, approximately half appear on each side.)")
840 (position, contents)
841 Lisp_Object position, contents;
843 FRAME_PTR f;
844 Lisp_Object window;
846 check_w32 ();
848 /* Decode the first argument: find the window or frame to use. */
849 if (EQ (position, Qt)
850 || (CONSP (position) && EQ (XCAR (position), Qmenu_bar)))
852 #if 0 /* Using the frame the mouse is on may not be right. */
853 /* Use the mouse's current position. */
854 FRAME_PTR new_f = SELECTED_FRAME ();
855 Lisp_Object bar_window;
856 int part;
857 unsigned long time;
858 Lisp_Object x, y;
860 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
862 if (new_f != 0)
863 XSETFRAME (window, new_f);
864 else
865 window = selected_window;
866 #endif
867 window = selected_window;
869 else if (CONSP (position))
871 Lisp_Object tem;
872 tem = Fcar (position);
873 if (CONSP (tem))
874 window = Fcar (Fcdr (position));
875 else
877 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
878 window = Fcar (tem); /* POSN_WINDOW (tem) */
881 else if (WINDOWP (position) || FRAMEP (position))
882 window = position;
883 else
884 window = Qnil;
886 /* Decode where to put the menu. */
888 if (FRAMEP (window))
889 f = XFRAME (window);
890 else if (WINDOWP (window))
892 CHECK_LIVE_WINDOW (window, 0);
893 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
895 else
896 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
897 but I don't want to make one now. */
898 CHECK_WINDOW (window, 0);
900 #ifndef HAVE_DIALOGS
901 /* Display a menu with these alternatives
902 in the middle of frame F. */
904 Lisp_Object x, y, frame, newpos;
905 XSETFRAME (frame, f);
906 XSETINT (x, x_pixel_width (f) / 2);
907 XSETINT (y, x_pixel_height (f) / 2);
908 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
910 return Fx_popup_menu (newpos,
911 Fcons (Fcar (contents), Fcons (contents, Qnil)));
913 #else /* HAVE_DIALOGS */
915 Lisp_Object title;
916 char *error_name;
917 Lisp_Object selection;
919 /* Decode the dialog items from what was specified. */
920 title = Fcar (contents);
921 CHECK_STRING (title, 1);
923 list_of_panes (Fcons (contents, Qnil));
925 /* Display them in a dialog box. */
926 BLOCK_INPUT;
927 selection = w32_dialog_show (f, 0, title, &error_name);
928 UNBLOCK_INPUT;
930 discard_menu_items ();
932 if (error_name) error (error_name);
933 return selection;
935 #endif /* HAVE_DIALOGS */
938 /* Activate the menu bar of frame F.
939 This is called from keyboard.c when it gets the
940 menu_bar_activate_event out of the Emacs event queue.
942 To activate the menu bar, we signal to the input thread that it can
943 return from the WM_INITMENU message, allowing the normal Windows
944 processing of the menus.
946 But first we recompute the menu bar contents (the whole tree).
948 This way we can safely execute Lisp code. */
950 void
951 x_activate_menubar (f)
952 FRAME_PTR f;
954 set_frame_menubar (f, 0, 1);
956 /* Lock out further menubar changes while active. */
957 f->output_data.w32->menubar_active = 1;
959 /* Signal input thread to return from WM_INITMENU. */
960 complete_deferred_msg (FRAME_W32_WINDOW (f), WM_INITMENU, 0);
963 /* This callback is called from the menu bar pulldown menu
964 when the user makes a selection.
965 Figure out what the user chose
966 and put the appropriate events into the keyboard buffer. */
968 void
969 menubar_selection_callback (FRAME_PTR f, void * client_data)
971 Lisp_Object prefix, entry;
972 Lisp_Object vector;
973 Lisp_Object *subprefix_stack;
974 int submenu_depth = 0;
975 int i;
977 if (!f)
978 return;
979 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
980 vector = f->menu_bar_vector;
981 prefix = Qnil;
982 i = 0;
983 while (i < f->menu_bar_items_used)
985 if (EQ (XVECTOR (vector)->contents[i], Qnil))
987 subprefix_stack[submenu_depth++] = prefix;
988 prefix = entry;
989 i++;
991 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
993 prefix = subprefix_stack[--submenu_depth];
994 i++;
996 else if (EQ (XVECTOR (vector)->contents[i], Qt))
998 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
999 i += MENU_ITEMS_PANE_LENGTH;
1001 else
1003 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1004 /* The EMACS_INT cast avoids a warning. There's no problem
1005 as long as pointers have enough bits to hold small integers. */
1006 if ((int) (EMACS_INT) client_data == i)
1008 int j;
1009 struct input_event buf;
1010 Lisp_Object frame;
1012 XSETFRAME (frame, f);
1013 buf.kind = menu_bar_event;
1014 buf.frame_or_window = Fcons (frame, Fcons (Qmenu_bar, Qnil));
1015 kbd_buffer_store_event (&buf);
1017 for (j = 0; j < submenu_depth; j++)
1018 if (!NILP (subprefix_stack[j]))
1020 buf.kind = menu_bar_event;
1021 buf.frame_or_window = Fcons (frame, subprefix_stack[j]);
1022 kbd_buffer_store_event (&buf);
1025 if (!NILP (prefix))
1027 buf.kind = menu_bar_event;
1028 buf.frame_or_window = Fcons (frame, prefix);
1029 kbd_buffer_store_event (&buf);
1032 buf.kind = menu_bar_event;
1033 buf.frame_or_window = Fcons (frame, entry);
1034 kbd_buffer_store_event (&buf);
1036 return;
1038 i += MENU_ITEMS_ITEM_LENGTH;
1043 /* Allocate a widget_value, blocking input. */
1045 widget_value *
1046 xmalloc_widget_value ()
1048 widget_value *value;
1050 BLOCK_INPUT;
1051 value = malloc_widget_value ();
1052 UNBLOCK_INPUT;
1054 return value;
1057 /* This recursively calls free_widget_value on the tree of widgets.
1058 It must free all data that was malloc'ed for these widget_values.
1059 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1060 must be left alone. */
1062 void
1063 free_menubar_widget_value_tree (wv)
1064 widget_value *wv;
1066 if (! wv) return;
1068 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1070 if (wv->contents && (wv->contents != (widget_value*)1))
1072 free_menubar_widget_value_tree (wv->contents);
1073 wv->contents = (widget_value *) 0xDEADBEEF;
1075 if (wv->next)
1077 free_menubar_widget_value_tree (wv->next);
1078 wv->next = (widget_value *) 0xDEADBEEF;
1080 BLOCK_INPUT;
1081 free_widget_value (wv);
1082 UNBLOCK_INPUT;
1085 /* Return a tree of widget_value structures for a menu bar item
1086 whose event type is ITEM_KEY (with string ITEM_NAME)
1087 and whose contents come from the list of keymaps MAPS. */
1089 static widget_value *
1090 single_submenu (item_key, item_name, maps)
1091 Lisp_Object item_key, item_name, maps;
1093 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1094 int i;
1095 int submenu_depth = 0;
1096 Lisp_Object length;
1097 int len;
1098 Lisp_Object *mapvec;
1099 widget_value **submenu_stack;
1100 int previous_items = menu_items_used;
1101 int top_level_items = 0;
1103 length = Flength (maps);
1104 len = XINT (length);
1106 /* Convert the list MAPS into a vector MAPVEC. */
1107 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1108 for (i = 0; i < len; i++)
1110 mapvec[i] = Fcar (maps);
1111 maps = Fcdr (maps);
1114 menu_items_n_panes = 0;
1116 /* Loop over the given keymaps, making a pane for each map.
1117 But don't make a pane that is empty--ignore that map instead. */
1118 for (i = 0; i < len; i++)
1120 if (SYMBOLP (mapvec[i])
1121 || (CONSP (mapvec[i])
1122 && NILP (Fkeymapp (mapvec[i]))))
1124 /* Here we have a command at top level in the menu bar
1125 as opposed to a submenu. */
1126 top_level_items = 1;
1127 push_menu_pane (Qnil, Qnil);
1128 push_menu_item (item_name, Qt, item_key, mapvec[i],
1129 Qnil, Qnil, Qnil, Qnil);
1131 else
1132 single_keymap_panes (mapvec[i], item_name, item_key, 0, 10);
1135 /* Create a tree of widget_value objects
1136 representing the panes and their items. */
1138 submenu_stack
1139 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1140 wv = xmalloc_widget_value ();
1141 wv->name = "menu";
1142 wv->value = 0;
1143 wv->enabled = 1;
1144 wv->button_type = BUTTON_TYPE_NONE;
1145 first_wv = wv;
1146 save_wv = 0;
1147 prev_wv = 0;
1149 /* Loop over all panes and items made during this call
1150 and construct a tree of widget_value objects.
1151 Ignore the panes and items made by previous calls to
1152 single_submenu, even though those are also in menu_items. */
1153 i = previous_items;
1154 while (i < menu_items_used)
1156 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1158 submenu_stack[submenu_depth++] = save_wv;
1159 save_wv = prev_wv;
1160 prev_wv = 0;
1161 i++;
1163 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1165 prev_wv = save_wv;
1166 save_wv = submenu_stack[--submenu_depth];
1167 i++;
1169 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1170 && submenu_depth != 0)
1171 i += MENU_ITEMS_PANE_LENGTH;
1172 /* Ignore a nil in the item list.
1173 It's meaningful only for dialog boxes. */
1174 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1175 i += 1;
1176 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1178 /* Create a new pane. */
1179 Lisp_Object pane_name, prefix;
1180 char *pane_string;
1181 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1182 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1183 #ifndef HAVE_MULTILINGUAL_MENU
1184 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1185 pane_name = string_make_unibyte (pane_name);
1186 #endif
1187 pane_string = (NILP (pane_name)
1188 ? "" : (char *) XSTRING (pane_name)->data);
1189 /* If there is just one top-level pane, put all its items directly
1190 under the top-level menu. */
1191 if (menu_items_n_panes == 1)
1192 pane_string = "";
1194 /* If the pane has a meaningful name,
1195 make the pane a top-level menu item
1196 with its items as a submenu beneath it. */
1197 if (strcmp (pane_string, ""))
1199 wv = xmalloc_widget_value ();
1200 if (save_wv)
1201 save_wv->next = wv;
1202 else
1203 first_wv->contents = wv;
1204 wv->name = pane_string;
1205 /* Ignore the @ that means "separate pane".
1206 This is a kludge, but this isn't worth more time. */
1207 if (!NILP (prefix) && wv->name[0] == '@')
1208 wv->name++;
1209 wv->value = 0;
1210 wv->enabled = 1;
1211 wv->button_type = BUTTON_TYPE_NONE;
1213 save_wv = wv;
1214 prev_wv = 0;
1215 i += MENU_ITEMS_PANE_LENGTH;
1217 else
1219 /* Create a new item within current pane. */
1220 Lisp_Object item_name, enable, descrip, def, type, selected;
1221 Lisp_Object help;
1222 /* NTEMACS_TODO: implement popup/modeline help for menus. */
1224 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1225 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1226 descrip
1227 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1228 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1229 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1230 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1231 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1233 #ifndef HAVE_MULTILINGUAL_MENU
1234 if (STRING_MULTIBYTE (item_name))
1235 item_name = string_make_unibyte (item_name);
1236 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1237 descrip = string_make_unibyte (descrip);
1238 #endif
1240 wv = xmalloc_widget_value ();
1241 if (prev_wv)
1242 prev_wv->next = wv;
1243 else
1244 save_wv->contents = wv;
1246 wv->name = (char *) XSTRING (item_name)->data;
1247 if (!NILP (descrip))
1248 wv->key = (char *) XSTRING (descrip)->data;
1249 wv->value = 0;
1250 /* The EMACS_INT cast avoids a warning. There's no problem
1251 as long as pointers have enough bits to hold small integers. */
1252 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1253 wv->enabled = !NILP (enable);
1255 if (NILP (type))
1256 wv->button_type = BUTTON_TYPE_NONE;
1257 else if (EQ (type, QCradio))
1258 wv->button_type = BUTTON_TYPE_RADIO;
1259 else if (EQ (type, QCtoggle))
1260 wv->button_type = BUTTON_TYPE_TOGGLE;
1261 else
1262 abort ();
1264 wv->selected = !NILP (selected);
1265 if (STRINGP (help))
1266 wv->help = XSTRING (help)->data;
1268 prev_wv = wv;
1270 i += MENU_ITEMS_ITEM_LENGTH;
1274 /* If we have just one "menu item"
1275 that was originally a button, return it by itself. */
1276 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1278 wv = first_wv->contents;
1279 free_widget_value (first_wv);
1280 return wv;
1283 return first_wv;
1286 /* Set the contents of the menubar widgets of frame F.
1287 The argument FIRST_TIME is currently ignored;
1288 it is set the first time this is called, from initialize_frame_menubar. */
1290 void
1291 set_frame_menubar (f, first_time, deep_p)
1292 FRAME_PTR f;
1293 int first_time;
1294 int deep_p;
1296 HMENU menubar_widget = f->output_data.w32->menubar_widget;
1297 Lisp_Object items;
1298 widget_value *wv, *first_wv, *prev_wv = 0;
1299 int i;
1301 /* We must not change the menubar when actually in use. */
1302 if (f->output_data.w32->menubar_active)
1303 return;
1305 XSETFRAME (Vmenu_updating_frame, f);
1307 if (! menubar_widget)
1308 deep_p = 1;
1309 else if (pending_menu_activation && !deep_p)
1310 deep_p = 1;
1312 wv = xmalloc_widget_value ();
1313 wv->name = "menubar";
1314 wv->value = 0;
1315 wv->enabled = 1;
1316 wv->button_type = BUTTON_TYPE_NONE;
1317 first_wv = wv;
1319 if (deep_p)
1321 /* Make a widget-value tree representing the entire menu trees. */
1323 struct buffer *prev = current_buffer;
1324 Lisp_Object buffer;
1325 int specpdl_count = specpdl_ptr - specpdl;
1326 int previous_menu_items_used = f->menu_bar_items_used;
1327 Lisp_Object *previous_items
1328 = (Lisp_Object *) alloca (previous_menu_items_used
1329 * sizeof (Lisp_Object));
1331 /* If we are making a new widget, its contents are empty,
1332 do always reinitialize them. */
1333 if (! menubar_widget)
1334 previous_menu_items_used = 0;
1336 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1337 specbind (Qinhibit_quit, Qt);
1338 /* Don't let the debugger step into this code
1339 because it is not reentrant. */
1340 specbind (Qdebug_on_next_call, Qnil);
1342 record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
1343 if (NILP (Voverriding_local_map_menu_flag))
1345 specbind (Qoverriding_terminal_local_map, Qnil);
1346 specbind (Qoverriding_local_map, Qnil);
1349 set_buffer_internal_1 (XBUFFER (buffer));
1351 /* Run the Lucid hook. */
1352 call1 (Vrun_hooks, Qactivate_menubar_hook);
1353 /* If it has changed current-menubar from previous value,
1354 really recompute the menubar from the value. */
1355 if (! NILP (Vlucid_menu_bar_dirty_flag))
1356 call0 (Qrecompute_lucid_menubar);
1357 safe_run_hooks (Qmenu_bar_update_hook);
1358 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1360 items = FRAME_MENU_BAR_ITEMS (f);
1362 inhibit_garbage_collection ();
1364 /* Save the frame's previous menu bar contents data. */
1365 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1366 previous_menu_items_used * sizeof (Lisp_Object));
1368 /* Fill in the current menu bar contents. */
1369 menu_items = f->menu_bar_vector;
1370 menu_items_allocated = XVECTOR (menu_items)->size;
1371 init_menu_items ();
1372 for (i = 0; i < XVECTOR (items)->size; i += 4)
1374 Lisp_Object key, string, maps;
1376 key = XVECTOR (items)->contents[i];
1377 string = XVECTOR (items)->contents[i + 1];
1378 maps = XVECTOR (items)->contents[i + 2];
1379 if (NILP (string))
1380 break;
1382 wv = single_submenu (key, string, maps);
1383 if (prev_wv)
1384 prev_wv->next = wv;
1385 else
1386 first_wv->contents = wv;
1387 /* Don't set wv->name here; GC during the loop might relocate it. */
1388 wv->enabled = 1;
1389 wv->button_type = BUTTON_TYPE_NONE;
1390 prev_wv = wv;
1393 finish_menu_items ();
1395 set_buffer_internal_1 (prev);
1396 unbind_to (specpdl_count, Qnil);
1398 /* If there has been no change in the Lisp-level contents
1399 of the menu bar, skip redisplaying it. Just exit. */
1401 for (i = 0; i < previous_menu_items_used; i++)
1402 if (menu_items_used == i
1403 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1404 break;
1405 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1407 free_menubar_widget_value_tree (first_wv);
1408 menu_items = Qnil;
1410 return;
1413 /* Now GC cannot happen during the lifetime of the widget_value,
1414 so it's safe to store data from a Lisp_String. */
1415 wv = first_wv->contents;
1416 for (i = 0; i < XVECTOR (items)->size; i += 4)
1418 Lisp_Object string;
1419 string = XVECTOR (items)->contents[i + 1];
1420 if (NILP (string))
1421 break;
1422 wv->name = (char *) XSTRING (string)->data;
1423 wv = wv->next;
1426 f->menu_bar_vector = menu_items;
1427 f->menu_bar_items_used = menu_items_used;
1428 menu_items = Qnil;
1430 else
1432 /* Make a widget-value tree containing
1433 just the top level menu bar strings. */
1435 items = FRAME_MENU_BAR_ITEMS (f);
1436 for (i = 0; i < XVECTOR (items)->size; i += 4)
1438 Lisp_Object string;
1440 string = XVECTOR (items)->contents[i + 1];
1441 if (NILP (string))
1442 break;
1444 wv = xmalloc_widget_value ();
1445 wv->name = (char *) XSTRING (string)->data;
1446 wv->value = 0;
1447 wv->enabled = 1;
1448 wv->button_type = BUTTON_TYPE_NONE;
1449 /* This prevents lwlib from assuming this
1450 menu item is really supposed to be empty. */
1451 /* The EMACS_INT cast avoids a warning.
1452 This value just has to be different from small integers. */
1453 wv->call_data = (void *) (EMACS_INT) (-1);
1455 if (prev_wv)
1456 prev_wv->next = wv;
1457 else
1458 first_wv->contents = wv;
1459 prev_wv = wv;
1462 /* Forget what we thought we knew about what is in the
1463 detailed contents of the menu bar menus.
1464 Changing the top level always destroys the contents. */
1465 f->menu_bar_items_used = 0;
1468 /* Create or update the menu bar widget. */
1470 BLOCK_INPUT;
1472 if (menubar_widget)
1474 /* Empty current menubar, rather than creating a fresh one. */
1475 while (DeleteMenu (menubar_widget, 0, MF_BYPOSITION))
1478 else
1480 menubar_widget = CreateMenu ();
1482 fill_in_menu (menubar_widget, first_wv->contents);
1484 free_menubar_widget_value_tree (first_wv);
1487 HMENU old_widget = f->output_data.w32->menubar_widget;
1489 f->output_data.w32->menubar_widget = menubar_widget;
1490 SetMenu (FRAME_W32_WINDOW (f), f->output_data.w32->menubar_widget);
1491 /* Causes flicker when menu bar is updated
1492 DrawMenuBar (FRAME_W32_WINDOW (f)); */
1494 /* Force the window size to be recomputed so that the frame's text
1495 area remains the same, if menubar has just been created. */
1496 if (old_widget == NULL)
1497 x_set_window_size (f, 0, FRAME_WIDTH (f), FRAME_HEIGHT (f));
1500 UNBLOCK_INPUT;
1503 /* Called from Fx_create_frame to create the initial menubar of a frame
1504 before it is mapped, so that the window is mapped with the menubar already
1505 there instead of us tacking it on later and thrashing the window after it
1506 is visible. */
1508 void
1509 initialize_frame_menubar (f)
1510 FRAME_PTR f;
1512 /* This function is called before the first chance to redisplay
1513 the frame. It has to be, so the frame will have the right size. */
1514 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1515 set_frame_menubar (f, 1, 1);
1518 /* Get rid of the menu bar of frame F, and free its storage.
1519 This is used when deleting a frame, and when turning off the menu bar. */
1521 void
1522 free_frame_menubar (f)
1523 FRAME_PTR f;
1525 BLOCK_INPUT;
1528 HMENU old = GetMenu (FRAME_W32_WINDOW (f));
1529 SetMenu (FRAME_W32_WINDOW (f), NULL);
1530 f->output_data.w32->menubar_widget = NULL;
1531 DestroyMenu (old);
1534 UNBLOCK_INPUT;
1538 /* w32_menu_show actually displays a menu using the panes and items in
1539 menu_items and returns the value selected from it; we assume input
1540 is blocked by the caller. */
1542 /* F is the frame the menu is for.
1543 X and Y are the frame-relative specified position,
1544 relative to the inside upper left corner of the frame F.
1545 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1546 KEYMAPS is 1 if this menu was specified with keymaps;
1547 in that case, we return a list containing the chosen item's value
1548 and perhaps also the pane's prefix.
1549 TITLE is the specified menu title.
1550 ERROR is a place to store an error message string in case of failure.
1551 (We return nil on failure, but the value doesn't actually matter.) */
1553 static Lisp_Object
1554 w32_menu_show (f, x, y, for_click, keymaps, title, error)
1555 FRAME_PTR f;
1556 int x;
1557 int y;
1558 int for_click;
1559 int keymaps;
1560 Lisp_Object title;
1561 char **error;
1563 int i;
1564 int menu_item_selection;
1565 HMENU menu;
1566 POINT pos;
1567 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1568 widget_value **submenu_stack
1569 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1570 Lisp_Object *subprefix_stack
1571 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1572 int submenu_depth = 0;
1573 int first_pane;
1574 int next_release_must_exit = 0;
1576 *error = NULL;
1578 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1580 *error = "Empty menu";
1581 return Qnil;
1584 /* Create a tree of widget_value objects
1585 representing the panes and their items. */
1586 wv = xmalloc_widget_value ();
1587 wv->name = "menu";
1588 wv->value = 0;
1589 wv->enabled = 1;
1590 wv->button_type = BUTTON_TYPE_NONE;
1591 first_wv = wv;
1592 first_pane = 1;
1594 /* Loop over all panes and items, filling in the tree. */
1595 i = 0;
1596 while (i < menu_items_used)
1598 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1600 submenu_stack[submenu_depth++] = save_wv;
1601 save_wv = prev_wv;
1602 prev_wv = 0;
1603 first_pane = 1;
1604 i++;
1606 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1608 prev_wv = save_wv;
1609 save_wv = submenu_stack[--submenu_depth];
1610 first_pane = 0;
1611 i++;
1613 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1614 && submenu_depth != 0)
1615 i += MENU_ITEMS_PANE_LENGTH;
1616 /* Ignore a nil in the item list.
1617 It's meaningful only for dialog boxes. */
1618 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1619 i += 1;
1620 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1622 /* Create a new pane. */
1623 Lisp_Object pane_name, prefix;
1624 char *pane_string;
1625 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1626 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1627 #ifndef HAVE_MULTILINGUAL_MENU
1628 if (!NILP (pane_name) && STRING_MULTIBYTE (pane_name))
1629 pane_name = string_make_unibyte (pane_name);
1630 #endif
1631 pane_string = (NILP (pane_name)
1632 ? "" : (char *) XSTRING (pane_name)->data);
1633 /* If there is just one top-level pane, put all its items directly
1634 under the top-level menu. */
1635 if (menu_items_n_panes == 1)
1636 pane_string = "";
1638 /* If the pane has a meaningful name,
1639 make the pane a top-level menu item
1640 with its items as a submenu beneath it. */
1641 if (!keymaps && strcmp (pane_string, ""))
1643 wv = xmalloc_widget_value ();
1644 if (save_wv)
1645 save_wv->next = wv;
1646 else
1647 first_wv->contents = wv;
1648 wv->name = pane_string;
1649 if (keymaps && !NILP (prefix))
1650 wv->name++;
1651 wv->value = 0;
1652 wv->enabled = 1;
1653 wv->button_type = BUTTON_TYPE_NONE;
1654 save_wv = wv;
1655 prev_wv = 0;
1657 else if (first_pane)
1659 save_wv = wv;
1660 prev_wv = 0;
1662 first_pane = 0;
1663 i += MENU_ITEMS_PANE_LENGTH;
1665 else
1667 /* Create a new item within current pane. */
1668 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1669 char *help_string;
1671 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1672 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1673 descrip
1674 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1675 def = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_DEFINITION];
1676 type = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_TYPE];
1677 selected = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_SELECTED];
1678 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1680 #ifndef HAVE_MULTILINGUAL_MENU
1681 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1682 item_name = string_make_unibyte (item_name);
1683 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1684 descrip = string_make_unibyte (descrip);
1685 if (STRINGP (help) && STRING_MULTIBYTE (help))
1686 help = string_make_unibyte (help);
1687 #endif
1689 help_string = STRINGP (help) ? XSTRING (help)->data : NULL;
1691 wv = xmalloc_widget_value ();
1692 if (prev_wv)
1693 prev_wv->next = wv;
1694 else
1695 save_wv->contents = wv;
1696 wv->name = (char *) XSTRING (item_name)->data;
1697 if (!NILP (descrip))
1698 wv->key = (char *) XSTRING (descrip)->data;
1699 wv->value = 0;
1700 /* Use the contents index as call_data, since we are
1701 restricted to 16-bits.. */
1702 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1703 wv->enabled = !NILP (enable);
1705 if (NILP (type))
1706 wv->button_type = BUTTON_TYPE_NONE;
1707 else if (EQ (type, QCtoggle))
1708 wv->button_type = BUTTON_TYPE_TOGGLE;
1709 else if (EQ (type, QCradio))
1710 wv->button_type = BUTTON_TYPE_RADIO;
1711 else
1712 abort ();
1714 wv->selected = !NILP (selected);
1716 prev_wv = wv;
1718 i += MENU_ITEMS_ITEM_LENGTH;
1722 /* Deal with the title, if it is non-nil. */
1723 if (!NILP (title))
1725 widget_value *wv_title = xmalloc_widget_value ();
1726 widget_value *wv_sep = xmalloc_widget_value ();
1728 /* Maybe replace this separator with a bitmap or owner-draw item
1729 so that it looks better. Having two separators looks odd. */
1730 wv_sep->name = "--";
1731 wv_sep->next = first_wv->contents;
1733 #ifndef HAVE_MULTILINGUAL_MENU
1734 if (STRING_MULTIBYTE (title))
1735 title = string_make_unibyte (title);
1736 #endif
1737 wv_title->name = (char *) XSTRING (title)->data;
1738 wv_title->enabled = True;
1739 wv_title->button_type = BUTTON_TYPE_NONE;
1740 wv_title->next = wv_sep;
1741 first_wv->contents = wv_title;
1744 /* Actually create the menu. */
1745 menu = CreatePopupMenu ();
1746 fill_in_menu (menu, first_wv->contents);
1748 /* Adjust coordinates to be root-window-relative. */
1749 pos.x = x;
1750 pos.y = y;
1751 ClientToScreen (FRAME_W32_WINDOW (f), &pos);
1753 /* Free the widget_value objects we used to specify the contents. */
1754 free_menubar_widget_value_tree (first_wv);
1756 /* No selection has been chosen yet. */
1757 menu_item_selection = 0;
1759 /* Display the menu. */
1760 menu_item_selection = SendMessage (FRAME_W32_WINDOW (f),
1761 WM_EMACS_TRACKPOPUPMENU,
1762 (WPARAM)menu, (LPARAM)&pos);
1764 /* Clean up extraneous mouse events which might have been generated
1765 during the call. */
1766 discard_mouse_events ();
1768 DestroyMenu (menu);
1770 /* Find the selected item, and its pane, to return
1771 the proper value. */
1772 if (menu_item_selection != 0)
1774 Lisp_Object prefix, entry;
1776 prefix = Qnil;
1777 i = 0;
1778 while (i < menu_items_used)
1780 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1782 subprefix_stack[submenu_depth++] = prefix;
1783 prefix = entry;
1784 i++;
1786 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1788 prefix = subprefix_stack[--submenu_depth];
1789 i++;
1791 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1793 prefix
1794 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1795 i += MENU_ITEMS_PANE_LENGTH;
1797 /* Ignore a nil in the item list.
1798 It's meaningful only for dialog boxes. */
1799 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1800 i += 1;
1801 else
1803 entry
1804 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1805 if (menu_item_selection == i)
1807 if (keymaps != 0)
1809 int j;
1811 entry = Fcons (entry, Qnil);
1812 if (!NILP (prefix))
1813 entry = Fcons (prefix, entry);
1814 for (j = submenu_depth - 1; j >= 0; j--)
1815 if (!NILP (subprefix_stack[j]))
1816 entry = Fcons (subprefix_stack[j], entry);
1818 return entry;
1820 i += MENU_ITEMS_ITEM_LENGTH;
1825 return Qnil;
1829 static char * button_names [] = {
1830 "button1", "button2", "button3", "button4", "button5",
1831 "button6", "button7", "button8", "button9", "button10" };
1833 static Lisp_Object
1834 w32_dialog_show (f, keymaps, title, error)
1835 FRAME_PTR f;
1836 int keymaps;
1837 Lisp_Object title;
1838 char **error;
1840 int i, nb_buttons=0;
1841 char dialog_name[6];
1842 int menu_item_selection;
1844 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1846 /* Number of elements seen so far, before boundary. */
1847 int left_count = 0;
1848 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1849 int boundary_seen = 0;
1851 *error = NULL;
1853 if (menu_items_n_panes > 1)
1855 *error = "Multiple panes in dialog box";
1856 return Qnil;
1859 /* Create a tree of widget_value objects
1860 representing the text label and buttons. */
1862 Lisp_Object pane_name, prefix;
1863 char *pane_string;
1864 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1865 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1866 pane_string = (NILP (pane_name)
1867 ? "" : (char *) XSTRING (pane_name)->data);
1868 prev_wv = xmalloc_widget_value ();
1869 prev_wv->value = pane_string;
1870 if (keymaps && !NILP (prefix))
1871 prev_wv->name++;
1872 prev_wv->enabled = 1;
1873 prev_wv->name = "message";
1874 first_wv = prev_wv;
1876 /* Loop over all panes and items, filling in the tree. */
1877 i = MENU_ITEMS_PANE_LENGTH;
1878 while (i < menu_items_used)
1881 /* Create a new item within current pane. */
1882 Lisp_Object item_name, enable, descrip, help;
1883 char *help_string;
1885 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1886 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1887 descrip
1888 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1889 help = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_HELP];
1890 help_string = STRINGP (help) ? XSTRING (help)->data : NULL;
1892 if (NILP (item_name))
1894 free_menubar_widget_value_tree (first_wv);
1895 *error = "Submenu in dialog items";
1896 return Qnil;
1898 if (EQ (item_name, Qquote))
1900 /* This is the boundary between left-side elts
1901 and right-side elts. Stop incrementing right_count. */
1902 boundary_seen = 1;
1903 i++;
1904 continue;
1906 if (nb_buttons >= 9)
1908 free_menubar_widget_value_tree (first_wv);
1909 *error = "Too many dialog items";
1910 return Qnil;
1913 wv = xmalloc_widget_value ();
1914 prev_wv->next = wv;
1915 wv->name = (char *) button_names[nb_buttons];
1916 if (!NILP (descrip))
1917 wv->key = (char *) XSTRING (descrip)->data;
1918 wv->value = (char *) XSTRING (item_name)->data;
1919 wv->call_data = (void *) &XVECTOR (menu_items)->contents[i];
1920 wv->enabled = !NILP (enable);
1921 prev_wv = wv;
1923 if (! boundary_seen)
1924 left_count++;
1926 nb_buttons++;
1927 i += MENU_ITEMS_ITEM_LENGTH;
1930 /* If the boundary was not specified,
1931 by default put half on the left and half on the right. */
1932 if (! boundary_seen)
1933 left_count = nb_buttons - nb_buttons / 2;
1935 wv = xmalloc_widget_value ();
1936 wv->name = dialog_name;
1938 /* Dialog boxes use a really stupid name encoding
1939 which specifies how many buttons to use
1940 and how many buttons are on the right.
1941 The Q means something also. */
1942 dialog_name[0] = 'Q';
1943 dialog_name[1] = '0' + nb_buttons;
1944 dialog_name[2] = 'B';
1945 dialog_name[3] = 'R';
1946 /* Number of buttons to put on the right. */
1947 dialog_name[4] = '0' + nb_buttons - left_count;
1948 dialog_name[5] = 0;
1949 wv->contents = first_wv;
1950 first_wv = wv;
1953 /* Actually create the dialog. */
1954 #ifdef HAVE_DIALOGS
1955 dialog_id = widget_id_tick++;
1956 menu = lw_create_widget (first_wv->name, "dialog", dialog_id, first_wv,
1957 f->output_data.w32->widget, 1, 0,
1958 dialog_selection_callback, 0);
1959 lw_modify_all_widgets (dialog_id, first_wv->contents, True);
1960 #endif
1962 /* Free the widget_value objects we used to specify the contents. */
1963 free_menubar_widget_value_tree (first_wv);
1965 /* No selection has been chosen yet. */
1966 menu_item_selection = 0;
1968 /* Display the menu. */
1969 #ifdef HAVE_DIALOGS
1970 lw_pop_up_all_widgets (dialog_id);
1971 popup_activated_flag = 1;
1973 /* Process events that apply to the menu. */
1974 popup_get_selection ((XEvent *) 0, FRAME_X_DISPLAY_INFO (f), dialog_id);
1976 lw_destroy_all_widgets (dialog_id);
1977 #endif
1979 /* Find the selected item, and its pane, to return
1980 the proper value. */
1981 if (menu_item_selection != 0)
1983 Lisp_Object prefix;
1985 prefix = Qnil;
1986 i = 0;
1987 while (i < menu_items_used)
1989 Lisp_Object entry;
1991 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1993 prefix
1994 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1995 i += MENU_ITEMS_PANE_LENGTH;
1997 else
1999 entry
2000 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2001 if (menu_item_selection == i)
2003 if (keymaps != 0)
2005 entry = Fcons (entry, Qnil);
2006 if (!NILP (prefix))
2007 entry = Fcons (prefix, entry);
2009 return entry;
2011 i += MENU_ITEMS_ITEM_LENGTH;
2016 return Qnil;
2020 /* Is this item a separator? */
2021 static int
2022 name_is_separator (name)
2023 char *name;
2025 /* Check if name string consists of only dashes ('-') */
2026 while (*name == '-') name++;
2027 return (*name == '\0');
2031 /* Indicate boundary between left and right. */
2032 static int
2033 add_left_right_boundary (HMENU menu)
2035 return AppendMenu (menu, MF_MENUBARBREAK, 0, NULL);
2038 static int
2039 add_menu_item (HMENU menu, widget_value *wv, HMENU item)
2041 UINT fuFlags;
2042 char *out_string;
2043 int return_value;
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;
2073 /* Draw radio buttons and tickboxes. */
2075 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2076 wv->button_type == BUTTON_TYPE_RADIO))
2077 fuFlags |= MF_CHECKED;
2078 else
2079 fuFlags |= MF_UNCHECKED;
2082 if (item != NULL)
2083 fuFlags = MF_POPUP;
2085 return_value =
2086 AppendMenu (menu,
2087 fuFlags,
2088 item != NULL ? (UINT) item : (UINT) wv->call_data,
2089 (fuFlags == MF_SEPARATOR) ? NULL: out_string );
2091 /* This must be done after the menu item is created. */
2092 if (wv->button_type == BUTTON_TYPE_RADIO)
2094 /* CheckMenuRadioItem allows us to differentiate TOGGLE and
2095 RADIO items, but is not available on NT 3.51 and earlier. */
2096 HMODULE user32 = GetModuleHandle ("user32.dll");
2097 FARPROC set_menu_item_info = GetProcAddress (user32, "SetMenuItemInfo");
2099 if (set_menu_item_info)
2101 MENUITEMINFO info;
2102 bzero (&info, sizeof (info));
2103 info.cbSize = sizeof (info);
2104 info.fMask = MIIM_TYPE | MIIM_STATE;
2105 info.fType = MFT_RADIOCHECK;
2106 info.fState = wv->selected ? MFS_CHECKED : MFS_UNCHECKED;
2107 set_menu_item_info (menu, item, FALSE, &info);
2111 return return_value;
2114 /* Construct native Windows menu(bar) based on widget_value tree. */
2115 static int
2116 fill_in_menu (HMENU menu, widget_value *wv)
2118 int items_added = 0;
2120 for ( ; wv != NULL; wv = wv->next)
2122 if (wv->contents)
2124 HMENU sub_menu = CreatePopupMenu ();
2126 if (sub_menu == NULL)
2127 return 0;
2129 if (!fill_in_menu (sub_menu, wv->contents) ||
2130 !add_menu_item (menu, wv, sub_menu))
2132 DestroyMenu (sub_menu);
2133 return 0;
2136 else
2138 if (!add_menu_item (menu, wv, NULL))
2139 return 0;
2142 return 1;
2146 popup_activated ()
2148 /* popup_activated_flag not actually used on W32 */
2149 return 0;
2152 #endif /* HAVE_MENUS */
2154 syms_of_w32menu ()
2156 staticpro (&menu_items);
2157 menu_items = Qnil;
2159 Qdebug_on_next_call = intern ("debug-on-next-call");
2160 staticpro (&Qdebug_on_next_call);
2162 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2163 "Frame for which we are updating a menu.\n\
2164 The enable predicate for a menu command should check this variable.");
2165 Vmenu_updating_frame = Qnil;
2167 defsubr (&Sx_popup_menu);
2168 #ifdef HAVE_MENUS
2169 defsubr (&Sx_popup_dialog);
2170 #endif