Merge from gnus--rel--5.10
[emacs.git] / src / macmenu.c
blob153969f7efddabe8d72860f749ade95a127e5a97
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
24 #include <config.h>
26 #include <stdio.h>
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.h"
37 #include "coding.h"
39 /* This may include sys/types.h, and that somehow loses
40 if this is not done before the other system files. */
41 #include "macterm.h"
43 /* Load sys/types.h if not already loaded.
44 In some systems loading it twice is suicidal. */
45 #ifndef makedev
46 #include <sys/types.h>
47 #endif
49 #include "dispextern.h"
51 #if TARGET_API_MAC_CARBON
52 #define HAVE_DIALOGS 1
53 #endif
55 #undef HAVE_MULTILINGUAL_MENU
57 /******************************************************************/
59 /* Assumed by other routines to zero area returned. */
60 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
61 0, (sizeof (widget_value)))
62 #define free_widget_value(wv) xfree (wv)
64 /******************************************************************/
66 #ifndef TRUE
67 #define TRUE 1
68 #define FALSE 0
69 #endif /* no TRUE */
71 Lisp_Object Qdebug_on_next_call;
73 extern Lisp_Object Vmenu_updating_frame;
75 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
77 extern Lisp_Object QCtoggle, QCradio;
79 extern Lisp_Object Voverriding_local_map;
80 extern Lisp_Object Voverriding_local_map_menu_flag;
82 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
84 extern Lisp_Object Qmenu_bar_update_hook;
86 void set_frame_menubar P_ ((FRAME_PTR, int, int));
88 #if TARGET_API_MAC_CARBON
89 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
90 #else
91 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
92 #endif
94 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
95 Lisp_Object, Lisp_Object, Lisp_Object,
96 Lisp_Object, Lisp_Object));
97 #ifdef HAVE_DIALOGS
98 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
99 Lisp_Object, char **));
100 #endif
101 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
102 Lisp_Object, char **));
103 static void keymap_panes P_ ((Lisp_Object *, int, int));
104 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
105 int, int));
106 static void list_of_panes P_ ((Lisp_Object));
107 static void list_of_items P_ ((Lisp_Object));
110 /* This holds a Lisp vector that holds the results of decoding
111 the keymaps or alist-of-alists that specify a menu.
113 It describes the panes and items within the panes.
115 Each pane is described by 3 elements in the vector:
116 t, the pane name, the pane's prefix key.
117 Then follow the pane's items, with 5 elements per item:
118 the item string, the enable flag, the item's value,
119 the definition, and the equivalent keyboard key's description string.
121 In some cases, multiple levels of menus may be described.
122 A single vector slot containing nil indicates the start of a submenu.
123 A single vector slot containing lambda indicates the end of a submenu.
124 The submenu follows a menu item which is the way to reach the submenu.
126 A single vector slot containing quote indicates that the
127 following items should appear on the right of a dialog box.
129 Using a Lisp vector to hold this information while we decode it
130 takes care of protecting all the data from GC. */
132 #define MENU_ITEMS_PANE_NAME 1
133 #define MENU_ITEMS_PANE_PREFIX 2
134 #define MENU_ITEMS_PANE_LENGTH 3
136 enum menu_item_idx
138 MENU_ITEMS_ITEM_NAME = 0,
139 MENU_ITEMS_ITEM_ENABLE,
140 MENU_ITEMS_ITEM_VALUE,
141 MENU_ITEMS_ITEM_EQUIV_KEY,
142 MENU_ITEMS_ITEM_DEFINITION,
143 MENU_ITEMS_ITEM_TYPE,
144 MENU_ITEMS_ITEM_SELECTED,
145 MENU_ITEMS_ITEM_HELP,
146 MENU_ITEMS_ITEM_LENGTH
149 static Lisp_Object menu_items;
151 /* Number of slots currently allocated in menu_items. */
152 static int menu_items_allocated;
154 /* This is the index in menu_items of the first empty slot. */
155 static int menu_items_used;
157 /* The number of panes currently recorded in menu_items,
158 excluding those within submenus. */
159 static int menu_items_n_panes;
161 /* Current depth within submenus. */
162 static int menu_items_submenu_depth;
164 /* Nonzero means a menu is currently active. */
165 int popup_activated_flag;
167 /* This is set nonzero after the user activates the menu bar, and set
168 to zero again after the menu bars are redisplayed by prepare_menu_bar.
169 While it is nonzero, all calls to set_frame_menubar go deep.
171 I don't understand why this is needed, but it does seem to be
172 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
174 int pending_menu_activation;
176 /* Initialize the menu_items structure if we haven't already done so.
177 Also mark it as currently empty. */
179 static void
180 init_menu_items ()
182 if (NILP (menu_items))
184 menu_items_allocated = 60;
185 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
188 menu_items_used = 0;
189 menu_items_n_panes = 0;
190 menu_items_submenu_depth = 0;
193 /* Call at the end of generating the data in menu_items. */
195 static void
196 finish_menu_items ()
200 /* Call when finished using the data for the current menu
201 in menu_items. */
203 static void
204 discard_menu_items ()
206 /* Free the structure if it is especially large.
207 Otherwise, hold on to it, to save time. */
208 if (menu_items_allocated > 200)
210 menu_items = Qnil;
211 menu_items_allocated = 0;
215 /* This undoes save_menu_items, and it is called by the specpdl unwind
216 mechanism. */
218 static Lisp_Object
219 restore_menu_items (saved)
220 Lisp_Object saved;
222 menu_items = XCAR (saved);
223 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
224 saved = XCDR (saved);
225 menu_items_used = XINT (XCAR (saved));
226 saved = XCDR (saved);
227 menu_items_n_panes = XINT (XCAR (saved));
228 saved = XCDR (saved);
229 menu_items_submenu_depth = XINT (XCAR (saved));
230 return Qnil;
233 /* Push the whole state of menu_items processing onto the specpdl.
234 It will be restored when the specpdl is unwound. */
236 static void
237 save_menu_items ()
239 Lisp_Object saved = list4 (menu_items,
240 make_number (menu_items_used),
241 make_number (menu_items_n_panes),
242 make_number (menu_items_submenu_depth));
243 record_unwind_protect (restore_menu_items, saved);
244 menu_items = Qnil;
247 /* Make the menu_items vector twice as large. */
249 static void
250 grow_menu_items ()
252 Lisp_Object old;
253 int old_size = menu_items_allocated;
254 old = menu_items;
256 menu_items_allocated *= 2;
258 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
259 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
260 old_size * sizeof (Lisp_Object));
263 /* Begin a submenu. */
265 static void
266 push_submenu_start ()
268 if (menu_items_used + 1 > menu_items_allocated)
269 grow_menu_items ();
271 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
272 menu_items_submenu_depth++;
275 /* End a submenu. */
277 static void
278 push_submenu_end ()
280 if (menu_items_used + 1 > menu_items_allocated)
281 grow_menu_items ();
283 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
284 menu_items_submenu_depth--;
287 /* Indicate boundary between left and right. */
289 static void
290 push_left_right_boundary ()
292 if (menu_items_used + 1 > menu_items_allocated)
293 grow_menu_items ();
295 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
298 /* Start a new menu pane in menu_items.
299 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
301 static void
302 push_menu_pane (name, prefix_vec)
303 Lisp_Object name, prefix_vec;
305 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
306 grow_menu_items ();
308 if (menu_items_submenu_depth == 0)
309 menu_items_n_panes++;
310 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
311 XVECTOR (menu_items)->contents[menu_items_used++] = name;
312 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
315 /* Push one menu item into the current pane. NAME is the string to
316 display. ENABLE if non-nil means this item can be selected. KEY
317 is the key generated by choosing this item, or nil if this item
318 doesn't really have a definition. DEF is the definition of this
319 item. EQUIV is the textual description of the keyboard equivalent
320 for this item (or nil if none). TYPE is the type of this menu
321 item, one of nil, `toggle' or `radio'. */
323 static void
324 push_menu_item (name, enable, key, def, equiv, type, selected, help)
325 Lisp_Object name, enable, key, def, equiv, type, selected, help;
327 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
328 grow_menu_items ();
330 XVECTOR (menu_items)->contents[menu_items_used++] = name;
331 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
332 XVECTOR (menu_items)->contents[menu_items_used++] = key;
333 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
334 XVECTOR (menu_items)->contents[menu_items_used++] = def;
335 XVECTOR (menu_items)->contents[menu_items_used++] = type;
336 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
337 XVECTOR (menu_items)->contents[menu_items_used++] = help;
340 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
341 and generate menu panes for them in menu_items.
342 If NOTREAL is nonzero,
343 don't bother really computing whether an item is enabled. */
345 static void
346 keymap_panes (keymaps, nmaps, notreal)
347 Lisp_Object *keymaps;
348 int nmaps;
349 int notreal;
351 int mapno;
353 init_menu_items ();
355 /* Loop over the given keymaps, making a pane for each map.
356 But don't make a pane that is empty--ignore that map instead.
357 P is the number of panes we have made so far. */
358 for (mapno = 0; mapno < nmaps; mapno++)
359 single_keymap_panes (keymaps[mapno],
360 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
362 finish_menu_items ();
365 /* Args passed between single_keymap_panes and single_menu_item. */
366 struct skp
368 Lisp_Object pending_maps;
369 int maxdepth, notreal;
372 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
373 void *));
375 /* This is a recursive subroutine of keymap_panes.
376 It handles one keymap, KEYMAP.
377 The other arguments are passed along
378 or point to local variables of the previous function.
379 If NOTREAL is nonzero, only check for equivalent key bindings, don't
380 evaluate expressions in menu items and don't make any menu.
382 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
384 static void
385 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
386 Lisp_Object keymap;
387 Lisp_Object pane_name;
388 Lisp_Object prefix;
389 int notreal;
390 int maxdepth;
392 struct skp skp;
393 struct gcpro gcpro1;
395 skp.pending_maps = Qnil;
396 skp.maxdepth = maxdepth;
397 skp.notreal = notreal;
399 if (maxdepth <= 0)
400 return;
402 push_menu_pane (pane_name, prefix);
404 GCPRO1 (skp.pending_maps);
405 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
406 UNGCPRO;
408 /* Process now any submenus which want to be panes at this level. */
409 while (CONSP (skp.pending_maps))
411 Lisp_Object elt, eltcdr, string;
412 elt = XCAR (skp.pending_maps);
413 eltcdr = XCDR (elt);
414 string = XCAR (eltcdr);
415 /* We no longer discard the @ from the beginning of the string here.
416 Instead, we do this in mac_menu_show. */
417 single_keymap_panes (Fcar (elt), string,
418 XCDR (eltcdr), notreal, maxdepth - 1);
419 skp.pending_maps = XCDR (skp.pending_maps);
423 /* This is a subroutine of single_keymap_panes that handles one
424 keymap entry.
425 KEY is a key in a keymap and ITEM is its binding.
426 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
427 separate panes.
428 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
429 evaluate expressions in menu items and don't make any menu.
430 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
432 static void
433 single_menu_item (key, item, dummy, skp_v)
434 Lisp_Object key, item, dummy;
435 void *skp_v;
437 Lisp_Object map, item_string, enabled;
438 struct gcpro gcpro1, gcpro2;
439 int res;
440 struct skp *skp = skp_v;
442 /* Parse the menu item and leave the result in item_properties. */
443 GCPRO2 (key, item);
444 res = parse_menu_item (item, skp->notreal, 0);
445 UNGCPRO;
446 if (!res)
447 return; /* Not a menu item. */
449 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
451 if (skp->notreal)
453 /* We don't want to make a menu, just traverse the keymaps to
454 precompute equivalent key bindings. */
455 if (!NILP (map))
456 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
457 return;
460 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
461 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
463 if (!NILP (map) && SREF (item_string, 0) == '@')
465 if (!NILP (enabled))
466 /* An enabled separate pane. Remember this to handle it later. */
467 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
468 skp->pending_maps);
469 return;
472 push_menu_item (item_string, enabled, key,
473 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
474 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
475 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
476 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
477 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
479 /* Display a submenu using the toolkit. */
480 if (! (NILP (map) || NILP (enabled)))
482 push_submenu_start ();
483 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
484 push_submenu_end ();
488 /* Push all the panes and items of a menu described by the
489 alist-of-alists MENU.
490 This handles old-fashioned calls to x-popup-menu. */
492 static void
493 list_of_panes (menu)
494 Lisp_Object menu;
496 Lisp_Object tail;
498 init_menu_items ();
500 for (tail = menu; CONSP (tail); tail = XCDR (tail))
502 Lisp_Object elt, pane_name, pane_data;
503 elt = XCAR (tail);
504 pane_name = Fcar (elt);
505 CHECK_STRING (pane_name);
506 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
507 pane_data = Fcdr (elt);
508 CHECK_CONS (pane_data);
509 list_of_items (pane_data);
512 finish_menu_items ();
515 /* Push the items in a single pane defined by the alist PANE. */
517 static void
518 list_of_items (pane)
519 Lisp_Object pane;
521 Lisp_Object tail, item, item1;
523 for (tail = pane; CONSP (tail); tail = XCDR (tail))
525 item = XCAR (tail);
526 if (STRINGP (item))
527 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
528 Qnil, Qnil, Qnil, Qnil);
529 else if (CONSP (item))
531 item1 = XCAR (item);
532 CHECK_STRING (item1);
533 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
534 Qt, Qnil, Qnil, Qnil, Qnil);
536 else
537 push_left_right_boundary ();
542 static Lisp_Object
543 cleanup_popup_menu (arg)
544 Lisp_Object arg;
546 discard_menu_items ();
547 return Qnil;
550 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
551 doc: /* Pop up a deck-of-cards menu and return user's selection.
552 POSITION is a position specification. This is either a mouse button event
553 or a list ((XOFFSET YOFFSET) WINDOW)
554 where XOFFSET and YOFFSET are positions in pixels from the top left
555 corner of WINDOW. (WINDOW may be a window or a frame object.)
556 This controls the position of the top left of the menu as a whole.
557 If POSITION is t, it means to use the current mouse position.
559 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
560 The menu items come from key bindings that have a menu string as well as
561 a definition; actually, the "definition" in such a key binding looks like
562 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
563 the keymap as a top-level element.
565 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
566 Otherwise, REAL-DEFINITION should be a valid key binding definition.
568 You can also use a list of keymaps as MENU.
569 Then each keymap makes a separate pane.
571 When MENU is a keymap or a list of keymaps, the return value is the
572 list of events corresponding to the user's choice. Note that
573 `x-popup-menu' does not actually execute the command bound to that
574 sequence of events.
576 Alternatively, you can specify a menu of multiple panes
577 with a list of the form (TITLE PANE1 PANE2...),
578 where each pane is a list of form (TITLE ITEM1 ITEM2...).
579 Each ITEM is normally a cons cell (STRING . VALUE);
580 but a string can appear as an item--that makes a nonselectable line
581 in the menu.
582 With this form of menu, the return value is VALUE from the chosen item.
584 If POSITION is nil, don't display the menu at all, just precalculate the
585 cached information about equivalent key sequences.
587 If the user gets rid of the menu without making a valid choice, for
588 instance by clicking the mouse away from a valid choice or by typing
589 keyboard input, then this normally results in a quit and
590 `x-popup-menu' does not return. But if POSITION is a mouse button
591 event (indicating that the user invoked the menu with the mouse) then
592 no quit occurs and `x-popup-menu' returns nil. */)
593 (position, menu)
594 Lisp_Object position, menu;
596 Lisp_Object keymap, tem;
597 int xpos = 0, ypos = 0;
598 Lisp_Object title;
599 char *error_name = NULL;
600 Lisp_Object selection;
601 FRAME_PTR f = NULL;
602 Lisp_Object x, y, window;
603 int keymaps = 0;
604 int for_click = 0;
605 int specpdl_count = SPECPDL_INDEX ();
606 struct gcpro gcpro1;
608 #ifdef HAVE_MENUS
609 if (! NILP (position))
611 check_mac ();
613 /* Decode the first argument: find the window and the coordinates. */
614 if (EQ (position, Qt)
615 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
616 || EQ (XCAR (position), Qtool_bar)
617 || EQ (XCAR (position), Qmac_apple_event))))
619 /* Use the mouse's current position. */
620 FRAME_PTR new_f = SELECTED_FRAME ();
621 Lisp_Object bar_window;
622 enum scroll_bar_part part;
623 unsigned long time;
625 if (mouse_position_hook)
626 (*mouse_position_hook) (&new_f, 1, &bar_window,
627 &part, &x, &y, &time);
628 if (new_f != 0)
629 XSETFRAME (window, new_f);
630 else
632 window = selected_window;
633 XSETFASTINT (x, 0);
634 XSETFASTINT (y, 0);
637 else
639 tem = Fcar (position);
640 if (CONSP (tem))
642 window = Fcar (Fcdr (position));
643 x = XCAR (tem);
644 y = Fcar (XCDR (tem));
646 else
648 for_click = 1;
649 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
650 window = Fcar (tem); /* POSN_WINDOW (tem) */
651 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
652 x = Fcar (tem);
653 y = Fcdr (tem);
657 CHECK_NUMBER (x);
658 CHECK_NUMBER (y);
660 /* Decode where to put the menu. */
662 if (FRAMEP (window))
664 f = XFRAME (window);
665 xpos = 0;
666 ypos = 0;
668 else if (WINDOWP (window))
670 CHECK_LIVE_WINDOW (window);
671 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
673 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
674 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
676 else
677 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
678 but I don't want to make one now. */
679 CHECK_WINDOW (window);
681 xpos += XINT (x);
682 ypos += XINT (y);
684 XSETFRAME (Vmenu_updating_frame, f);
686 else
687 Vmenu_updating_frame = Qnil;
688 #endif /* HAVE_MENUS */
690 title = Qnil;
691 GCPRO1 (title);
693 /* Decode the menu items from what was specified. */
695 keymap = get_keymap (menu, 0, 0);
696 if (CONSP (keymap))
698 /* We were given a keymap. Extract menu info from the keymap. */
699 Lisp_Object prompt;
701 /* Extract the detailed info to make one pane. */
702 keymap_panes (&menu, 1, NILP (position));
704 /* Search for a string appearing directly as an element of the keymap.
705 That string is the title of the menu. */
706 prompt = Fkeymap_prompt (keymap);
707 if (NILP (title) && !NILP (prompt))
708 title = prompt;
710 /* Make that be the pane title of the first pane. */
711 if (!NILP (prompt) && menu_items_n_panes >= 0)
712 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
714 keymaps = 1;
716 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
718 /* We were given a list of keymaps. */
719 int nmaps = XFASTINT (Flength (menu));
720 Lisp_Object *maps
721 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
722 int i;
724 title = Qnil;
726 /* The first keymap that has a prompt string
727 supplies the menu title. */
728 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
730 Lisp_Object prompt;
732 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
734 prompt = Fkeymap_prompt (keymap);
735 if (NILP (title) && !NILP (prompt))
736 title = prompt;
739 /* Extract the detailed info to make one pane. */
740 keymap_panes (maps, nmaps, NILP (position));
742 /* Make the title be the pane title of the first pane. */
743 if (!NILP (title) && menu_items_n_panes >= 0)
744 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
746 keymaps = 1;
748 else
750 /* We were given an old-fashioned menu. */
751 title = Fcar (menu);
752 CHECK_STRING (title);
754 list_of_panes (Fcdr (menu));
756 keymaps = 0;
759 if (NILP (position))
761 discard_menu_items ();
762 UNGCPRO;
763 return Qnil;
766 #ifdef HAVE_MENUS
767 /* Display them in a menu. */
768 record_unwind_protect (cleanup_popup_menu, Qnil);
769 BLOCK_INPUT;
771 selection = mac_menu_show (f, xpos, ypos, for_click,
772 keymaps, title, &error_name);
773 UNBLOCK_INPUT;
774 unbind_to (specpdl_count, Qnil);
776 UNGCPRO;
777 #endif /* HAVE_MENUS */
779 if (error_name) error (error_name);
780 return selection;
783 #ifdef HAVE_MENUS
785 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
786 doc: /* Pop up a dialog box and return user's selection.
787 POSITION specifies which frame to use.
788 This is normally a mouse button event or a window or frame.
789 If POSITION is t, it means to use the frame the mouse is on.
790 The dialog box appears in the middle of the specified frame.
792 CONTENTS specifies the alternatives to display in the dialog box.
793 It is a list of the form (DIALOG ITEM1 ITEM2...).
794 Each ITEM is a cons cell (STRING . VALUE).
795 The return value is VALUE from the chosen item.
797 An ITEM may also be just a string--that makes a nonselectable item.
798 An ITEM may also be nil--that means to put all preceding items
799 on the left of the dialog box and all following items on the right.
800 \(By default, approximately half appear on each side.)
802 If HEADER is non-nil, the frame title for the box is "Information",
803 otherwise it is "Question".
805 If the user gets rid of the dialog box without making a valid choice,
806 for instance using the window manager, then this produces a quit and
807 `x-popup-dialog' does not return. */)
808 (position, contents, header)
809 Lisp_Object position, contents, header;
811 FRAME_PTR f = NULL;
812 Lisp_Object window;
814 check_mac ();
816 /* Decode the first argument: find the window or frame to use. */
817 if (EQ (position, Qt)
818 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
819 || EQ (XCAR (position), Qtool_bar)
820 || EQ (XCAR (position), Qmac_apple_event))))
822 #if 0 /* Using the frame the mouse is on may not be right. */
823 /* Use the mouse's current position. */
824 FRAME_PTR new_f = SELECTED_FRAME ();
825 Lisp_Object bar_window;
826 enum scroll_bar_part part;
827 unsigned long time;
828 Lisp_Object x, y;
830 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
832 if (new_f != 0)
833 XSETFRAME (window, new_f);
834 else
835 window = selected_window;
836 #endif
837 window = selected_window;
839 else if (CONSP (position))
841 Lisp_Object tem;
842 tem = Fcar (position);
843 if (CONSP (tem))
844 window = Fcar (Fcdr (position));
845 else
847 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
848 window = Fcar (tem); /* POSN_WINDOW (tem) */
851 else if (WINDOWP (position) || FRAMEP (position))
852 window = position;
853 else
854 window = Qnil;
856 /* Decode where to put the menu. */
858 if (FRAMEP (window))
859 f = XFRAME (window);
860 else if (WINDOWP (window))
862 CHECK_LIVE_WINDOW (window);
863 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
865 else
866 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
867 but I don't want to make one now. */
868 CHECK_WINDOW (window);
870 #ifndef HAVE_DIALOGS
871 /* Display a menu with these alternatives
872 in the middle of frame F. */
874 Lisp_Object x, y, frame, newpos;
875 XSETFRAME (frame, f);
876 XSETINT (x, x_pixel_width (f) / 2);
877 XSETINT (y, x_pixel_height (f) / 2);
878 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
880 return Fx_popup_menu (newpos,
881 Fcons (Fcar (contents), Fcons (contents, Qnil)));
883 #else /* HAVE_DIALOGS */
885 Lisp_Object title;
886 char *error_name;
887 Lisp_Object selection;
888 int specpdl_count = SPECPDL_INDEX ();
890 /* Decode the dialog items from what was specified. */
891 title = Fcar (contents);
892 CHECK_STRING (title);
894 list_of_panes (Fcons (contents, Qnil));
896 /* Display them in a dialog box. */
897 record_unwind_protect (cleanup_popup_menu, Qnil);
898 BLOCK_INPUT;
899 selection = mac_dialog_show (f, 0, title, header, &error_name);
900 UNBLOCK_INPUT;
901 unbind_to (specpdl_count, Qnil);
903 if (error_name) error (error_name);
904 return selection;
906 #endif /* HAVE_DIALOGS */
909 /* Find the menu selection and store it in the keyboard buffer.
910 F is the frame the menu is on.
911 MENU_BAR_ITEMS_USED is the length of VECTOR.
912 VECTOR is an array of menu events for the whole menu. */
914 void
915 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
916 FRAME_PTR f;
917 int menu_bar_items_used;
918 Lisp_Object vector;
919 void *client_data;
921 Lisp_Object prefix, entry;
922 Lisp_Object *subprefix_stack;
923 int submenu_depth = 0;
924 int i;
926 entry = Qnil;
927 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
928 prefix = Qnil;
929 i = 0;
931 while (i < menu_bar_items_used)
933 if (EQ (XVECTOR (vector)->contents[i], Qnil))
935 subprefix_stack[submenu_depth++] = prefix;
936 prefix = entry;
937 i++;
939 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
941 prefix = subprefix_stack[--submenu_depth];
942 i++;
944 else if (EQ (XVECTOR (vector)->contents[i], Qt))
946 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
947 i += MENU_ITEMS_PANE_LENGTH;
949 else
951 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
952 /* The EMACS_INT cast avoids a warning. There's no problem
953 as long as pointers have enough bits to hold small integers. */
954 if ((int) (EMACS_INT) client_data == i)
956 int j;
957 struct input_event buf;
958 Lisp_Object frame;
959 EVENT_INIT (buf);
961 XSETFRAME (frame, f);
962 buf.kind = MENU_BAR_EVENT;
963 buf.frame_or_window = frame;
964 buf.arg = frame;
965 kbd_buffer_store_event (&buf);
967 for (j = 0; j < submenu_depth; j++)
968 if (!NILP (subprefix_stack[j]))
970 buf.kind = MENU_BAR_EVENT;
971 buf.frame_or_window = frame;
972 buf.arg = subprefix_stack[j];
973 kbd_buffer_store_event (&buf);
976 if (!NILP (prefix))
978 buf.kind = MENU_BAR_EVENT;
979 buf.frame_or_window = frame;
980 buf.arg = prefix;
981 kbd_buffer_store_event (&buf);
984 buf.kind = MENU_BAR_EVENT;
985 buf.frame_or_window = frame;
986 buf.arg = entry;
987 kbd_buffer_store_event (&buf);
989 return;
991 i += MENU_ITEMS_ITEM_LENGTH;
996 /* Allocate a widget_value, blocking input. */
998 widget_value *
999 xmalloc_widget_value ()
1001 widget_value *value;
1003 BLOCK_INPUT;
1004 value = malloc_widget_value ();
1005 UNBLOCK_INPUT;
1007 return value;
1010 /* This recursively calls free_widget_value on the tree of widgets.
1011 It must free all data that was malloc'ed for these widget_values.
1012 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1013 must be left alone. */
1015 void
1016 free_menubar_widget_value_tree (wv)
1017 widget_value *wv;
1019 if (! wv) return;
1021 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1023 if (wv->contents && (wv->contents != (widget_value*)1))
1025 free_menubar_widget_value_tree (wv->contents);
1026 wv->contents = (widget_value *) 0xDEADBEEF;
1028 if (wv->next)
1030 free_menubar_widget_value_tree (wv->next);
1031 wv->next = (widget_value *) 0xDEADBEEF;
1033 BLOCK_INPUT;
1034 free_widget_value (wv);
1035 UNBLOCK_INPUT;
1038 /* Set up data in menu_items for a menu bar item
1039 whose event type is ITEM_KEY (with string ITEM_NAME)
1040 and whose contents come from the list of keymaps MAPS. */
1042 static int
1043 parse_single_submenu (item_key, item_name, maps)
1044 Lisp_Object item_key, item_name, maps;
1046 Lisp_Object length;
1047 int len;
1048 Lisp_Object *mapvec;
1049 int i;
1050 int top_level_items = 0;
1052 length = Flength (maps);
1053 len = XINT (length);
1055 /* Convert the list MAPS into a vector MAPVEC. */
1056 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1057 for (i = 0; i < len; i++)
1059 mapvec[i] = Fcar (maps);
1060 maps = Fcdr (maps);
1063 /* Loop over the given keymaps, making a pane for each map.
1064 But don't make a pane that is empty--ignore that map instead. */
1065 for (i = 0; i < len; i++)
1067 if (!KEYMAPP (mapvec[i]))
1069 /* Here we have a command at top level in the menu bar
1070 as opposed to a submenu. */
1071 top_level_items = 1;
1072 push_menu_pane (Qnil, Qnil);
1073 push_menu_item (item_name, Qt, item_key, mapvec[i],
1074 Qnil, Qnil, Qnil, Qnil);
1076 else
1078 Lisp_Object prompt;
1079 prompt = Fkeymap_prompt (mapvec[i]);
1080 single_keymap_panes (mapvec[i],
1081 !NILP (prompt) ? prompt : item_name,
1082 item_key, 0, 10);
1086 return top_level_items;
1089 /* Create a tree of widget_value objects
1090 representing the panes and items
1091 in menu_items starting at index START, up to index END. */
1093 static widget_value *
1094 digest_single_submenu (start, end, top_level_items)
1095 int start, end, top_level_items;
1097 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1098 int i;
1099 int submenu_depth = 0;
1100 widget_value **submenu_stack;
1101 int panes_seen = 0;
1103 submenu_stack
1104 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1105 wv = xmalloc_widget_value ();
1106 wv->name = "menu";
1107 wv->value = 0;
1108 wv->enabled = 1;
1109 wv->button_type = BUTTON_TYPE_NONE;
1110 wv->help = Qnil;
1111 first_wv = wv;
1112 save_wv = 0;
1113 prev_wv = 0;
1115 /* Loop over all panes and items made by the preceding call
1116 to parse_single_submenu and construct a tree of widget_value objects.
1117 Ignore the panes and items used by previous calls to
1118 digest_single_submenu, even though those are also in menu_items. */
1119 i = start;
1120 while (i < end)
1122 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1124 submenu_stack[submenu_depth++] = save_wv;
1125 save_wv = prev_wv;
1126 prev_wv = 0;
1127 i++;
1129 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1131 prev_wv = save_wv;
1132 save_wv = submenu_stack[--submenu_depth];
1133 i++;
1135 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1136 && submenu_depth != 0)
1137 i += MENU_ITEMS_PANE_LENGTH;
1138 /* Ignore a nil in the item list.
1139 It's meaningful only for dialog boxes. */
1140 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1141 i += 1;
1142 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1144 /* Create a new pane. */
1145 Lisp_Object pane_name, prefix;
1146 char *pane_string;
1148 panes_seen++;
1150 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1151 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1153 #ifndef HAVE_MULTILINGUAL_MENU
1154 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1156 pane_name = ENCODE_MENU_STRING (pane_name);
1157 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1159 #endif
1160 pane_string = (NILP (pane_name)
1161 ? "" : (char *) SDATA (pane_name));
1162 /* If there is just one top-level pane, put all its items directly
1163 under the top-level menu. */
1164 if (menu_items_n_panes == 1)
1165 pane_string = "";
1167 /* If the pane has a meaningful name,
1168 make the pane a top-level menu item
1169 with its items as a submenu beneath it. */
1170 if (strcmp (pane_string, ""))
1172 wv = xmalloc_widget_value ();
1173 if (save_wv)
1174 save_wv->next = wv;
1175 else
1176 first_wv->contents = wv;
1177 wv->lname = pane_name;
1178 /* Set value to 1 so update_submenu_strings can handle '@' */
1179 wv->value = (char *)1;
1180 wv->enabled = 1;
1181 wv->button_type = BUTTON_TYPE_NONE;
1182 wv->help = Qnil;
1183 save_wv = wv;
1185 else
1186 save_wv = first_wv;
1188 prev_wv = 0;
1189 i += MENU_ITEMS_PANE_LENGTH;
1191 else
1193 /* Create a new item within current pane. */
1194 Lisp_Object item_name, enable, descrip, def, type, selected;
1195 Lisp_Object help;
1197 /* All items should be contained in panes. */
1198 if (panes_seen == 0)
1199 abort ();
1201 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1202 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1203 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1204 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1205 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1206 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1207 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1209 #ifndef HAVE_MULTILINGUAL_MENU
1210 if (STRING_MULTIBYTE (item_name))
1212 item_name = ENCODE_MENU_STRING (item_name);
1213 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1216 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1218 descrip = ENCODE_MENU_STRING (descrip);
1219 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1221 #endif /* not HAVE_MULTILINGUAL_MENU */
1223 wv = xmalloc_widget_value ();
1224 if (prev_wv)
1225 prev_wv->next = wv;
1226 else
1227 save_wv->contents = wv;
1229 wv->lname = item_name;
1230 if (!NILP (descrip))
1231 wv->lkey = descrip;
1232 wv->value = 0;
1233 /* The EMACS_INT cast avoids a warning. There's no problem
1234 as long as pointers have enough bits to hold small integers. */
1235 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1236 wv->enabled = !NILP (enable);
1238 if (NILP (type))
1239 wv->button_type = BUTTON_TYPE_NONE;
1240 else if (EQ (type, QCradio))
1241 wv->button_type = BUTTON_TYPE_RADIO;
1242 else if (EQ (type, QCtoggle))
1243 wv->button_type = BUTTON_TYPE_TOGGLE;
1244 else
1245 abort ();
1247 wv->selected = !NILP (selected);
1248 if (! STRINGP (help))
1249 help = Qnil;
1251 wv->help = help;
1253 prev_wv = wv;
1255 i += MENU_ITEMS_ITEM_LENGTH;
1259 /* If we have just one "menu item"
1260 that was originally a button, return it by itself. */
1261 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1263 wv = first_wv->contents;
1264 free_widget_value (first_wv);
1265 return wv;
1268 return first_wv;
1271 /* Walk through the widget_value tree starting at FIRST_WV and update
1272 the char * pointers from the corresponding lisp values.
1273 We do this after building the whole tree, since GC may happen while the
1274 tree is constructed, and small strings are relocated. So we must wait
1275 until no GC can happen before storing pointers into lisp values. */
1276 static void
1277 update_submenu_strings (first_wv)
1278 widget_value *first_wv;
1280 widget_value *wv;
1282 for (wv = first_wv; wv; wv = wv->next)
1284 if (STRINGP (wv->lname))
1286 wv->name = SDATA (wv->lname);
1288 /* Ignore the @ that means "separate pane".
1289 This is a kludge, but this isn't worth more time. */
1290 if (wv->value == (char *)1)
1292 if (wv->name[0] == '@')
1293 wv->name++;
1294 wv->value = 0;
1298 if (STRINGP (wv->lkey))
1299 wv->key = SDATA (wv->lkey);
1301 if (wv->contents)
1302 update_submenu_strings (wv->contents);
1307 /* Set the contents of the menubar widgets of frame F.
1308 The argument FIRST_TIME is currently ignored;
1309 it is set the first time this is called, from initialize_frame_menubar. */
1311 void
1312 set_frame_menubar (f, first_time, deep_p)
1313 FRAME_PTR f;
1314 int first_time;
1315 int deep_p;
1317 int menubar_widget = f->output_data.mac->menubar_widget;
1318 Lisp_Object items;
1319 widget_value *wv, *first_wv, *prev_wv = 0;
1320 int i, last_i = 0;
1321 int *submenu_start, *submenu_end;
1322 int *submenu_top_level_items, *submenu_n_panes;
1324 XSETFRAME (Vmenu_updating_frame, f);
1326 /* This seems to be unnecessary for Carbon. */
1327 #if 0
1328 if (! menubar_widget)
1329 deep_p = 1;
1330 else if (pending_menu_activation && !deep_p)
1331 deep_p = 1;
1332 #endif
1334 if (deep_p)
1336 /* Make a widget-value tree representing the entire menu trees. */
1338 struct buffer *prev = current_buffer;
1339 Lisp_Object buffer;
1340 int specpdl_count = SPECPDL_INDEX ();
1341 int previous_menu_items_used = f->menu_bar_items_used;
1342 Lisp_Object *previous_items
1343 = (Lisp_Object *) alloca (previous_menu_items_used
1344 * sizeof (Lisp_Object));
1346 /* If we are making a new widget, its contents are empty,
1347 do always reinitialize them. */
1348 if (! menubar_widget)
1349 previous_menu_items_used = 0;
1351 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1352 specbind (Qinhibit_quit, Qt);
1353 /* Don't let the debugger step into this code
1354 because it is not reentrant. */
1355 specbind (Qdebug_on_next_call, Qnil);
1357 record_unwind_save_match_data ();
1358 if (NILP (Voverriding_local_map_menu_flag))
1360 specbind (Qoverriding_terminal_local_map, Qnil);
1361 specbind (Qoverriding_local_map, Qnil);
1364 set_buffer_internal_1 (XBUFFER (buffer));
1366 /* Run the Lucid hook. */
1367 safe_run_hooks (Qactivate_menubar_hook);
1369 /* If it has changed current-menubar from previous value,
1370 really recompute the menubar from the value. */
1371 if (! NILP (Vlucid_menu_bar_dirty_flag))
1372 call0 (Qrecompute_lucid_menubar);
1373 safe_run_hooks (Qmenu_bar_update_hook);
1374 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1376 items = FRAME_MENU_BAR_ITEMS (f);
1378 /* Save the frame's previous menu bar contents data. */
1379 if (previous_menu_items_used)
1380 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1381 previous_menu_items_used * sizeof (Lisp_Object));
1383 /* Fill in menu_items with the current menu bar contents.
1384 This can evaluate Lisp code. */
1385 save_menu_items ();
1387 menu_items = f->menu_bar_vector;
1388 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1389 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1390 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1391 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1392 submenu_top_level_items
1393 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1394 init_menu_items ();
1395 for (i = 0; i < XVECTOR (items)->size; i += 4)
1397 Lisp_Object key, string, maps;
1399 last_i = i;
1401 key = XVECTOR (items)->contents[i];
1402 string = XVECTOR (items)->contents[i + 1];
1403 maps = XVECTOR (items)->contents[i + 2];
1404 if (NILP (string))
1405 break;
1407 submenu_start[i] = menu_items_used;
1409 menu_items_n_panes = 0;
1410 submenu_top_level_items[i]
1411 = parse_single_submenu (key, string, maps);
1412 submenu_n_panes[i] = menu_items_n_panes;
1414 submenu_end[i] = menu_items_used;
1417 finish_menu_items ();
1419 /* Convert menu_items into widget_value trees
1420 to display the menu. This cannot evaluate Lisp code. */
1422 wv = xmalloc_widget_value ();
1423 wv->name = "menubar";
1424 wv->value = 0;
1425 wv->enabled = 1;
1426 wv->button_type = BUTTON_TYPE_NONE;
1427 wv->help = Qnil;
1428 first_wv = wv;
1430 for (i = 0; i < last_i; i += 4)
1432 menu_items_n_panes = submenu_n_panes[i];
1433 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1434 submenu_top_level_items[i]);
1435 if (prev_wv)
1436 prev_wv->next = wv;
1437 else
1438 first_wv->contents = wv;
1439 /* Don't set wv->name here; GC during the loop might relocate it. */
1440 wv->enabled = 1;
1441 wv->button_type = BUTTON_TYPE_NONE;
1442 prev_wv = wv;
1445 set_buffer_internal_1 (prev);
1447 /* If there has been no change in the Lisp-level contents
1448 of the menu bar, skip redisplaying it. Just exit. */
1450 /* Compare the new menu items with the ones computed last time. */
1451 for (i = 0; i < previous_menu_items_used; i++)
1452 if (menu_items_used == i
1453 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1454 break;
1455 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1457 /* The menu items have not changed. Don't bother updating
1458 the menus in any form, since it would be a no-op. */
1459 free_menubar_widget_value_tree (first_wv);
1460 discard_menu_items ();
1461 unbind_to (specpdl_count, Qnil);
1462 return;
1465 /* The menu items are different, so store them in the frame. */
1466 f->menu_bar_vector = menu_items;
1467 f->menu_bar_items_used = menu_items_used;
1469 /* This calls restore_menu_items to restore menu_items, etc.,
1470 as they were outside. */
1471 unbind_to (specpdl_count, Qnil);
1473 /* Now GC cannot happen during the lifetime of the widget_value,
1474 so it's safe to store data from a Lisp_String. */
1475 wv = first_wv->contents;
1476 for (i = 0; i < XVECTOR (items)->size; i += 4)
1478 Lisp_Object string;
1479 string = XVECTOR (items)->contents[i + 1];
1480 if (NILP (string))
1481 break;
1482 wv->name = (char *) SDATA (string);
1483 update_submenu_strings (wv->contents);
1484 wv = wv->next;
1488 else
1490 /* Make a widget-value tree containing
1491 just the top level menu bar strings. */
1493 wv = xmalloc_widget_value ();
1494 wv->name = "menubar";
1495 wv->value = 0;
1496 wv->enabled = 1;
1497 wv->button_type = BUTTON_TYPE_NONE;
1498 wv->help = Qnil;
1499 first_wv = wv;
1501 items = FRAME_MENU_BAR_ITEMS (f);
1502 for (i = 0; i < XVECTOR (items)->size; i += 4)
1504 Lisp_Object string;
1506 string = XVECTOR (items)->contents[i + 1];
1507 if (NILP (string))
1508 break;
1510 wv = xmalloc_widget_value ();
1511 wv->name = (char *) SDATA (string);
1512 wv->value = 0;
1513 wv->enabled = 1;
1514 wv->button_type = BUTTON_TYPE_NONE;
1515 wv->help = Qnil;
1516 /* This prevents lwlib from assuming this
1517 menu item is really supposed to be empty. */
1518 /* The EMACS_INT cast avoids a warning.
1519 This value just has to be different from small integers. */
1520 wv->call_data = (void *) (EMACS_INT) (-1);
1522 if (prev_wv)
1523 prev_wv->next = wv;
1524 else
1525 first_wv->contents = wv;
1526 prev_wv = wv;
1529 /* Forget what we thought we knew about what is in the
1530 detailed contents of the menu bar menus.
1531 Changing the top level always destroys the contents. */
1532 f->menu_bar_items_used = 0;
1535 /* Create or update the menu bar widget. */
1537 BLOCK_INPUT;
1539 /* Non-null value to indicate menubar has already been "created". */
1540 f->output_data.mac->menubar_widget = 1;
1542 mac_fill_menubar (first_wv->contents, deep_p);
1544 free_menubar_widget_value_tree (first_wv);
1546 UNBLOCK_INPUT;
1549 /* Get rid of the menu bar of frame F, and free its storage.
1550 This is used when deleting a frame, and when turning off the menu bar. */
1552 void
1553 free_frame_menubar (f)
1554 FRAME_PTR f;
1556 f->output_data.mac->menubar_widget = 0;
1560 /* The item selected in the popup menu. */
1561 int menu_item_selection;
1563 /* Mac_menu_show actually displays a menu using the panes and items in
1564 menu_items and returns the value selected from it; we assume input
1565 is blocked by the caller. */
1567 /* F is the frame the menu is for.
1568 X and Y are the frame-relative specified position,
1569 relative to the inside upper left corner of the frame F.
1570 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1571 KEYMAPS is 1 if this menu was specified with keymaps;
1572 in that case, we return a list containing the chosen item's value
1573 and perhaps also the pane's prefix.
1574 TITLE is the specified menu title.
1575 ERROR is a place to store an error message string in case of failure.
1576 (We return nil on failure, but the value doesn't actually matter.) */
1578 static Lisp_Object
1579 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1580 FRAME_PTR f;
1581 int x;
1582 int y;
1583 int for_click;
1584 int keymaps;
1585 Lisp_Object title;
1586 char **error;
1588 int i;
1589 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1590 widget_value **submenu_stack
1591 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1592 Lisp_Object *subprefix_stack
1593 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1594 int submenu_depth = 0;
1596 int first_pane;
1598 *error = NULL;
1600 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1602 *error = "Empty menu";
1603 return Qnil;
1606 /* Create a tree of widget_value objects
1607 representing the panes and their items. */
1608 wv = xmalloc_widget_value ();
1609 wv->name = "menu";
1610 wv->value = 0;
1611 wv->enabled = 1;
1612 wv->button_type = BUTTON_TYPE_NONE;
1613 wv->help = Qnil;
1614 first_wv = wv;
1615 first_pane = 1;
1617 /* Loop over all panes and items, filling in the tree. */
1618 i = 0;
1619 while (i < menu_items_used)
1621 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1623 submenu_stack[submenu_depth++] = save_wv;
1624 save_wv = prev_wv;
1625 prev_wv = 0;
1626 first_pane = 1;
1627 i++;
1629 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1631 prev_wv = save_wv;
1632 save_wv = submenu_stack[--submenu_depth];
1633 first_pane = 0;
1634 i++;
1636 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1637 && submenu_depth != 0)
1638 i += MENU_ITEMS_PANE_LENGTH;
1639 /* Ignore a nil in the item list.
1640 It's meaningful only for dialog boxes. */
1641 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1642 i += 1;
1643 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1645 /* Create a new pane. */
1646 Lisp_Object pane_name, prefix;
1647 char *pane_string;
1649 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1650 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1652 #ifndef HAVE_MULTILINGUAL_MENU
1653 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1655 pane_name = ENCODE_MENU_STRING (pane_name);
1656 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1658 #endif
1659 pane_string = (NILP (pane_name)
1660 ? "" : (char *) SDATA (pane_name));
1661 /* If there is just one top-level pane, put all its items directly
1662 under the top-level menu. */
1663 if (menu_items_n_panes == 1)
1664 pane_string = "";
1666 /* If the pane has a meaningful name,
1667 make the pane a top-level menu item
1668 with its items as a submenu beneath it. */
1669 if (!keymaps && strcmp (pane_string, ""))
1671 wv = xmalloc_widget_value ();
1672 if (save_wv)
1673 save_wv->next = wv;
1674 else
1675 first_wv->contents = wv;
1676 wv->name = pane_string;
1677 if (keymaps && !NILP (prefix))
1678 wv->name++;
1679 wv->value = 0;
1680 wv->enabled = 1;
1681 wv->button_type = BUTTON_TYPE_NONE;
1682 wv->help = Qnil;
1683 save_wv = wv;
1684 prev_wv = 0;
1686 else if (first_pane)
1688 save_wv = wv;
1689 prev_wv = 0;
1691 first_pane = 0;
1692 i += MENU_ITEMS_PANE_LENGTH;
1694 else
1696 /* Create a new item within current pane. */
1697 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1698 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1699 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1700 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1701 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1702 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1703 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1704 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1706 #ifndef HAVE_MULTILINGUAL_MENU
1707 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1709 item_name = ENCODE_MENU_STRING (item_name);
1710 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1713 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1715 descrip = ENCODE_MENU_STRING (descrip);
1716 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1718 #endif /* not HAVE_MULTILINGUAL_MENU */
1720 wv = xmalloc_widget_value ();
1721 if (prev_wv)
1722 prev_wv->next = wv;
1723 else
1724 save_wv->contents = wv;
1725 wv->name = (char *) SDATA (item_name);
1726 if (!NILP (descrip))
1727 wv->key = (char *) SDATA (descrip);
1728 wv->value = 0;
1729 /* Use the contents index as call_data, since we are
1730 restricted to 16-bits. */
1731 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1732 wv->enabled = !NILP (enable);
1734 if (NILP (type))
1735 wv->button_type = BUTTON_TYPE_NONE;
1736 else if (EQ (type, QCtoggle))
1737 wv->button_type = BUTTON_TYPE_TOGGLE;
1738 else if (EQ (type, QCradio))
1739 wv->button_type = BUTTON_TYPE_RADIO;
1740 else
1741 abort ();
1743 wv->selected = !NILP (selected);
1745 if (! STRINGP (help))
1746 help = Qnil;
1748 wv->help = help;
1750 prev_wv = wv;
1752 i += MENU_ITEMS_ITEM_LENGTH;
1756 /* Deal with the title, if it is non-nil. */
1757 if (!NILP (title))
1759 widget_value *wv_title = xmalloc_widget_value ();
1760 widget_value *wv_sep = xmalloc_widget_value ();
1762 /* Maybe replace this separator with a bitmap or owner-draw item
1763 so that it looks better. Having two separators looks odd. */
1764 wv_sep->name = "--";
1765 wv_sep->next = first_wv->contents;
1766 wv_sep->help = Qnil;
1768 #ifndef HAVE_MULTILINGUAL_MENU
1769 if (STRING_MULTIBYTE (title))
1770 title = ENCODE_MENU_STRING (title);
1771 #endif
1773 wv_title->name = (char *) SDATA (title);
1774 wv_title->enabled = FALSE;
1775 wv_title->title = TRUE;
1776 wv_title->button_type = BUTTON_TYPE_NONE;
1777 wv_title->help = Qnil;
1778 wv_title->next = wv_sep;
1779 first_wv->contents = wv_title;
1782 /* No selection has been chosen yet. */
1783 menu_item_selection = 0;
1785 /* Actually create and show the menu until popped down. */
1786 create_and_show_popup_menu (f, first_wv, x, y, for_click);
1788 /* Free the widget_value objects we used to specify the contents. */
1789 free_menubar_widget_value_tree (first_wv);
1791 /* Find the selected item, and its pane, to return
1792 the proper value. */
1793 if (menu_item_selection != 0)
1795 Lisp_Object prefix, entry;
1797 prefix = entry = Qnil;
1798 i = 0;
1799 while (i < menu_items_used)
1801 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1803 subprefix_stack[submenu_depth++] = prefix;
1804 prefix = entry;
1805 i++;
1807 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1809 prefix = subprefix_stack[--submenu_depth];
1810 i++;
1812 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1814 prefix
1815 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1816 i += MENU_ITEMS_PANE_LENGTH;
1818 /* Ignore a nil in the item list.
1819 It's meaningful only for dialog boxes. */
1820 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1821 i += 1;
1822 else
1824 entry
1825 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1826 if (menu_item_selection == i)
1828 if (keymaps != 0)
1830 int j;
1832 entry = Fcons (entry, Qnil);
1833 if (!NILP (prefix))
1834 entry = Fcons (prefix, entry);
1835 for (j = submenu_depth - 1; j >= 0; j--)
1836 if (!NILP (subprefix_stack[j]))
1837 entry = Fcons (subprefix_stack[j], entry);
1839 return entry;
1841 i += MENU_ITEMS_ITEM_LENGTH;
1845 else if (!for_click)
1846 /* Make "Cancel" equivalent to C-g. */
1847 Fsignal (Qquit, Qnil);
1849 return Qnil;
1853 #ifdef HAVE_DIALOGS
1854 /* Construct native Mac OS dialog based on widget_value tree. */
1856 static char * button_names [] = {
1857 "button1", "button2", "button3", "button4", "button5",
1858 "button6", "button7", "button8", "button9", "button10" };
1860 static Lisp_Object
1861 mac_dialog_show (f, keymaps, title, header, error_name)
1862 FRAME_PTR f;
1863 int keymaps;
1864 Lisp_Object title, header;
1865 char **error_name;
1867 int i, nb_buttons=0;
1868 char dialog_name[6];
1870 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1872 /* Number of elements seen so far, before boundary. */
1873 int left_count = 0;
1874 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1875 int boundary_seen = 0;
1877 *error_name = NULL;
1879 if (menu_items_n_panes > 1)
1881 *error_name = "Multiple panes in dialog box";
1882 return Qnil;
1885 /* Create a tree of widget_value objects
1886 representing the text label and buttons. */
1888 Lisp_Object pane_name, prefix;
1889 char *pane_string;
1890 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1891 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1892 pane_string = (NILP (pane_name)
1893 ? "" : (char *) SDATA (pane_name));
1894 prev_wv = xmalloc_widget_value ();
1895 prev_wv->value = pane_string;
1896 if (keymaps && !NILP (prefix))
1897 prev_wv->name++;
1898 prev_wv->enabled = 1;
1899 prev_wv->name = "message";
1900 prev_wv->help = Qnil;
1901 first_wv = prev_wv;
1903 /* Loop over all panes and items, filling in the tree. */
1904 i = MENU_ITEMS_PANE_LENGTH;
1905 while (i < menu_items_used)
1908 /* Create a new item within current pane. */
1909 Lisp_Object item_name, enable, descrip;
1910 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1911 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1912 descrip
1913 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1915 if (NILP (item_name))
1917 free_menubar_widget_value_tree (first_wv);
1918 *error_name = "Submenu in dialog items";
1919 return Qnil;
1921 if (EQ (item_name, Qquote))
1923 /* This is the boundary between left-side elts
1924 and right-side elts. Stop incrementing right_count. */
1925 boundary_seen = 1;
1926 i++;
1927 continue;
1929 if (nb_buttons >= 9)
1931 free_menubar_widget_value_tree (first_wv);
1932 *error_name = "Too many dialog items";
1933 return Qnil;
1936 wv = xmalloc_widget_value ();
1937 prev_wv->next = wv;
1938 wv->name = (char *) button_names[nb_buttons];
1939 if (!NILP (descrip))
1940 wv->key = (char *) SDATA (descrip);
1941 wv->value = (char *) SDATA (item_name);
1942 wv->call_data = (void *) i;
1943 /* menu item is identified by its index in menu_items table */
1944 wv->enabled = !NILP (enable);
1945 wv->help = Qnil;
1946 prev_wv = wv;
1948 if (! boundary_seen)
1949 left_count++;
1951 nb_buttons++;
1952 i += MENU_ITEMS_ITEM_LENGTH;
1955 /* If the boundary was not specified,
1956 by default put half on the left and half on the right. */
1957 if (! boundary_seen)
1958 left_count = nb_buttons - nb_buttons / 2;
1960 wv = xmalloc_widget_value ();
1961 wv->name = dialog_name;
1962 wv->help = Qnil;
1964 /* Frame title: 'Q' = Question, 'I' = Information.
1965 Can also have 'E' = Error if, one day, we want
1966 a popup for errors. */
1967 if (NILP(header))
1968 dialog_name[0] = 'Q';
1969 else
1970 dialog_name[0] = 'I';
1972 /* Dialog boxes use a really stupid name encoding
1973 which specifies how many buttons to use
1974 and how many buttons are on the right. */
1975 dialog_name[1] = '0' + nb_buttons;
1976 dialog_name[2] = 'B';
1977 dialog_name[3] = 'R';
1978 /* Number of buttons to put on the right. */
1979 dialog_name[4] = '0' + nb_buttons - left_count;
1980 dialog_name[5] = 0;
1981 wv->contents = first_wv;
1982 first_wv = wv;
1985 /* No selection has been chosen yet. */
1986 menu_item_selection = 0;
1988 /* Force a redisplay before showing the dialog. If a frame is created
1989 just before showing the dialog, its contents may not have been fully
1990 drawn. */
1991 Fredisplay (Qt);
1993 /* Actually create the dialog. */
1994 #if TARGET_API_MAC_CARBON
1995 create_and_show_dialog (f, first_wv);
1996 #else
1997 menu_item_selection = mac_dialog (first_wv);
1998 #endif
2000 /* Free the widget_value objects we used to specify the contents. */
2001 free_menubar_widget_value_tree (first_wv);
2003 /* Find the selected item, and its pane, to return
2004 the proper value. */
2005 if (menu_item_selection != 0)
2007 Lisp_Object prefix;
2009 prefix = Qnil;
2010 i = 0;
2011 while (i < menu_items_used)
2013 Lisp_Object entry;
2015 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2017 prefix
2018 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2019 i += MENU_ITEMS_PANE_LENGTH;
2021 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2023 /* This is the boundary between left-side elts and
2024 right-side elts. */
2025 ++i;
2027 else
2029 entry
2030 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2031 if (menu_item_selection == i)
2033 if (keymaps != 0)
2035 entry = Fcons (entry, Qnil);
2036 if (!NILP (prefix))
2037 entry = Fcons (prefix, entry);
2039 return entry;
2041 i += MENU_ITEMS_ITEM_LENGTH;
2045 else
2046 /* Make "Cancel" equivalent to C-g. */
2047 Fsignal (Qquit, Qnil);
2049 return Qnil;
2051 #endif /* HAVE_DIALOGS */
2054 /* Is this item a separator? */
2056 name_is_separator (name)
2057 const char *name;
2059 const char *start = name;
2061 /* Check if name string consists of only dashes ('-'). */
2062 while (*name == '-') name++;
2063 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2064 or "--deep-shadow". We don't implement them yet, se we just treat
2065 them like normal separators. */
2066 return (*name == '\0' || start + 2 == name);
2068 #endif /* HAVE_MENUS */
2070 /* Detect if a menu is currently active. */
2073 popup_activated ()
2075 return popup_activated_flag;
2078 /* The following is used by delayed window autoselection. */
2080 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2081 doc: /* Return t if a menu or popup dialog is active. */)
2084 #if TARGET_API_MAC_CARBON
2085 return (popup_activated ()) ? Qt : Qnil;
2086 #else
2087 /* Always return Qnil since menu selection functions do not return
2088 until a selection has been made or cancelled. */
2089 return Qnil;
2090 #endif
2093 void
2094 syms_of_macmenu ()
2096 staticpro (&menu_items);
2097 menu_items = Qnil;
2099 Qdebug_on_next_call = intern ("debug-on-next-call");
2100 staticpro (&Qdebug_on_next_call);
2102 defsubr (&Sx_popup_menu);
2103 defsubr (&Smenu_or_popup_active_p);
2104 #ifdef HAVE_MENUS
2105 defsubr (&Sx_popup_dialog);
2106 #endif
2109 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2110 (do not change this comment) */