(x-colors): Re-order colors.
[emacs.git] / src / macmenu.c
blobbb45013fc73f3734f9b25bb6ef83dc693004013c
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 "frame.h"
30 #include "termhooks.h"
31 #include "keyboard.h"
32 #include "keymap.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 menu_items_allocated *= 2;
253 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
256 /* Begin a submenu. */
258 static void
259 push_submenu_start ()
261 if (menu_items_used + 1 > menu_items_allocated)
262 grow_menu_items ();
264 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
265 menu_items_submenu_depth++;
268 /* End a submenu. */
270 static void
271 push_submenu_end ()
273 if (menu_items_used + 1 > menu_items_allocated)
274 grow_menu_items ();
276 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
277 menu_items_submenu_depth--;
280 /* Indicate boundary between left and right. */
282 static void
283 push_left_right_boundary ()
285 if (menu_items_used + 1 > menu_items_allocated)
286 grow_menu_items ();
288 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
291 /* Start a new menu pane in menu_items.
292 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
294 static void
295 push_menu_pane (name, prefix_vec)
296 Lisp_Object name, prefix_vec;
298 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
299 grow_menu_items ();
301 if (menu_items_submenu_depth == 0)
302 menu_items_n_panes++;
303 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
304 XVECTOR (menu_items)->contents[menu_items_used++] = name;
305 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
308 /* Push one menu item into the current pane. NAME is the string to
309 display. ENABLE if non-nil means this item can be selected. KEY
310 is the key generated by choosing this item, or nil if this item
311 doesn't really have a definition. DEF is the definition of this
312 item. EQUIV is the textual description of the keyboard equivalent
313 for this item (or nil if none). TYPE is the type of this menu
314 item, one of nil, `toggle' or `radio'. */
316 static void
317 push_menu_item (name, enable, key, def, equiv, type, selected, help)
318 Lisp_Object name, enable, key, def, equiv, type, selected, help;
320 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
321 grow_menu_items ();
323 XVECTOR (menu_items)->contents[menu_items_used++] = name;
324 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
325 XVECTOR (menu_items)->contents[menu_items_used++] = key;
326 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
327 XVECTOR (menu_items)->contents[menu_items_used++] = def;
328 XVECTOR (menu_items)->contents[menu_items_used++] = type;
329 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
330 XVECTOR (menu_items)->contents[menu_items_used++] = help;
333 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
334 and generate menu panes for them in menu_items.
335 If NOTREAL is nonzero,
336 don't bother really computing whether an item is enabled. */
338 static void
339 keymap_panes (keymaps, nmaps, notreal)
340 Lisp_Object *keymaps;
341 int nmaps;
342 int notreal;
344 int mapno;
346 init_menu_items ();
348 /* Loop over the given keymaps, making a pane for each map.
349 But don't make a pane that is empty--ignore that map instead.
350 P is the number of panes we have made so far. */
351 for (mapno = 0; mapno < nmaps; mapno++)
352 single_keymap_panes (keymaps[mapno],
353 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
355 finish_menu_items ();
358 /* Args passed between single_keymap_panes and single_menu_item. */
359 struct skp
361 Lisp_Object pending_maps;
362 int maxdepth, notreal;
365 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
366 void *));
368 /* This is a recursive subroutine of keymap_panes.
369 It handles one keymap, KEYMAP.
370 The other arguments are passed along
371 or point to local variables of the previous function.
372 If NOTREAL is nonzero, only check for equivalent key bindings, don't
373 evaluate expressions in menu items and don't make any menu.
375 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
377 static void
378 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
379 Lisp_Object keymap;
380 Lisp_Object pane_name;
381 Lisp_Object prefix;
382 int notreal;
383 int maxdepth;
385 struct skp skp;
386 struct gcpro gcpro1;
388 skp.pending_maps = Qnil;
389 skp.maxdepth = maxdepth;
390 skp.notreal = notreal;
392 if (maxdepth <= 0)
393 return;
395 push_menu_pane (pane_name, prefix);
397 GCPRO1 (skp.pending_maps);
398 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
399 UNGCPRO;
401 /* Process now any submenus which want to be panes at this level. */
402 while (CONSP (skp.pending_maps))
404 Lisp_Object elt, eltcdr, string;
405 elt = XCAR (skp.pending_maps);
406 eltcdr = XCDR (elt);
407 string = XCAR (eltcdr);
408 /* We no longer discard the @ from the beginning of the string here.
409 Instead, we do this in mac_menu_show. */
410 single_keymap_panes (Fcar (elt), string,
411 XCDR (eltcdr), notreal, maxdepth - 1);
412 skp.pending_maps = XCDR (skp.pending_maps);
416 /* This is a subroutine of single_keymap_panes that handles one
417 keymap entry.
418 KEY is a key in a keymap and ITEM is its binding.
419 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
420 separate panes.
421 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
422 evaluate expressions in menu items and don't make any menu.
423 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
425 static void
426 single_menu_item (key, item, dummy, skp_v)
427 Lisp_Object key, item, dummy;
428 void *skp_v;
430 Lisp_Object map, item_string, enabled;
431 struct gcpro gcpro1, gcpro2;
432 int res;
433 struct skp *skp = skp_v;
435 /* Parse the menu item and leave the result in item_properties. */
436 GCPRO2 (key, item);
437 res = parse_menu_item (item, skp->notreal, 0);
438 UNGCPRO;
439 if (!res)
440 return; /* Not a menu item. */
442 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
444 if (skp->notreal)
446 /* We don't want to make a menu, just traverse the keymaps to
447 precompute equivalent key bindings. */
448 if (!NILP (map))
449 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
450 return;
453 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
454 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
456 if (!NILP (map) && SREF (item_string, 0) == '@')
458 if (!NILP (enabled))
459 /* An enabled separate pane. Remember this to handle it later. */
460 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
461 skp->pending_maps);
462 return;
465 push_menu_item (item_string, enabled, key,
466 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
467 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
468 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
469 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
470 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
472 /* Display a submenu using the toolkit. */
473 if (! (NILP (map) || NILP (enabled)))
475 push_submenu_start ();
476 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
477 push_submenu_end ();
481 /* Push all the panes and items of a menu described by the
482 alist-of-alists MENU.
483 This handles old-fashioned calls to x-popup-menu. */
485 static void
486 list_of_panes (menu)
487 Lisp_Object menu;
489 Lisp_Object tail;
491 init_menu_items ();
493 for (tail = menu; CONSP (tail); tail = XCDR (tail))
495 Lisp_Object elt, pane_name, pane_data;
496 elt = XCAR (tail);
497 pane_name = Fcar (elt);
498 CHECK_STRING (pane_name);
499 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
500 pane_data = Fcdr (elt);
501 CHECK_CONS (pane_data);
502 list_of_items (pane_data);
505 finish_menu_items ();
508 /* Push the items in a single pane defined by the alist PANE. */
510 static void
511 list_of_items (pane)
512 Lisp_Object pane;
514 Lisp_Object tail, item, item1;
516 for (tail = pane; CONSP (tail); tail = XCDR (tail))
518 item = XCAR (tail);
519 if (STRINGP (item))
520 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
521 Qnil, Qnil, Qnil, Qnil);
522 else if (CONSP (item))
524 item1 = XCAR (item);
525 CHECK_STRING (item1);
526 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
527 Qt, Qnil, Qnil, Qnil, Qnil);
529 else
530 push_left_right_boundary ();
535 static Lisp_Object
536 cleanup_popup_menu (arg)
537 Lisp_Object arg;
539 discard_menu_items ();
540 return Qnil;
543 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
544 doc: /* Pop up a deck-of-cards menu and return user's selection.
545 POSITION is a position specification. This is either a mouse button event
546 or a list ((XOFFSET YOFFSET) WINDOW)
547 where XOFFSET and YOFFSET are positions in pixels from the top left
548 corner of WINDOW. (WINDOW may be a window or a frame object.)
549 This controls the position of the top left of the menu as a whole.
550 If POSITION is t, it means to use the current mouse position.
552 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
553 The menu items come from key bindings that have a menu string as well as
554 a definition; actually, the "definition" in such a key binding looks like
555 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
556 the keymap as a top-level element.
558 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
559 Otherwise, REAL-DEFINITION should be a valid key binding definition.
561 You can also use a list of keymaps as MENU.
562 Then each keymap makes a separate pane.
564 When MENU is a keymap or a list of keymaps, the return value is the
565 list of events corresponding to the user's choice. Note that
566 `x-popup-menu' does not actually execute the command bound to that
567 sequence of events.
569 Alternatively, you can specify a menu of multiple panes
570 with a list of the form (TITLE PANE1 PANE2...),
571 where each pane is a list of form (TITLE ITEM1 ITEM2...).
572 Each ITEM is normally a cons cell (STRING . VALUE);
573 but a string can appear as an item--that makes a nonselectable line
574 in the menu.
575 With this form of menu, the return value is VALUE from the chosen item.
577 If POSITION is nil, don't display the menu at all, just precalculate the
578 cached information about equivalent key sequences.
580 If the user gets rid of the menu without making a valid choice, for
581 instance by clicking the mouse away from a valid choice or by typing
582 keyboard input, then this normally results in a quit and
583 `x-popup-menu' does not return. But if POSITION is a mouse button
584 event (indicating that the user invoked the menu with the mouse) then
585 no quit occurs and `x-popup-menu' returns nil. */)
586 (position, menu)
587 Lisp_Object position, menu;
589 Lisp_Object keymap, tem;
590 int xpos = 0, ypos = 0;
591 Lisp_Object title;
592 char *error_name = NULL;
593 Lisp_Object selection;
594 FRAME_PTR f = NULL;
595 Lisp_Object x, y, window;
596 int keymaps = 0;
597 int for_click = 0;
598 int specpdl_count = SPECPDL_INDEX ();
599 struct gcpro gcpro1;
601 #ifdef HAVE_MENUS
602 if (! NILP (position))
604 check_mac ();
606 /* Decode the first argument: find the window and the coordinates. */
607 if (EQ (position, Qt)
608 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
609 || EQ (XCAR (position), Qtool_bar)
610 || EQ (XCAR (position), Qmac_apple_event))))
612 /* Use the mouse's current position. */
613 FRAME_PTR new_f = SELECTED_FRAME ();
614 Lisp_Object bar_window;
615 enum scroll_bar_part part;
616 unsigned long time;
618 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
619 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
620 &part, &x, &y, &time);
621 if (new_f != 0)
622 XSETFRAME (window, new_f);
623 else
625 window = selected_window;
626 XSETFASTINT (x, 0);
627 XSETFASTINT (y, 0);
630 else
632 tem = Fcar (position);
633 if (CONSP (tem))
635 window = Fcar (Fcdr (position));
636 x = XCAR (tem);
637 y = Fcar (XCDR (tem));
639 else
641 for_click = 1;
642 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
643 window = Fcar (tem); /* POSN_WINDOW (tem) */
644 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
645 x = Fcar (tem);
646 y = Fcdr (tem);
650 CHECK_NUMBER (x);
651 CHECK_NUMBER (y);
653 /* Decode where to put the menu. */
655 if (FRAMEP (window))
657 f = XFRAME (window);
658 xpos = 0;
659 ypos = 0;
661 else if (WINDOWP (window))
663 CHECK_LIVE_WINDOW (window);
664 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
666 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
667 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
669 else
670 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
671 but I don't want to make one now. */
672 CHECK_WINDOW (window);
674 xpos += XINT (x);
675 ypos += XINT (y);
677 XSETFRAME (Vmenu_updating_frame, f);
679 else
680 Vmenu_updating_frame = Qnil;
681 #endif /* HAVE_MENUS */
683 title = Qnil;
684 GCPRO1 (title);
686 /* Decode the menu items from what was specified. */
688 keymap = get_keymap (menu, 0, 0);
689 if (CONSP (keymap))
691 /* We were given a keymap. Extract menu info from the keymap. */
692 Lisp_Object prompt;
694 /* Extract the detailed info to make one pane. */
695 keymap_panes (&menu, 1, NILP (position));
697 /* Search for a string appearing directly as an element of the keymap.
698 That string is the title of the menu. */
699 prompt = Fkeymap_prompt (keymap);
700 if (NILP (title) && !NILP (prompt))
701 title = prompt;
703 /* Make that be the pane title of the first pane. */
704 if (!NILP (prompt) && menu_items_n_panes >= 0)
705 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
707 keymaps = 1;
709 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
711 /* We were given a list of keymaps. */
712 int nmaps = XFASTINT (Flength (menu));
713 Lisp_Object *maps
714 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
715 int i;
717 title = Qnil;
719 /* The first keymap that has a prompt string
720 supplies the menu title. */
721 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
723 Lisp_Object prompt;
725 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
727 prompt = Fkeymap_prompt (keymap);
728 if (NILP (title) && !NILP (prompt))
729 title = prompt;
732 /* Extract the detailed info to make one pane. */
733 keymap_panes (maps, nmaps, NILP (position));
735 /* Make the title be the pane title of the first pane. */
736 if (!NILP (title) && menu_items_n_panes >= 0)
737 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
739 keymaps = 1;
741 else
743 /* We were given an old-fashioned menu. */
744 title = Fcar (menu);
745 CHECK_STRING (title);
747 list_of_panes (Fcdr (menu));
749 keymaps = 0;
752 if (NILP (position))
754 discard_menu_items ();
755 UNGCPRO;
756 return Qnil;
759 #ifdef HAVE_MENUS
760 /* Display them in a menu. */
761 record_unwind_protect (cleanup_popup_menu, Qnil);
762 BLOCK_INPUT;
764 selection = mac_menu_show (f, xpos, ypos, for_click,
765 keymaps, title, &error_name);
766 UNBLOCK_INPUT;
767 unbind_to (specpdl_count, Qnil);
769 UNGCPRO;
770 #endif /* HAVE_MENUS */
772 if (error_name) error (error_name);
773 return selection;
776 #ifdef HAVE_MENUS
778 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
779 doc: /* Pop up a dialog box and return user's selection.
780 POSITION specifies which frame to use.
781 This is normally a mouse button event or a window or frame.
782 If POSITION is t, it means to use the frame the mouse is on.
783 The dialog box appears in the middle of the specified frame.
785 CONTENTS specifies the alternatives to display in the dialog box.
786 It is a list of the form (DIALOG ITEM1 ITEM2...).
787 Each ITEM is a cons cell (STRING . VALUE).
788 The return value is VALUE from the chosen item.
790 An ITEM may also be just a string--that makes a nonselectable item.
791 An ITEM may also be nil--that means to put all preceding items
792 on the left of the dialog box and all following items on the right.
793 \(By default, approximately half appear on each side.)
795 If HEADER is non-nil, the frame title for the box is "Information",
796 otherwise it is "Question".
798 If the user gets rid of the dialog box without making a valid choice,
799 for instance using the window manager, then this produces a quit and
800 `x-popup-dialog' does not return. */)
801 (position, contents, header)
802 Lisp_Object position, contents, header;
804 FRAME_PTR f = NULL;
805 Lisp_Object window;
807 check_mac ();
809 /* Decode the first argument: find the window or frame to use. */
810 if (EQ (position, Qt)
811 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
812 || EQ (XCAR (position), Qtool_bar)
813 || EQ (XCAR (position), Qmac_apple_event))))
815 #if 0 /* Using the frame the mouse is on may not be right. */
816 /* Use the mouse's current position. */
817 FRAME_PTR new_f = SELECTED_FRAME ();
818 Lisp_Object bar_window;
819 enum scroll_bar_part part;
820 unsigned long time;
821 Lisp_Object x, y;
823 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
825 if (new_f != 0)
826 XSETFRAME (window, new_f);
827 else
828 window = selected_window;
829 #endif
830 window = selected_window;
832 else if (CONSP (position))
834 Lisp_Object tem;
835 tem = Fcar (position);
836 if (CONSP (tem))
837 window = Fcar (Fcdr (position));
838 else
840 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
841 window = Fcar (tem); /* POSN_WINDOW (tem) */
844 else if (WINDOWP (position) || FRAMEP (position))
845 window = position;
846 else
847 window = Qnil;
849 /* Decode where to put the menu. */
851 if (FRAMEP (window))
852 f = XFRAME (window);
853 else if (WINDOWP (window))
855 CHECK_LIVE_WINDOW (window);
856 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
858 else
859 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
860 but I don't want to make one now. */
861 CHECK_WINDOW (window);
863 #ifndef HAVE_DIALOGS
864 /* Display a menu with these alternatives
865 in the middle of frame F. */
867 Lisp_Object x, y, frame, newpos;
868 XSETFRAME (frame, f);
869 XSETINT (x, x_pixel_width (f) / 2);
870 XSETINT (y, x_pixel_height (f) / 2);
871 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
873 return Fx_popup_menu (newpos,
874 Fcons (Fcar (contents), Fcons (contents, Qnil)));
876 #else /* HAVE_DIALOGS */
878 Lisp_Object title;
879 char *error_name;
880 Lisp_Object selection;
881 int specpdl_count = SPECPDL_INDEX ();
883 /* Decode the dialog items from what was specified. */
884 title = Fcar (contents);
885 CHECK_STRING (title);
887 list_of_panes (Fcons (contents, Qnil));
889 /* Display them in a dialog box. */
890 record_unwind_protect (cleanup_popup_menu, Qnil);
891 BLOCK_INPUT;
892 selection = mac_dialog_show (f, 0, title, header, &error_name);
893 UNBLOCK_INPUT;
894 unbind_to (specpdl_count, Qnil);
896 if (error_name) error (error_name);
897 return selection;
899 #endif /* HAVE_DIALOGS */
902 /* Find the menu selection and store it in the keyboard buffer.
903 F is the frame the menu is on.
904 MENU_BAR_ITEMS_USED is the length of VECTOR.
905 VECTOR is an array of menu events for the whole menu. */
907 void
908 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
909 FRAME_PTR f;
910 int menu_bar_items_used;
911 Lisp_Object vector;
912 void *client_data;
914 Lisp_Object prefix, entry;
915 Lisp_Object *subprefix_stack;
916 int submenu_depth = 0;
917 int i;
919 entry = Qnil;
920 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
921 prefix = Qnil;
922 i = 0;
924 while (i < menu_bar_items_used)
926 if (EQ (XVECTOR (vector)->contents[i], Qnil))
928 subprefix_stack[submenu_depth++] = prefix;
929 prefix = entry;
930 i++;
932 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
934 prefix = subprefix_stack[--submenu_depth];
935 i++;
937 else if (EQ (XVECTOR (vector)->contents[i], Qt))
939 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
940 i += MENU_ITEMS_PANE_LENGTH;
942 else
944 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
945 /* The EMACS_INT cast avoids a warning. There's no problem
946 as long as pointers have enough bits to hold small integers. */
947 if ((int) (EMACS_INT) client_data == i)
949 int j;
950 struct input_event buf;
951 Lisp_Object frame;
952 EVENT_INIT (buf);
954 XSETFRAME (frame, f);
955 buf.kind = MENU_BAR_EVENT;
956 buf.frame_or_window = frame;
957 buf.arg = frame;
958 kbd_buffer_store_event (&buf);
960 for (j = 0; j < submenu_depth; j++)
961 if (!NILP (subprefix_stack[j]))
963 buf.kind = MENU_BAR_EVENT;
964 buf.frame_or_window = frame;
965 buf.arg = subprefix_stack[j];
966 kbd_buffer_store_event (&buf);
969 if (!NILP (prefix))
971 buf.kind = MENU_BAR_EVENT;
972 buf.frame_or_window = frame;
973 buf.arg = prefix;
974 kbd_buffer_store_event (&buf);
977 buf.kind = MENU_BAR_EVENT;
978 buf.frame_or_window = frame;
979 buf.arg = entry;
980 kbd_buffer_store_event (&buf);
982 return;
984 i += MENU_ITEMS_ITEM_LENGTH;
989 /* Allocate a widget_value, blocking input. */
991 widget_value *
992 xmalloc_widget_value ()
994 widget_value *value;
996 BLOCK_INPUT;
997 value = malloc_widget_value ();
998 UNBLOCK_INPUT;
1000 return value;
1003 /* This recursively calls free_widget_value on the tree of widgets.
1004 It must free all data that was malloc'ed for these widget_values.
1005 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1006 must be left alone. */
1008 void
1009 free_menubar_widget_value_tree (wv)
1010 widget_value *wv;
1012 if (! wv) return;
1014 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1016 if (wv->contents && (wv->contents != (widget_value*)1))
1018 free_menubar_widget_value_tree (wv->contents);
1019 wv->contents = (widget_value *) 0xDEADBEEF;
1021 if (wv->next)
1023 free_menubar_widget_value_tree (wv->next);
1024 wv->next = (widget_value *) 0xDEADBEEF;
1026 BLOCK_INPUT;
1027 free_widget_value (wv);
1028 UNBLOCK_INPUT;
1031 /* Set up data in menu_items for a menu bar item
1032 whose event type is ITEM_KEY (with string ITEM_NAME)
1033 and whose contents come from the list of keymaps MAPS. */
1035 static int
1036 parse_single_submenu (item_key, item_name, maps)
1037 Lisp_Object item_key, item_name, maps;
1039 Lisp_Object length;
1040 int len;
1041 Lisp_Object *mapvec;
1042 int i;
1043 int top_level_items = 0;
1045 length = Flength (maps);
1046 len = XINT (length);
1048 /* Convert the list MAPS into a vector MAPVEC. */
1049 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1050 for (i = 0; i < len; i++)
1052 mapvec[i] = Fcar (maps);
1053 maps = Fcdr (maps);
1056 /* Loop over the given keymaps, making a pane for each map.
1057 But don't make a pane that is empty--ignore that map instead. */
1058 for (i = 0; i < len; i++)
1060 if (!KEYMAPP (mapvec[i]))
1062 /* Here we have a command at top level in the menu bar
1063 as opposed to a submenu. */
1064 top_level_items = 1;
1065 push_menu_pane (Qnil, Qnil);
1066 push_menu_item (item_name, Qt, item_key, mapvec[i],
1067 Qnil, Qnil, Qnil, Qnil);
1069 else
1071 Lisp_Object prompt;
1072 prompt = Fkeymap_prompt (mapvec[i]);
1073 single_keymap_panes (mapvec[i],
1074 !NILP (prompt) ? prompt : item_name,
1075 item_key, 0, 10);
1079 return top_level_items;
1082 /* Create a tree of widget_value objects
1083 representing the panes and items
1084 in menu_items starting at index START, up to index END. */
1086 static widget_value *
1087 digest_single_submenu (start, end, top_level_items)
1088 int start, end, top_level_items;
1090 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1091 int i;
1092 int submenu_depth = 0;
1093 widget_value **submenu_stack;
1094 int panes_seen = 0;
1096 submenu_stack
1097 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1098 wv = xmalloc_widget_value ();
1099 wv->name = "menu";
1100 wv->value = 0;
1101 wv->enabled = 1;
1102 wv->button_type = BUTTON_TYPE_NONE;
1103 wv->help = Qnil;
1104 first_wv = wv;
1105 save_wv = 0;
1106 prev_wv = 0;
1108 /* Loop over all panes and items made by the preceding call
1109 to parse_single_submenu and construct a tree of widget_value objects.
1110 Ignore the panes and items used by previous calls to
1111 digest_single_submenu, even though those are also in menu_items. */
1112 i = start;
1113 while (i < end)
1115 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1117 submenu_stack[submenu_depth++] = save_wv;
1118 save_wv = prev_wv;
1119 prev_wv = 0;
1120 i++;
1122 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1124 prev_wv = save_wv;
1125 save_wv = submenu_stack[--submenu_depth];
1126 i++;
1128 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1129 && submenu_depth != 0)
1130 i += MENU_ITEMS_PANE_LENGTH;
1131 /* Ignore a nil in the item list.
1132 It's meaningful only for dialog boxes. */
1133 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1134 i += 1;
1135 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1137 /* Create a new pane. */
1138 Lisp_Object pane_name, prefix;
1139 char *pane_string;
1141 panes_seen++;
1143 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1144 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1146 #ifndef HAVE_MULTILINGUAL_MENU
1147 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1149 pane_name = ENCODE_MENU_STRING (pane_name);
1150 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1152 #endif
1153 pane_string = (NILP (pane_name)
1154 ? "" : (char *) SDATA (pane_name));
1155 /* If there is just one top-level pane, put all its items directly
1156 under the top-level menu. */
1157 if (menu_items_n_panes == 1)
1158 pane_string = "";
1160 /* If the pane has a meaningful name,
1161 make the pane a top-level menu item
1162 with its items as a submenu beneath it. */
1163 if (strcmp (pane_string, ""))
1165 wv = xmalloc_widget_value ();
1166 if (save_wv)
1167 save_wv->next = wv;
1168 else
1169 first_wv->contents = wv;
1170 wv->lname = pane_name;
1171 /* Set value to 1 so update_submenu_strings can handle '@' */
1172 wv->value = (char *)1;
1173 wv->enabled = 1;
1174 wv->button_type = BUTTON_TYPE_NONE;
1175 wv->help = Qnil;
1176 save_wv = wv;
1178 else
1179 save_wv = first_wv;
1181 prev_wv = 0;
1182 i += MENU_ITEMS_PANE_LENGTH;
1184 else
1186 /* Create a new item within current pane. */
1187 Lisp_Object item_name, enable, descrip, def, type, selected;
1188 Lisp_Object help;
1190 /* All items should be contained in panes. */
1191 if (panes_seen == 0)
1192 abort ();
1194 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1195 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1196 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1197 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1198 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1199 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1200 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1202 #ifndef HAVE_MULTILINGUAL_MENU
1203 if (STRING_MULTIBYTE (item_name))
1205 item_name = ENCODE_MENU_STRING (item_name);
1206 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1209 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1211 descrip = ENCODE_MENU_STRING (descrip);
1212 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1214 #endif /* not HAVE_MULTILINGUAL_MENU */
1216 wv = xmalloc_widget_value ();
1217 if (prev_wv)
1218 prev_wv->next = wv;
1219 else
1220 save_wv->contents = wv;
1222 wv->lname = item_name;
1223 if (!NILP (descrip))
1224 wv->lkey = descrip;
1225 wv->value = 0;
1226 /* The EMACS_INT cast avoids a warning. There's no problem
1227 as long as pointers have enough bits to hold small integers. */
1228 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1229 wv->enabled = !NILP (enable);
1231 if (NILP (type))
1232 wv->button_type = BUTTON_TYPE_NONE;
1233 else if (EQ (type, QCradio))
1234 wv->button_type = BUTTON_TYPE_RADIO;
1235 else if (EQ (type, QCtoggle))
1236 wv->button_type = BUTTON_TYPE_TOGGLE;
1237 else
1238 abort ();
1240 wv->selected = !NILP (selected);
1241 if (! STRINGP (help))
1242 help = Qnil;
1244 wv->help = help;
1246 prev_wv = wv;
1248 i += MENU_ITEMS_ITEM_LENGTH;
1252 /* If we have just one "menu item"
1253 that was originally a button, return it by itself. */
1254 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1256 wv = first_wv->contents;
1257 free_widget_value (first_wv);
1258 return wv;
1261 return first_wv;
1264 /* Walk through the widget_value tree starting at FIRST_WV and update
1265 the char * pointers from the corresponding lisp values.
1266 We do this after building the whole tree, since GC may happen while the
1267 tree is constructed, and small strings are relocated. So we must wait
1268 until no GC can happen before storing pointers into lisp values. */
1269 static void
1270 update_submenu_strings (first_wv)
1271 widget_value *first_wv;
1273 widget_value *wv;
1275 for (wv = first_wv; wv; wv = wv->next)
1277 if (STRINGP (wv->lname))
1279 wv->name = SDATA (wv->lname);
1281 /* Ignore the @ that means "separate pane".
1282 This is a kludge, but this isn't worth more time. */
1283 if (wv->value == (char *)1)
1285 if (wv->name[0] == '@')
1286 wv->name++;
1287 wv->value = 0;
1291 if (STRINGP (wv->lkey))
1292 wv->key = SDATA (wv->lkey);
1294 if (wv->contents)
1295 update_submenu_strings (wv->contents);
1300 /* Set the contents of the menubar widgets of frame F.
1301 The argument FIRST_TIME is currently ignored;
1302 it is set the first time this is called, from initialize_frame_menubar. */
1304 void
1305 set_frame_menubar (f, first_time, deep_p)
1306 FRAME_PTR f;
1307 int first_time;
1308 int deep_p;
1310 int menubar_widget = f->output_data.mac->menubar_widget;
1311 Lisp_Object items;
1312 widget_value *wv, *first_wv, *prev_wv = 0;
1313 int i, last_i = 0;
1314 int *submenu_start, *submenu_end;
1315 int *submenu_top_level_items, *submenu_n_panes;
1317 XSETFRAME (Vmenu_updating_frame, f);
1319 /* This seems to be unnecessary for Carbon. */
1320 #if 0
1321 if (! menubar_widget)
1322 deep_p = 1;
1323 else if (pending_menu_activation && !deep_p)
1324 deep_p = 1;
1325 #endif
1327 if (deep_p)
1329 /* Make a widget-value tree representing the entire menu trees. */
1331 struct buffer *prev = current_buffer;
1332 Lisp_Object buffer;
1333 int specpdl_count = SPECPDL_INDEX ();
1334 int previous_menu_items_used = f->menu_bar_items_used;
1335 Lisp_Object *previous_items
1336 = (Lisp_Object *) alloca (previous_menu_items_used
1337 * sizeof (Lisp_Object));
1339 /* If we are making a new widget, its contents are empty,
1340 do always reinitialize them. */
1341 if (! menubar_widget)
1342 previous_menu_items_used = 0;
1344 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1345 specbind (Qinhibit_quit, Qt);
1346 /* Don't let the debugger step into this code
1347 because it is not reentrant. */
1348 specbind (Qdebug_on_next_call, Qnil);
1350 record_unwind_save_match_data ();
1351 if (NILP (Voverriding_local_map_menu_flag))
1353 specbind (Qoverriding_terminal_local_map, Qnil);
1354 specbind (Qoverriding_local_map, Qnil);
1357 set_buffer_internal_1 (XBUFFER (buffer));
1359 /* Run the Lucid hook. */
1360 safe_run_hooks (Qactivate_menubar_hook);
1362 /* If it has changed current-menubar from previous value,
1363 really recompute the menubar from the value. */
1364 if (! NILP (Vlucid_menu_bar_dirty_flag))
1365 call0 (Qrecompute_lucid_menubar);
1366 safe_run_hooks (Qmenu_bar_update_hook);
1367 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1369 items = FRAME_MENU_BAR_ITEMS (f);
1371 /* Save the frame's previous menu bar contents data. */
1372 if (previous_menu_items_used)
1373 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1374 previous_menu_items_used * sizeof (Lisp_Object));
1376 /* Fill in menu_items with the current menu bar contents.
1377 This can evaluate Lisp code. */
1378 save_menu_items ();
1380 menu_items = f->menu_bar_vector;
1381 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1382 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1383 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1384 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1385 submenu_top_level_items
1386 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1387 init_menu_items ();
1388 for (i = 0; i < XVECTOR (items)->size; i += 4)
1390 Lisp_Object key, string, maps;
1392 last_i = i;
1394 key = XVECTOR (items)->contents[i];
1395 string = XVECTOR (items)->contents[i + 1];
1396 maps = XVECTOR (items)->contents[i + 2];
1397 if (NILP (string))
1398 break;
1400 submenu_start[i] = menu_items_used;
1402 menu_items_n_panes = 0;
1403 submenu_top_level_items[i]
1404 = parse_single_submenu (key, string, maps);
1405 submenu_n_panes[i] = menu_items_n_panes;
1407 submenu_end[i] = menu_items_used;
1410 finish_menu_items ();
1412 /* Convert menu_items into widget_value trees
1413 to display the menu. This cannot evaluate Lisp code. */
1415 wv = xmalloc_widget_value ();
1416 wv->name = "menubar";
1417 wv->value = 0;
1418 wv->enabled = 1;
1419 wv->button_type = BUTTON_TYPE_NONE;
1420 wv->help = Qnil;
1421 first_wv = wv;
1423 for (i = 0; i < last_i; i += 4)
1425 menu_items_n_panes = submenu_n_panes[i];
1426 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1427 submenu_top_level_items[i]);
1428 if (prev_wv)
1429 prev_wv->next = wv;
1430 else
1431 first_wv->contents = wv;
1432 /* Don't set wv->name here; GC during the loop might relocate it. */
1433 wv->enabled = 1;
1434 wv->button_type = BUTTON_TYPE_NONE;
1435 prev_wv = wv;
1438 set_buffer_internal_1 (prev);
1440 /* If there has been no change in the Lisp-level contents
1441 of the menu bar, skip redisplaying it. Just exit. */
1443 /* Compare the new menu items with the ones computed last time. */
1444 for (i = 0; i < previous_menu_items_used; i++)
1445 if (menu_items_used == i
1446 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1447 break;
1448 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1450 /* The menu items have not changed. Don't bother updating
1451 the menus in any form, since it would be a no-op. */
1452 free_menubar_widget_value_tree (first_wv);
1453 discard_menu_items ();
1454 unbind_to (specpdl_count, Qnil);
1455 return;
1458 /* The menu items are different, so store them in the frame. */
1459 f->menu_bar_vector = menu_items;
1460 f->menu_bar_items_used = menu_items_used;
1462 /* This calls restore_menu_items to restore menu_items, etc.,
1463 as they were outside. */
1464 unbind_to (specpdl_count, Qnil);
1466 /* Now GC cannot happen during the lifetime of the widget_value,
1467 so it's safe to store data from a Lisp_String. */
1468 wv = first_wv->contents;
1469 for (i = 0; i < XVECTOR (items)->size; i += 4)
1471 Lisp_Object string;
1472 string = XVECTOR (items)->contents[i + 1];
1473 if (NILP (string))
1474 break;
1475 wv->name = (char *) SDATA (string);
1476 update_submenu_strings (wv->contents);
1477 wv = wv->next;
1481 else
1483 /* Make a widget-value tree containing
1484 just the top level menu bar strings. */
1486 wv = xmalloc_widget_value ();
1487 wv->name = "menubar";
1488 wv->value = 0;
1489 wv->enabled = 1;
1490 wv->button_type = BUTTON_TYPE_NONE;
1491 wv->help = Qnil;
1492 first_wv = wv;
1494 items = FRAME_MENU_BAR_ITEMS (f);
1495 for (i = 0; i < XVECTOR (items)->size; i += 4)
1497 Lisp_Object string;
1499 string = XVECTOR (items)->contents[i + 1];
1500 if (NILP (string))
1501 break;
1503 wv = xmalloc_widget_value ();
1504 wv->name = (char *) SDATA (string);
1505 wv->value = 0;
1506 wv->enabled = 1;
1507 wv->button_type = BUTTON_TYPE_NONE;
1508 wv->help = Qnil;
1509 /* This prevents lwlib from assuming this
1510 menu item is really supposed to be empty. */
1511 /* The EMACS_INT cast avoids a warning.
1512 This value just has to be different from small integers. */
1513 wv->call_data = (void *) (EMACS_INT) (-1);
1515 if (prev_wv)
1516 prev_wv->next = wv;
1517 else
1518 first_wv->contents = wv;
1519 prev_wv = wv;
1522 /* Forget what we thought we knew about what is in the
1523 detailed contents of the menu bar menus.
1524 Changing the top level always destroys the contents. */
1525 f->menu_bar_items_used = 0;
1528 /* Create or update the menu bar widget. */
1530 BLOCK_INPUT;
1532 /* Non-null value to indicate menubar has already been "created". */
1533 f->output_data.mac->menubar_widget = 1;
1535 mac_fill_menubar (first_wv->contents, deep_p);
1537 free_menubar_widget_value_tree (first_wv);
1539 UNBLOCK_INPUT;
1542 /* Get rid of the menu bar of frame F, and free its storage.
1543 This is used when deleting a frame, and when turning off the menu bar. */
1545 void
1546 free_frame_menubar (f)
1547 FRAME_PTR f;
1549 f->output_data.mac->menubar_widget = 0;
1553 /* The item selected in the popup menu. */
1554 int menu_item_selection;
1556 /* Mac_menu_show actually displays a menu using the panes and items in
1557 menu_items and returns the value selected from it; we assume input
1558 is blocked by the caller. */
1560 /* F is the frame the menu is for.
1561 X and Y are the frame-relative specified position,
1562 relative to the inside upper left corner of the frame F.
1563 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1564 KEYMAPS is 1 if this menu was specified with keymaps;
1565 in that case, we return a list containing the chosen item's value
1566 and perhaps also the pane's prefix.
1567 TITLE is the specified menu title.
1568 ERROR is a place to store an error message string in case of failure.
1569 (We return nil on failure, but the value doesn't actually matter.) */
1571 static Lisp_Object
1572 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1573 FRAME_PTR f;
1574 int x;
1575 int y;
1576 int for_click;
1577 int keymaps;
1578 Lisp_Object title;
1579 char **error;
1581 int i;
1582 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1583 widget_value **submenu_stack
1584 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1585 Lisp_Object *subprefix_stack
1586 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1587 int submenu_depth = 0;
1589 int first_pane;
1591 *error = NULL;
1593 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1595 *error = "Empty menu";
1596 return Qnil;
1599 /* Create a tree of widget_value objects
1600 representing the panes and their items. */
1601 wv = xmalloc_widget_value ();
1602 wv->name = "menu";
1603 wv->value = 0;
1604 wv->enabled = 1;
1605 wv->button_type = BUTTON_TYPE_NONE;
1606 wv->help = Qnil;
1607 first_wv = wv;
1608 first_pane = 1;
1610 /* Loop over all panes and items, filling in the tree. */
1611 i = 0;
1612 while (i < menu_items_used)
1614 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1616 submenu_stack[submenu_depth++] = save_wv;
1617 save_wv = prev_wv;
1618 prev_wv = 0;
1619 first_pane = 1;
1620 i++;
1622 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1624 prev_wv = save_wv;
1625 save_wv = submenu_stack[--submenu_depth];
1626 first_pane = 0;
1627 i++;
1629 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1630 && submenu_depth != 0)
1631 i += MENU_ITEMS_PANE_LENGTH;
1632 /* Ignore a nil in the item list.
1633 It's meaningful only for dialog boxes. */
1634 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1635 i += 1;
1636 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1638 /* Create a new pane. */
1639 Lisp_Object pane_name, prefix;
1640 char *pane_string;
1642 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1643 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1645 #ifndef HAVE_MULTILINGUAL_MENU
1646 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1648 pane_name = ENCODE_MENU_STRING (pane_name);
1649 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1651 #endif
1652 pane_string = (NILP (pane_name)
1653 ? "" : (char *) SDATA (pane_name));
1654 /* If there is just one top-level pane, put all its items directly
1655 under the top-level menu. */
1656 if (menu_items_n_panes == 1)
1657 pane_string = "";
1659 /* If the pane has a meaningful name,
1660 make the pane a top-level menu item
1661 with its items as a submenu beneath it. */
1662 if (!keymaps && strcmp (pane_string, ""))
1664 wv = xmalloc_widget_value ();
1665 if (save_wv)
1666 save_wv->next = wv;
1667 else
1668 first_wv->contents = wv;
1669 wv->name = pane_string;
1670 if (keymaps && !NILP (prefix))
1671 wv->name++;
1672 wv->value = 0;
1673 wv->enabled = 1;
1674 wv->button_type = BUTTON_TYPE_NONE;
1675 wv->help = Qnil;
1676 save_wv = wv;
1677 prev_wv = 0;
1679 else if (first_pane)
1681 save_wv = wv;
1682 prev_wv = 0;
1684 first_pane = 0;
1685 i += MENU_ITEMS_PANE_LENGTH;
1687 else
1689 /* Create a new item within current pane. */
1690 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1691 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1692 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1693 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1694 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1695 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1696 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1697 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1699 #ifndef HAVE_MULTILINGUAL_MENU
1700 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1702 item_name = ENCODE_MENU_STRING (item_name);
1703 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1706 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1708 descrip = ENCODE_MENU_STRING (descrip);
1709 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1711 #endif /* not HAVE_MULTILINGUAL_MENU */
1713 wv = xmalloc_widget_value ();
1714 if (prev_wv)
1715 prev_wv->next = wv;
1716 else
1717 save_wv->contents = wv;
1718 wv->name = (char *) SDATA (item_name);
1719 if (!NILP (descrip))
1720 wv->key = (char *) SDATA (descrip);
1721 wv->value = 0;
1722 /* Use the contents index as call_data, since we are
1723 restricted to 16-bits. */
1724 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1725 wv->enabled = !NILP (enable);
1727 if (NILP (type))
1728 wv->button_type = BUTTON_TYPE_NONE;
1729 else if (EQ (type, QCtoggle))
1730 wv->button_type = BUTTON_TYPE_TOGGLE;
1731 else if (EQ (type, QCradio))
1732 wv->button_type = BUTTON_TYPE_RADIO;
1733 else
1734 abort ();
1736 wv->selected = !NILP (selected);
1738 if (! STRINGP (help))
1739 help = Qnil;
1741 wv->help = help;
1743 prev_wv = wv;
1745 i += MENU_ITEMS_ITEM_LENGTH;
1749 /* Deal with the title, if it is non-nil. */
1750 if (!NILP (title))
1752 widget_value *wv_title = xmalloc_widget_value ();
1753 widget_value *wv_sep = xmalloc_widget_value ();
1755 /* Maybe replace this separator with a bitmap or owner-draw item
1756 so that it looks better. Having two separators looks odd. */
1757 wv_sep->name = "--";
1758 wv_sep->next = first_wv->contents;
1759 wv_sep->help = Qnil;
1761 #ifndef HAVE_MULTILINGUAL_MENU
1762 if (STRING_MULTIBYTE (title))
1763 title = ENCODE_MENU_STRING (title);
1764 #endif
1766 wv_title->name = (char *) SDATA (title);
1767 wv_title->enabled = FALSE;
1768 wv_title->title = TRUE;
1769 wv_title->button_type = BUTTON_TYPE_NONE;
1770 wv_title->help = Qnil;
1771 wv_title->next = wv_sep;
1772 first_wv->contents = wv_title;
1775 /* No selection has been chosen yet. */
1776 menu_item_selection = 0;
1778 /* Actually create and show the menu until popped down. */
1779 create_and_show_popup_menu (f, first_wv, x, y, for_click);
1781 /* Free the widget_value objects we used to specify the contents. */
1782 free_menubar_widget_value_tree (first_wv);
1784 /* Find the selected item, and its pane, to return
1785 the proper value. */
1786 if (menu_item_selection != 0)
1788 Lisp_Object prefix, entry;
1790 prefix = entry = Qnil;
1791 i = 0;
1792 while (i < menu_items_used)
1794 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1796 subprefix_stack[submenu_depth++] = prefix;
1797 prefix = entry;
1798 i++;
1800 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1802 prefix = subprefix_stack[--submenu_depth];
1803 i++;
1805 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1807 prefix
1808 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1809 i += MENU_ITEMS_PANE_LENGTH;
1811 /* Ignore a nil in the item list.
1812 It's meaningful only for dialog boxes. */
1813 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1814 i += 1;
1815 else
1817 entry
1818 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1819 if (menu_item_selection == i)
1821 if (keymaps != 0)
1823 int j;
1825 entry = Fcons (entry, Qnil);
1826 if (!NILP (prefix))
1827 entry = Fcons (prefix, entry);
1828 for (j = submenu_depth - 1; j >= 0; j--)
1829 if (!NILP (subprefix_stack[j]))
1830 entry = Fcons (subprefix_stack[j], entry);
1832 return entry;
1834 i += MENU_ITEMS_ITEM_LENGTH;
1838 else if (!for_click)
1839 /* Make "Cancel" equivalent to C-g. */
1840 Fsignal (Qquit, Qnil);
1842 return Qnil;
1846 #ifdef HAVE_DIALOGS
1847 /* Construct native Mac OS dialog based on widget_value tree. */
1849 static char * button_names [] = {
1850 "button1", "button2", "button3", "button4", "button5",
1851 "button6", "button7", "button8", "button9", "button10" };
1853 static Lisp_Object
1854 mac_dialog_show (f, keymaps, title, header, error_name)
1855 FRAME_PTR f;
1856 int keymaps;
1857 Lisp_Object title, header;
1858 char **error_name;
1860 int i, nb_buttons=0;
1861 char dialog_name[6];
1863 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1865 /* Number of elements seen so far, before boundary. */
1866 int left_count = 0;
1867 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1868 int boundary_seen = 0;
1870 *error_name = NULL;
1872 if (menu_items_n_panes > 1)
1874 *error_name = "Multiple panes in dialog box";
1875 return Qnil;
1878 /* Create a tree of widget_value objects
1879 representing the text label and buttons. */
1881 Lisp_Object pane_name, prefix;
1882 char *pane_string;
1883 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1884 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1885 pane_string = (NILP (pane_name)
1886 ? "" : (char *) SDATA (pane_name));
1887 prev_wv = xmalloc_widget_value ();
1888 prev_wv->value = pane_string;
1889 if (keymaps && !NILP (prefix))
1890 prev_wv->name++;
1891 prev_wv->enabled = 1;
1892 prev_wv->name = "message";
1893 prev_wv->help = Qnil;
1894 first_wv = prev_wv;
1896 /* Loop over all panes and items, filling in the tree. */
1897 i = MENU_ITEMS_PANE_LENGTH;
1898 while (i < menu_items_used)
1901 /* Create a new item within current pane. */
1902 Lisp_Object item_name, enable, descrip;
1903 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1904 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1905 descrip
1906 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1908 if (NILP (item_name))
1910 free_menubar_widget_value_tree (first_wv);
1911 *error_name = "Submenu in dialog items";
1912 return Qnil;
1914 if (EQ (item_name, Qquote))
1916 /* This is the boundary between left-side elts
1917 and right-side elts. Stop incrementing right_count. */
1918 boundary_seen = 1;
1919 i++;
1920 continue;
1922 if (nb_buttons >= 9)
1924 free_menubar_widget_value_tree (first_wv);
1925 *error_name = "Too many dialog items";
1926 return Qnil;
1929 wv = xmalloc_widget_value ();
1930 prev_wv->next = wv;
1931 wv->name = (char *) button_names[nb_buttons];
1932 if (!NILP (descrip))
1933 wv->key = (char *) SDATA (descrip);
1934 wv->value = (char *) SDATA (item_name);
1935 wv->call_data = (void *) i;
1936 /* menu item is identified by its index in menu_items table */
1937 wv->enabled = !NILP (enable);
1938 wv->help = Qnil;
1939 prev_wv = wv;
1941 if (! boundary_seen)
1942 left_count++;
1944 nb_buttons++;
1945 i += MENU_ITEMS_ITEM_LENGTH;
1948 /* If the boundary was not specified,
1949 by default put half on the left and half on the right. */
1950 if (! boundary_seen)
1951 left_count = nb_buttons - nb_buttons / 2;
1953 wv = xmalloc_widget_value ();
1954 wv->name = dialog_name;
1955 wv->help = Qnil;
1957 /* Frame title: 'Q' = Question, 'I' = Information.
1958 Can also have 'E' = Error if, one day, we want
1959 a popup for errors. */
1960 if (NILP(header))
1961 dialog_name[0] = 'Q';
1962 else
1963 dialog_name[0] = 'I';
1965 /* Dialog boxes use a really stupid name encoding
1966 which specifies how many buttons to use
1967 and how many buttons are on the right. */
1968 dialog_name[1] = '0' + nb_buttons;
1969 dialog_name[2] = 'B';
1970 dialog_name[3] = 'R';
1971 /* Number of buttons to put on the right. */
1972 dialog_name[4] = '0' + nb_buttons - left_count;
1973 dialog_name[5] = 0;
1974 wv->contents = first_wv;
1975 first_wv = wv;
1978 /* No selection has been chosen yet. */
1979 menu_item_selection = 0;
1981 /* Force a redisplay before showing the dialog. If a frame is created
1982 just before showing the dialog, its contents may not have been fully
1983 drawn. */
1984 Fredisplay (Qt);
1986 /* Actually create the dialog. */
1987 #if TARGET_API_MAC_CARBON
1988 create_and_show_dialog (f, first_wv);
1989 #else
1990 menu_item_selection = mac_dialog (first_wv);
1991 #endif
1993 /* Free the widget_value objects we used to specify the contents. */
1994 free_menubar_widget_value_tree (first_wv);
1996 /* Find the selected item, and its pane, to return
1997 the proper value. */
1998 if (menu_item_selection != 0)
2000 Lisp_Object prefix;
2002 prefix = Qnil;
2003 i = 0;
2004 while (i < menu_items_used)
2006 Lisp_Object entry;
2008 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2010 prefix
2011 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2012 i += MENU_ITEMS_PANE_LENGTH;
2014 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2016 /* This is the boundary between left-side elts and
2017 right-side elts. */
2018 ++i;
2020 else
2022 entry
2023 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2024 if (menu_item_selection == i)
2026 if (keymaps != 0)
2028 entry = Fcons (entry, Qnil);
2029 if (!NILP (prefix))
2030 entry = Fcons (prefix, entry);
2032 return entry;
2034 i += MENU_ITEMS_ITEM_LENGTH;
2038 else
2039 /* Make "Cancel" equivalent to C-g. */
2040 Fsignal (Qquit, Qnil);
2042 return Qnil;
2044 #endif /* HAVE_DIALOGS */
2047 /* Is this item a separator? */
2049 name_is_separator (name)
2050 const char *name;
2052 const char *start = name;
2054 /* Check if name string consists of only dashes ('-'). */
2055 while (*name == '-') name++;
2056 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2057 or "--deep-shadow". We don't implement them yet, se we just treat
2058 them like normal separators. */
2059 return (*name == '\0' || start + 2 == name);
2061 #endif /* HAVE_MENUS */
2063 /* Detect if a menu is currently active. */
2066 popup_activated ()
2068 return popup_activated_flag;
2071 /* The following is used by delayed window autoselection. */
2073 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2074 doc: /* Return t if a menu or popup dialog is active. */)
2077 #if TARGET_API_MAC_CARBON
2078 return (popup_activated ()) ? Qt : Qnil;
2079 #else
2080 /* Always return Qnil since menu selection functions do not return
2081 until a selection has been made or cancelled. */
2082 return Qnil;
2083 #endif
2086 void
2087 syms_of_macmenu ()
2089 staticpro (&menu_items);
2090 menu_items = Qnil;
2092 Qdebug_on_next_call = intern ("debug-on-next-call");
2093 staticpro (&Qdebug_on_next_call);
2095 defsubr (&Sx_popup_menu);
2096 defsubr (&Smenu_or_popup_active_p);
2097 #ifdef HAVE_MENUS
2098 defsubr (&Sx_popup_dialog);
2099 #endif
2102 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2103 (do not change this comment) */