(top-level): Don't require cl when compiling.
[emacs.git] / src / macmenu.c
blobb3ccf578ae9f6be77395ad8cc931a9dfcd80e91b
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
3 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 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
20 /* Contributed by Andrew Choi (akochoi@mac.com). */
22 #include <config.h>
24 #include <stdio.h>
26 #include "lisp.h"
27 #include "frame.h"
28 #include "termhooks.h"
29 #include "keyboard.h"
30 #include "keymap.h"
31 #include "window.h"
32 #include "blockinput.h"
33 #include "buffer.h"
34 #include "charset.h"
35 #include "coding.h"
37 /* This may include sys/types.h, and that somehow loses
38 if this is not done before the other system files. */
39 #include "macterm.h"
41 /* Load sys/types.h if not already loaded.
42 In some systems loading it twice is suicidal. */
43 #ifndef makedev
44 #include <sys/types.h>
45 #endif
47 #include "dispextern.h"
49 #if TARGET_API_MAC_CARBON
50 #define HAVE_DIALOGS 1
51 #endif
53 #undef HAVE_MULTILINGUAL_MENU
55 /******************************************************************/
57 /* Assumed by other routines to zero area returned. */
58 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
59 0, (sizeof (widget_value)))
60 #define free_widget_value(wv) xfree (wv)
62 /******************************************************************/
64 #ifndef TRUE
65 #define TRUE 1
66 #define FALSE 0
67 #endif /* no TRUE */
69 Lisp_Object Qdebug_on_next_call;
71 extern Lisp_Object Vmenu_updating_frame;
73 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
75 extern Lisp_Object QCtoggle, QCradio;
77 extern Lisp_Object Voverriding_local_map;
78 extern Lisp_Object Voverriding_local_map_menu_flag;
80 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
82 extern Lisp_Object Qmenu_bar_update_hook;
84 void set_frame_menubar P_ ((FRAME_PTR, int, int));
86 #if TARGET_API_MAC_CARBON
87 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
88 #else
89 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
90 #endif
92 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
93 Lisp_Object, Lisp_Object, Lisp_Object,
94 Lisp_Object, Lisp_Object));
95 #ifdef HAVE_DIALOGS
96 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
97 Lisp_Object, char **));
98 #endif
99 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
100 Lisp_Object, char **));
101 static void keymap_panes P_ ((Lisp_Object *, int, int));
102 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
103 int, int));
104 static void list_of_panes P_ ((Lisp_Object));
105 static void list_of_items P_ ((Lisp_Object));
108 /* This holds a Lisp vector that holds the results of decoding
109 the keymaps or alist-of-alists that specify a menu.
111 It describes the panes and items within the panes.
113 Each pane is described by 3 elements in the vector:
114 t, the pane name, the pane's prefix key.
115 Then follow the pane's items, with 5 elements per item:
116 the item string, the enable flag, the item's value,
117 the definition, and the equivalent keyboard key's description string.
119 In some cases, multiple levels of menus may be described.
120 A single vector slot containing nil indicates the start of a submenu.
121 A single vector slot containing lambda indicates the end of a submenu.
122 The submenu follows a menu item which is the way to reach the submenu.
124 A single vector slot containing quote indicates that the
125 following items should appear on the right of a dialog box.
127 Using a Lisp vector to hold this information while we decode it
128 takes care of protecting all the data from GC. */
130 #define MENU_ITEMS_PANE_NAME 1
131 #define MENU_ITEMS_PANE_PREFIX 2
132 #define MENU_ITEMS_PANE_LENGTH 3
134 enum menu_item_idx
136 MENU_ITEMS_ITEM_NAME = 0,
137 MENU_ITEMS_ITEM_ENABLE,
138 MENU_ITEMS_ITEM_VALUE,
139 MENU_ITEMS_ITEM_EQUIV_KEY,
140 MENU_ITEMS_ITEM_DEFINITION,
141 MENU_ITEMS_ITEM_TYPE,
142 MENU_ITEMS_ITEM_SELECTED,
143 MENU_ITEMS_ITEM_HELP,
144 MENU_ITEMS_ITEM_LENGTH
147 static Lisp_Object menu_items;
149 /* Number of slots currently allocated in menu_items. */
150 static int menu_items_allocated;
152 /* This is the index in menu_items of the first empty slot. */
153 static int menu_items_used;
155 /* The number of panes currently recorded in menu_items,
156 excluding those within submenus. */
157 static int menu_items_n_panes;
159 /* Current depth within submenus. */
160 static int menu_items_submenu_depth;
162 /* Nonzero means a menu is currently active. */
163 int popup_activated_flag;
165 /* This is set nonzero after the user activates the menu bar, and set
166 to zero again after the menu bars are redisplayed by prepare_menu_bar.
167 While it is nonzero, all calls to set_frame_menubar go deep.
169 I don't understand why this is needed, but it does seem to be
170 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
172 int pending_menu_activation;
174 /* Initialize the menu_items structure if we haven't already done so.
175 Also mark it as currently empty. */
177 static void
178 init_menu_items ()
180 if (NILP (menu_items))
182 menu_items_allocated = 60;
183 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
186 menu_items_used = 0;
187 menu_items_n_panes = 0;
188 menu_items_submenu_depth = 0;
191 /* Call at the end of generating the data in menu_items. */
193 static void
194 finish_menu_items ()
198 /* Call when finished using the data for the current menu
199 in menu_items. */
201 static void
202 discard_menu_items ()
204 /* Free the structure if it is especially large.
205 Otherwise, hold on to it, to save time. */
206 if (menu_items_allocated > 200)
208 menu_items = Qnil;
209 menu_items_allocated = 0;
213 /* This undoes save_menu_items, and it is called by the specpdl unwind
214 mechanism. */
216 static Lisp_Object
217 restore_menu_items (saved)
218 Lisp_Object saved;
220 menu_items = XCAR (saved);
221 menu_items_allocated = (VECTORP (menu_items) ? ASIZE (menu_items) : 0);
222 saved = XCDR (saved);
223 menu_items_used = XINT (XCAR (saved));
224 saved = XCDR (saved);
225 menu_items_n_panes = XINT (XCAR (saved));
226 saved = XCDR (saved);
227 menu_items_submenu_depth = XINT (XCAR (saved));
228 return Qnil;
231 /* Push the whole state of menu_items processing onto the specpdl.
232 It will be restored when the specpdl is unwound. */
234 static void
235 save_menu_items ()
237 Lisp_Object saved = list4 (menu_items,
238 make_number (menu_items_used),
239 make_number (menu_items_n_panes),
240 make_number (menu_items_submenu_depth));
241 record_unwind_protect (restore_menu_items, saved);
242 menu_items = Qnil;
245 /* Make the menu_items vector twice as large. */
247 static void
248 grow_menu_items ()
250 menu_items_allocated *= 2;
251 menu_items = larger_vector (menu_items, menu_items_allocated, Qnil);
254 /* Begin a submenu. */
256 static void
257 push_submenu_start ()
259 if (menu_items_used + 1 > menu_items_allocated)
260 grow_menu_items ();
262 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
263 menu_items_submenu_depth++;
266 /* End a submenu. */
268 static void
269 push_submenu_end ()
271 if (menu_items_used + 1 > menu_items_allocated)
272 grow_menu_items ();
274 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
275 menu_items_submenu_depth--;
278 /* Indicate boundary between left and right. */
280 static void
281 push_left_right_boundary ()
283 if (menu_items_used + 1 > menu_items_allocated)
284 grow_menu_items ();
286 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
289 /* Start a new menu pane in menu_items.
290 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
292 static void
293 push_menu_pane (name, prefix_vec)
294 Lisp_Object name, prefix_vec;
296 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
297 grow_menu_items ();
299 if (menu_items_submenu_depth == 0)
300 menu_items_n_panes++;
301 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
302 XVECTOR (menu_items)->contents[menu_items_used++] = name;
303 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
306 /* Push one menu item into the current pane. NAME is the string to
307 display. ENABLE if non-nil means this item can be selected. KEY
308 is the key generated by choosing this item, or nil if this item
309 doesn't really have a definition. DEF is the definition of this
310 item. EQUIV is the textual description of the keyboard equivalent
311 for this item (or nil if none). TYPE is the type of this menu
312 item, one of nil, `toggle' or `radio'. */
314 static void
315 push_menu_item (name, enable, key, def, equiv, type, selected, help)
316 Lisp_Object name, enable, key, def, equiv, type, selected, help;
318 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
319 grow_menu_items ();
321 XVECTOR (menu_items)->contents[menu_items_used++] = name;
322 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
323 XVECTOR (menu_items)->contents[menu_items_used++] = key;
324 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
325 XVECTOR (menu_items)->contents[menu_items_used++] = def;
326 XVECTOR (menu_items)->contents[menu_items_used++] = type;
327 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
328 XVECTOR (menu_items)->contents[menu_items_used++] = help;
331 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
332 and generate menu panes for them in menu_items.
333 If NOTREAL is nonzero,
334 don't bother really computing whether an item is enabled. */
336 static void
337 keymap_panes (keymaps, nmaps, notreal)
338 Lisp_Object *keymaps;
339 int nmaps;
340 int notreal;
342 int mapno;
344 init_menu_items ();
346 /* Loop over the given keymaps, making a pane for each map.
347 But don't make a pane that is empty--ignore that map instead.
348 P is the number of panes we have made so far. */
349 for (mapno = 0; mapno < nmaps; mapno++)
350 single_keymap_panes (keymaps[mapno],
351 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
353 finish_menu_items ();
356 /* Args passed between single_keymap_panes and single_menu_item. */
357 struct skp
359 Lisp_Object pending_maps;
360 int maxdepth, notreal;
363 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
364 void *));
366 /* This is a recursive subroutine of keymap_panes.
367 It handles one keymap, KEYMAP.
368 The other arguments are passed along
369 or point to local variables of the previous function.
370 If NOTREAL is nonzero, only check for equivalent key bindings, don't
371 evaluate expressions in menu items and don't make any menu.
373 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
375 static void
376 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
377 Lisp_Object keymap;
378 Lisp_Object pane_name;
379 Lisp_Object prefix;
380 int notreal;
381 int maxdepth;
383 struct skp skp;
384 struct gcpro gcpro1;
386 skp.pending_maps = Qnil;
387 skp.maxdepth = maxdepth;
388 skp.notreal = notreal;
390 if (maxdepth <= 0)
391 return;
393 push_menu_pane (pane_name, prefix);
395 GCPRO1 (skp.pending_maps);
396 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
397 UNGCPRO;
399 /* Process now any submenus which want to be panes at this level. */
400 while (CONSP (skp.pending_maps))
402 Lisp_Object elt, eltcdr, string;
403 elt = XCAR (skp.pending_maps);
404 eltcdr = XCDR (elt);
405 string = XCAR (eltcdr);
406 /* We no longer discard the @ from the beginning of the string here.
407 Instead, we do this in mac_menu_show. */
408 single_keymap_panes (Fcar (elt), string,
409 XCDR (eltcdr), notreal, maxdepth - 1);
410 skp.pending_maps = XCDR (skp.pending_maps);
414 /* This is a subroutine of single_keymap_panes that handles one
415 keymap entry.
416 KEY is a key in a keymap and ITEM is its binding.
417 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
418 separate panes.
419 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
420 evaluate expressions in menu items and don't make any menu.
421 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
423 static void
424 single_menu_item (key, item, dummy, skp_v)
425 Lisp_Object key, item, dummy;
426 void *skp_v;
428 Lisp_Object map, item_string, enabled;
429 struct gcpro gcpro1, gcpro2;
430 int res;
431 struct skp *skp = skp_v;
433 /* Parse the menu item and leave the result in item_properties. */
434 GCPRO2 (key, item);
435 res = parse_menu_item (item, skp->notreal, 0);
436 UNGCPRO;
437 if (!res)
438 return; /* Not a menu item. */
440 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
442 if (skp->notreal)
444 /* We don't want to make a menu, just traverse the keymaps to
445 precompute equivalent key bindings. */
446 if (!NILP (map))
447 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
448 return;
451 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
452 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
454 if (!NILP (map) && SREF (item_string, 0) == '@')
456 if (!NILP (enabled))
457 /* An enabled separate pane. Remember this to handle it later. */
458 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
459 skp->pending_maps);
460 return;
463 push_menu_item (item_string, enabled, key,
464 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
465 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
466 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
467 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
468 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
470 /* Display a submenu using the toolkit. */
471 if (! (NILP (map) || NILP (enabled)))
473 push_submenu_start ();
474 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
475 push_submenu_end ();
479 /* Push all the panes and items of a menu described by the
480 alist-of-alists MENU.
481 This handles old-fashioned calls to x-popup-menu. */
483 static void
484 list_of_panes (menu)
485 Lisp_Object menu;
487 Lisp_Object tail;
489 init_menu_items ();
491 for (tail = menu; CONSP (tail); tail = XCDR (tail))
493 Lisp_Object elt, pane_name, pane_data;
494 elt = XCAR (tail);
495 pane_name = Fcar (elt);
496 CHECK_STRING (pane_name);
497 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
498 pane_data = Fcdr (elt);
499 CHECK_CONS (pane_data);
500 list_of_items (pane_data);
503 finish_menu_items ();
506 /* Push the items in a single pane defined by the alist PANE. */
508 static void
509 list_of_items (pane)
510 Lisp_Object pane;
512 Lisp_Object tail, item, item1;
514 for (tail = pane; CONSP (tail); tail = XCDR (tail))
516 item = XCAR (tail);
517 if (STRINGP (item))
518 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
519 Qnil, Qnil, Qnil, Qnil);
520 else if (CONSP (item))
522 item1 = XCAR (item);
523 CHECK_STRING (item1);
524 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
525 Qt, Qnil, Qnil, Qnil, Qnil);
527 else
528 push_left_right_boundary ();
533 static Lisp_Object
534 cleanup_popup_menu (arg)
535 Lisp_Object arg;
537 discard_menu_items ();
538 return Qnil;
541 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
542 doc: /* Pop up a deck-of-cards menu and return user's selection.
543 POSITION is a position specification. This is either a mouse button event
544 or a list ((XOFFSET YOFFSET) WINDOW)
545 where XOFFSET and YOFFSET are positions in pixels from the top left
546 corner of WINDOW. (WINDOW may be a window or a frame object.)
547 This controls the position of the top left of the menu as a whole.
548 If POSITION is t, it means to use the current mouse position.
550 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
551 The menu items come from key bindings that have a menu string as well as
552 a definition; actually, the "definition" in such a key binding looks like
553 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
554 the keymap as a top-level element.
556 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
557 Otherwise, REAL-DEFINITION should be a valid key binding definition.
559 You can also use a list of keymaps as MENU.
560 Then each keymap makes a separate pane.
562 When MENU is a keymap or a list of keymaps, the return value is the
563 list of events corresponding to the user's choice. Note that
564 `x-popup-menu' does not actually execute the command bound to that
565 sequence of events.
567 Alternatively, you can specify a menu of multiple panes
568 with a list of the form (TITLE PANE1 PANE2...),
569 where each pane is a list of form (TITLE ITEM1 ITEM2...).
570 Each ITEM is normally a cons cell (STRING . VALUE);
571 but a string can appear as an item--that makes a nonselectable line
572 in the menu.
573 With this form of menu, the return value is VALUE from the chosen item.
575 If POSITION is nil, don't display the menu at all, just precalculate the
576 cached information about equivalent key sequences.
578 If the user gets rid of the menu without making a valid choice, for
579 instance by clicking the mouse away from a valid choice or by typing
580 keyboard input, then this normally results in a quit and
581 `x-popup-menu' does not return. But if POSITION is a mouse button
582 event (indicating that the user invoked the menu with the mouse) then
583 no quit occurs and `x-popup-menu' returns nil. */)
584 (position, menu)
585 Lisp_Object position, menu;
587 Lisp_Object keymap, tem;
588 int xpos = 0, ypos = 0;
589 Lisp_Object title;
590 char *error_name = NULL;
591 Lisp_Object selection;
592 FRAME_PTR f = NULL;
593 Lisp_Object x, y, window;
594 int keymaps = 0;
595 int for_click = 0;
596 int specpdl_count = SPECPDL_INDEX ();
597 struct gcpro gcpro1;
599 #ifdef HAVE_MENUS
600 if (! NILP (position))
602 check_mac ();
604 /* Decode the first argument: find the window and the coordinates. */
605 if (EQ (position, Qt)
606 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
607 || EQ (XCAR (position), Qtool_bar)
608 || EQ (XCAR (position), Qmac_apple_event))))
610 /* Use the mouse's current position. */
611 FRAME_PTR new_f = SELECTED_FRAME ();
612 Lisp_Object bar_window;
613 enum scroll_bar_part part;
614 unsigned long time;
616 if (FRAME_TERMINAL (new_f)->mouse_position_hook)
617 (*FRAME_TERMINAL (new_f)->mouse_position_hook) (&new_f, 1, &bar_window,
618 &part, &x, &y, &time);
619 if (new_f != 0)
620 XSETFRAME (window, new_f);
621 else
623 window = selected_window;
624 XSETFASTINT (x, 0);
625 XSETFASTINT (y, 0);
628 else
630 tem = Fcar (position);
631 if (CONSP (tem))
633 window = Fcar (Fcdr (position));
634 x = XCAR (tem);
635 y = Fcar (XCDR (tem));
637 else
639 for_click = 1;
640 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
641 window = Fcar (tem); /* POSN_WINDOW (tem) */
642 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
643 x = Fcar (tem);
644 y = Fcdr (tem);
648 CHECK_NUMBER (x);
649 CHECK_NUMBER (y);
651 /* Decode where to put the menu. */
653 if (FRAMEP (window))
655 f = XFRAME (window);
656 xpos = 0;
657 ypos = 0;
659 else if (WINDOWP (window))
661 CHECK_LIVE_WINDOW (window);
662 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
664 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
665 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
667 else
668 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
669 but I don't want to make one now. */
670 CHECK_WINDOW (window);
672 xpos += XINT (x);
673 ypos += XINT (y);
675 XSETFRAME (Vmenu_updating_frame, f);
677 else
678 Vmenu_updating_frame = Qnil;
679 #endif /* HAVE_MENUS */
681 title = Qnil;
682 GCPRO1 (title);
684 /* Decode the menu items from what was specified. */
686 keymap = get_keymap (menu, 0, 0);
687 if (CONSP (keymap))
689 /* We were given a keymap. Extract menu info from the keymap. */
690 Lisp_Object prompt;
692 /* Extract the detailed info to make one pane. */
693 keymap_panes (&menu, 1, NILP (position));
695 /* Search for a string appearing directly as an element of the keymap.
696 That string is the title of the menu. */
697 prompt = Fkeymap_prompt (keymap);
698 if (NILP (title) && !NILP (prompt))
699 title = prompt;
701 /* Make that be the pane title of the first pane. */
702 if (!NILP (prompt) && menu_items_n_panes >= 0)
703 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
705 keymaps = 1;
707 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
709 /* We were given a list of keymaps. */
710 int nmaps = XFASTINT (Flength (menu));
711 Lisp_Object *maps
712 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
713 int i;
715 title = Qnil;
717 /* The first keymap that has a prompt string
718 supplies the menu title. */
719 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
721 Lisp_Object prompt;
723 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
725 prompt = Fkeymap_prompt (keymap);
726 if (NILP (title) && !NILP (prompt))
727 title = prompt;
730 /* Extract the detailed info to make one pane. */
731 keymap_panes (maps, nmaps, NILP (position));
733 /* Make the title be the pane title of the first pane. */
734 if (!NILP (title) && menu_items_n_panes >= 0)
735 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
737 keymaps = 1;
739 else
741 /* We were given an old-fashioned menu. */
742 title = Fcar (menu);
743 CHECK_STRING (title);
745 list_of_panes (Fcdr (menu));
747 keymaps = 0;
750 if (NILP (position))
752 discard_menu_items ();
753 UNGCPRO;
754 return Qnil;
757 #ifdef HAVE_MENUS
758 /* Display them in a menu. */
759 record_unwind_protect (cleanup_popup_menu, Qnil);
760 BLOCK_INPUT;
762 selection = mac_menu_show (f, xpos, ypos, for_click,
763 keymaps, title, &error_name);
764 UNBLOCK_INPUT;
765 unbind_to (specpdl_count, Qnil);
767 UNGCPRO;
768 #endif /* HAVE_MENUS */
770 if (error_name) error (error_name);
771 return selection;
774 #ifdef HAVE_MENUS
776 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
777 doc: /* Pop up a dialog box and return user's selection.
778 POSITION specifies which frame to use.
779 This is normally a mouse button event or a window or frame.
780 If POSITION is t, it means to use the frame the mouse is on.
781 The dialog box appears in the middle of the specified frame.
783 CONTENTS specifies the alternatives to display in the dialog box.
784 It is a list of the form (DIALOG ITEM1 ITEM2...).
785 Each ITEM is a cons cell (STRING . VALUE).
786 The return value is VALUE from the chosen item.
788 An ITEM may also be just a string--that makes a nonselectable item.
789 An ITEM may also be nil--that means to put all preceding items
790 on the left of the dialog box and all following items on the right.
791 \(By default, approximately half appear on each side.)
793 If HEADER is non-nil, the frame title for the box is "Information",
794 otherwise it is "Question".
796 If the user gets rid of the dialog box without making a valid choice,
797 for instance using the window manager, then this produces a quit and
798 `x-popup-dialog' does not return. */)
799 (position, contents, header)
800 Lisp_Object position, contents, header;
802 FRAME_PTR f = NULL;
803 Lisp_Object window;
805 check_mac ();
807 /* Decode the first argument: find the window or frame to use. */
808 if (EQ (position, Qt)
809 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
810 || EQ (XCAR (position), Qtool_bar)
811 || EQ (XCAR (position), Qmac_apple_event))))
813 #if 0 /* Using the frame the mouse is on may not be right. */
814 /* Use the mouse's current position. */
815 FRAME_PTR new_f = SELECTED_FRAME ();
816 Lisp_Object bar_window;
817 enum scroll_bar_part part;
818 unsigned long time;
819 Lisp_Object x, y;
821 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
823 if (new_f != 0)
824 XSETFRAME (window, new_f);
825 else
826 window = selected_window;
827 #endif
828 window = selected_window;
830 else if (CONSP (position))
832 Lisp_Object tem;
833 tem = Fcar (position);
834 if (CONSP (tem))
835 window = Fcar (Fcdr (position));
836 else
838 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
839 window = Fcar (tem); /* POSN_WINDOW (tem) */
842 else if (WINDOWP (position) || FRAMEP (position))
843 window = position;
844 else
845 window = Qnil;
847 /* Decode where to put the menu. */
849 if (FRAMEP (window))
850 f = XFRAME (window);
851 else if (WINDOWP (window))
853 CHECK_LIVE_WINDOW (window);
854 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
856 else
857 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
858 but I don't want to make one now. */
859 CHECK_WINDOW (window);
861 #ifndef HAVE_DIALOGS
862 /* Display a menu with these alternatives
863 in the middle of frame F. */
865 Lisp_Object x, y, frame, newpos;
866 XSETFRAME (frame, f);
867 XSETINT (x, x_pixel_width (f) / 2);
868 XSETINT (y, x_pixel_height (f) / 2);
869 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
871 return Fx_popup_menu (newpos,
872 Fcons (Fcar (contents), Fcons (contents, Qnil)));
874 #else /* HAVE_DIALOGS */
876 Lisp_Object title;
877 char *error_name;
878 Lisp_Object selection;
879 int specpdl_count = SPECPDL_INDEX ();
881 /* Decode the dialog items from what was specified. */
882 title = Fcar (contents);
883 CHECK_STRING (title);
885 list_of_panes (Fcons (contents, Qnil));
887 /* Display them in a dialog box. */
888 record_unwind_protect (cleanup_popup_menu, Qnil);
889 BLOCK_INPUT;
890 selection = mac_dialog_show (f, 0, title, header, &error_name);
891 UNBLOCK_INPUT;
892 unbind_to (specpdl_count, Qnil);
894 if (error_name) error (error_name);
895 return selection;
897 #endif /* HAVE_DIALOGS */
900 /* Find the menu selection and store it in the keyboard buffer.
901 F is the frame the menu is on.
902 MENU_BAR_ITEMS_USED is the length of VECTOR.
903 VECTOR is an array of menu events for the whole menu. */
905 void
906 find_and_call_menu_selection (f, menu_bar_items_used, vector, client_data)
907 FRAME_PTR f;
908 int menu_bar_items_used;
909 Lisp_Object vector;
910 void *client_data;
912 Lisp_Object prefix, entry;
913 Lisp_Object *subprefix_stack;
914 int submenu_depth = 0;
915 int i;
917 entry = Qnil;
918 subprefix_stack = (Lisp_Object *) alloca (menu_bar_items_used * sizeof (Lisp_Object));
919 prefix = Qnil;
920 i = 0;
922 while (i < menu_bar_items_used)
924 if (EQ (XVECTOR (vector)->contents[i], Qnil))
926 subprefix_stack[submenu_depth++] = prefix;
927 prefix = entry;
928 i++;
930 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
932 prefix = subprefix_stack[--submenu_depth];
933 i++;
935 else if (EQ (XVECTOR (vector)->contents[i], Qt))
937 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
938 i += MENU_ITEMS_PANE_LENGTH;
940 else
942 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
943 /* The EMACS_INT cast avoids a warning. There's no problem
944 as long as pointers have enough bits to hold small integers. */
945 if ((int) (EMACS_INT) client_data == i)
947 int j;
948 struct input_event buf;
949 Lisp_Object frame;
950 EVENT_INIT (buf);
952 XSETFRAME (frame, f);
953 buf.kind = MENU_BAR_EVENT;
954 buf.frame_or_window = frame;
955 buf.arg = frame;
956 kbd_buffer_store_event (&buf);
958 for (j = 0; j < submenu_depth; j++)
959 if (!NILP (subprefix_stack[j]))
961 buf.kind = MENU_BAR_EVENT;
962 buf.frame_or_window = frame;
963 buf.arg = subprefix_stack[j];
964 kbd_buffer_store_event (&buf);
967 if (!NILP (prefix))
969 buf.kind = MENU_BAR_EVENT;
970 buf.frame_or_window = frame;
971 buf.arg = prefix;
972 kbd_buffer_store_event (&buf);
975 buf.kind = MENU_BAR_EVENT;
976 buf.frame_or_window = frame;
977 buf.arg = entry;
978 kbd_buffer_store_event (&buf);
980 return;
982 i += MENU_ITEMS_ITEM_LENGTH;
987 /* Allocate a widget_value, blocking input. */
989 widget_value *
990 xmalloc_widget_value ()
992 widget_value *value;
994 BLOCK_INPUT;
995 value = malloc_widget_value ();
996 UNBLOCK_INPUT;
998 return value;
1001 /* This recursively calls free_widget_value on the tree of widgets.
1002 It must free all data that was malloc'ed for these widget_values.
1003 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1004 must be left alone. */
1006 void
1007 free_menubar_widget_value_tree (wv)
1008 widget_value *wv;
1010 if (! wv) return;
1012 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1014 if (wv->contents && (wv->contents != (widget_value*)1))
1016 free_menubar_widget_value_tree (wv->contents);
1017 wv->contents = (widget_value *) 0xDEADBEEF;
1019 if (wv->next)
1021 free_menubar_widget_value_tree (wv->next);
1022 wv->next = (widget_value *) 0xDEADBEEF;
1024 BLOCK_INPUT;
1025 free_widget_value (wv);
1026 UNBLOCK_INPUT;
1029 /* Set up data in menu_items for a menu bar item
1030 whose event type is ITEM_KEY (with string ITEM_NAME)
1031 and whose contents come from the list of keymaps MAPS. */
1033 static int
1034 parse_single_submenu (item_key, item_name, maps)
1035 Lisp_Object item_key, item_name, maps;
1037 Lisp_Object length;
1038 int len;
1039 Lisp_Object *mapvec;
1040 int i;
1041 int top_level_items = 0;
1043 length = Flength (maps);
1044 len = XINT (length);
1046 /* Convert the list MAPS into a vector MAPVEC. */
1047 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1048 for (i = 0; i < len; i++)
1050 mapvec[i] = Fcar (maps);
1051 maps = Fcdr (maps);
1054 /* Loop over the given keymaps, making a pane for each map.
1055 But don't make a pane that is empty--ignore that map instead. */
1056 for (i = 0; i < len; i++)
1058 if (!KEYMAPP (mapvec[i]))
1060 /* Here we have a command at top level in the menu bar
1061 as opposed to a submenu. */
1062 top_level_items = 1;
1063 push_menu_pane (Qnil, Qnil);
1064 push_menu_item (item_name, Qt, item_key, mapvec[i],
1065 Qnil, Qnil, Qnil, Qnil);
1067 else
1069 Lisp_Object prompt;
1070 prompt = Fkeymap_prompt (mapvec[i]);
1071 single_keymap_panes (mapvec[i],
1072 !NILP (prompt) ? prompt : item_name,
1073 item_key, 0, 10);
1077 return top_level_items;
1080 /* Create a tree of widget_value objects
1081 representing the panes and items
1082 in menu_items starting at index START, up to index END. */
1084 static widget_value *
1085 digest_single_submenu (start, end, top_level_items)
1086 int start, end, top_level_items;
1088 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1089 int i;
1090 int submenu_depth = 0;
1091 widget_value **submenu_stack;
1092 int panes_seen = 0;
1094 submenu_stack
1095 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1096 wv = xmalloc_widget_value ();
1097 wv->name = "menu";
1098 wv->value = 0;
1099 wv->enabled = 1;
1100 wv->button_type = BUTTON_TYPE_NONE;
1101 wv->help = Qnil;
1102 first_wv = wv;
1103 save_wv = 0;
1104 prev_wv = 0;
1106 /* Loop over all panes and items made by the preceding call
1107 to parse_single_submenu and construct a tree of widget_value objects.
1108 Ignore the panes and items used by previous calls to
1109 digest_single_submenu, even though those are also in menu_items. */
1110 i = start;
1111 while (i < end)
1113 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1115 submenu_stack[submenu_depth++] = save_wv;
1116 save_wv = prev_wv;
1117 prev_wv = 0;
1118 i++;
1120 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1122 prev_wv = save_wv;
1123 save_wv = submenu_stack[--submenu_depth];
1124 i++;
1126 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1127 && submenu_depth != 0)
1128 i += MENU_ITEMS_PANE_LENGTH;
1129 /* Ignore a nil in the item list.
1130 It's meaningful only for dialog boxes. */
1131 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1132 i += 1;
1133 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1135 /* Create a new pane. */
1136 Lisp_Object pane_name, prefix;
1137 char *pane_string;
1139 panes_seen++;
1141 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1142 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1144 #ifndef HAVE_MULTILINGUAL_MENU
1145 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1147 pane_name = ENCODE_MENU_STRING (pane_name);
1148 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1150 #endif
1151 pane_string = (NILP (pane_name)
1152 ? "" : (char *) SDATA (pane_name));
1153 /* If there is just one top-level pane, put all its items directly
1154 under the top-level menu. */
1155 if (menu_items_n_panes == 1)
1156 pane_string = "";
1158 /* If the pane has a meaningful name,
1159 make the pane a top-level menu item
1160 with its items as a submenu beneath it. */
1161 if (strcmp (pane_string, ""))
1163 wv = xmalloc_widget_value ();
1164 if (save_wv)
1165 save_wv->next = wv;
1166 else
1167 first_wv->contents = wv;
1168 wv->lname = pane_name;
1169 /* Set value to 1 so update_submenu_strings can handle '@' */
1170 wv->value = (char *)1;
1171 wv->enabled = 1;
1172 wv->button_type = BUTTON_TYPE_NONE;
1173 wv->help = Qnil;
1174 save_wv = wv;
1176 else
1177 save_wv = first_wv;
1179 prev_wv = 0;
1180 i += MENU_ITEMS_PANE_LENGTH;
1182 else
1184 /* Create a new item within current pane. */
1185 Lisp_Object item_name, enable, descrip, def, type, selected;
1186 Lisp_Object help;
1188 /* All items should be contained in panes. */
1189 if (panes_seen == 0)
1190 abort ();
1192 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1193 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1194 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1195 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1196 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1197 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1198 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1200 #ifndef HAVE_MULTILINGUAL_MENU
1201 if (STRING_MULTIBYTE (item_name))
1203 item_name = ENCODE_MENU_STRING (item_name);
1204 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1207 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1209 descrip = ENCODE_MENU_STRING (descrip);
1210 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1212 #endif /* not HAVE_MULTILINGUAL_MENU */
1214 wv = xmalloc_widget_value ();
1215 if (prev_wv)
1216 prev_wv->next = wv;
1217 else
1218 save_wv->contents = wv;
1220 wv->lname = item_name;
1221 if (!NILP (descrip))
1222 wv->lkey = descrip;
1223 wv->value = 0;
1224 /* The EMACS_INT cast avoids a warning. There's no problem
1225 as long as pointers have enough bits to hold small integers. */
1226 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1227 wv->enabled = !NILP (enable);
1229 if (NILP (type))
1230 wv->button_type = BUTTON_TYPE_NONE;
1231 else if (EQ (type, QCradio))
1232 wv->button_type = BUTTON_TYPE_RADIO;
1233 else if (EQ (type, QCtoggle))
1234 wv->button_type = BUTTON_TYPE_TOGGLE;
1235 else
1236 abort ();
1238 wv->selected = !NILP (selected);
1239 if (! STRINGP (help))
1240 help = Qnil;
1242 wv->help = help;
1244 prev_wv = wv;
1246 i += MENU_ITEMS_ITEM_LENGTH;
1250 /* If we have just one "menu item"
1251 that was originally a button, return it by itself. */
1252 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1254 wv = first_wv->contents;
1255 free_widget_value (first_wv);
1256 return wv;
1259 return first_wv;
1262 /* Walk through the widget_value tree starting at FIRST_WV and update
1263 the char * pointers from the corresponding lisp values.
1264 We do this after building the whole tree, since GC may happen while the
1265 tree is constructed, and small strings are relocated. So we must wait
1266 until no GC can happen before storing pointers into lisp values. */
1267 static void
1268 update_submenu_strings (first_wv)
1269 widget_value *first_wv;
1271 widget_value *wv;
1273 for (wv = first_wv; wv; wv = wv->next)
1275 if (STRINGP (wv->lname))
1277 wv->name = SDATA (wv->lname);
1279 /* Ignore the @ that means "separate pane".
1280 This is a kludge, but this isn't worth more time. */
1281 if (wv->value == (char *)1)
1283 if (wv->name[0] == '@')
1284 wv->name++;
1285 wv->value = 0;
1289 if (STRINGP (wv->lkey))
1290 wv->key = SDATA (wv->lkey);
1292 if (wv->contents)
1293 update_submenu_strings (wv->contents);
1298 /* Set the contents of the menubar widgets of frame F.
1299 The argument FIRST_TIME is currently ignored;
1300 it is set the first time this is called, from initialize_frame_menubar. */
1302 void
1303 set_frame_menubar (f, first_time, deep_p)
1304 FRAME_PTR f;
1305 int first_time;
1306 int deep_p;
1308 int menubar_widget = f->output_data.mac->menubar_widget;
1309 Lisp_Object items;
1310 widget_value *wv, *first_wv, *prev_wv = 0;
1311 int i, last_i = 0;
1312 int *submenu_start, *submenu_end;
1313 int *submenu_top_level_items, *submenu_n_panes;
1315 XSETFRAME (Vmenu_updating_frame, f);
1317 /* This seems to be unnecessary for Carbon. */
1318 #if 0
1319 if (! menubar_widget)
1320 deep_p = 1;
1321 else if (pending_menu_activation && !deep_p)
1322 deep_p = 1;
1323 #endif
1325 if (deep_p)
1327 /* Make a widget-value tree representing the entire menu trees. */
1329 struct buffer *prev = current_buffer;
1330 Lisp_Object buffer;
1331 int specpdl_count = SPECPDL_INDEX ();
1332 int previous_menu_items_used = f->menu_bar_items_used;
1333 Lisp_Object *previous_items
1334 = (Lisp_Object *) alloca (previous_menu_items_used
1335 * sizeof (Lisp_Object));
1337 /* If we are making a new widget, its contents are empty,
1338 do always reinitialize them. */
1339 if (! menubar_widget)
1340 previous_menu_items_used = 0;
1342 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1343 specbind (Qinhibit_quit, Qt);
1344 /* Don't let the debugger step into this code
1345 because it is not reentrant. */
1346 specbind (Qdebug_on_next_call, Qnil);
1348 record_unwind_save_match_data ();
1349 if (NILP (Voverriding_local_map_menu_flag))
1351 specbind (Qoverriding_terminal_local_map, Qnil);
1352 specbind (Qoverriding_local_map, Qnil);
1355 set_buffer_internal_1 (XBUFFER (buffer));
1357 /* Run the Lucid hook. */
1358 safe_run_hooks (Qactivate_menubar_hook);
1360 /* If it has changed current-menubar from previous value,
1361 really recompute the menubar from the value. */
1362 if (! NILP (Vlucid_menu_bar_dirty_flag))
1363 call0 (Qrecompute_lucid_menubar);
1364 safe_run_hooks (Qmenu_bar_update_hook);
1365 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1367 items = FRAME_MENU_BAR_ITEMS (f);
1369 /* Save the frame's previous menu bar contents data. */
1370 if (previous_menu_items_used)
1371 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1372 previous_menu_items_used * sizeof (Lisp_Object));
1374 /* Fill in menu_items with the current menu bar contents.
1375 This can evaluate Lisp code. */
1376 save_menu_items ();
1378 menu_items = f->menu_bar_vector;
1379 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1380 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1381 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1382 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1383 submenu_top_level_items
1384 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1385 init_menu_items ();
1386 for (i = 0; i < XVECTOR (items)->size; i += 4)
1388 Lisp_Object key, string, maps;
1390 last_i = i;
1392 key = XVECTOR (items)->contents[i];
1393 string = XVECTOR (items)->contents[i + 1];
1394 maps = XVECTOR (items)->contents[i + 2];
1395 if (NILP (string))
1396 break;
1398 submenu_start[i] = menu_items_used;
1400 menu_items_n_panes = 0;
1401 submenu_top_level_items[i]
1402 = parse_single_submenu (key, string, maps);
1403 submenu_n_panes[i] = menu_items_n_panes;
1405 submenu_end[i] = menu_items_used;
1408 finish_menu_items ();
1410 /* Convert menu_items into widget_value trees
1411 to display the menu. This cannot evaluate Lisp code. */
1413 wv = xmalloc_widget_value ();
1414 wv->name = "menubar";
1415 wv->value = 0;
1416 wv->enabled = 1;
1417 wv->button_type = BUTTON_TYPE_NONE;
1418 wv->help = Qnil;
1419 first_wv = wv;
1421 for (i = 0; i < last_i; i += 4)
1423 menu_items_n_panes = submenu_n_panes[i];
1424 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1425 submenu_top_level_items[i]);
1426 if (prev_wv)
1427 prev_wv->next = wv;
1428 else
1429 first_wv->contents = wv;
1430 /* Don't set wv->name here; GC during the loop might relocate it. */
1431 wv->enabled = 1;
1432 wv->button_type = BUTTON_TYPE_NONE;
1433 prev_wv = wv;
1436 set_buffer_internal_1 (prev);
1438 /* If there has been no change in the Lisp-level contents
1439 of the menu bar, skip redisplaying it. Just exit. */
1441 /* Compare the new menu items with the ones computed last time. */
1442 for (i = 0; i < previous_menu_items_used; i++)
1443 if (menu_items_used == i
1444 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1445 break;
1446 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1448 /* The menu items have not changed. Don't bother updating
1449 the menus in any form, since it would be a no-op. */
1450 free_menubar_widget_value_tree (first_wv);
1451 discard_menu_items ();
1452 unbind_to (specpdl_count, Qnil);
1453 return;
1456 /* The menu items are different, so store them in the frame. */
1457 f->menu_bar_vector = menu_items;
1458 f->menu_bar_items_used = menu_items_used;
1460 /* This calls restore_menu_items to restore menu_items, etc.,
1461 as they were outside. */
1462 unbind_to (specpdl_count, Qnil);
1464 /* Now GC cannot happen during the lifetime of the widget_value,
1465 so it's safe to store data from a Lisp_String. */
1466 wv = first_wv->contents;
1467 for (i = 0; i < XVECTOR (items)->size; i += 4)
1469 Lisp_Object string;
1470 string = XVECTOR (items)->contents[i + 1];
1471 if (NILP (string))
1472 break;
1473 wv->name = (char *) SDATA (string);
1474 update_submenu_strings (wv->contents);
1475 wv = wv->next;
1479 else
1481 /* Make a widget-value tree containing
1482 just the top level menu bar strings. */
1484 wv = xmalloc_widget_value ();
1485 wv->name = "menubar";
1486 wv->value = 0;
1487 wv->enabled = 1;
1488 wv->button_type = BUTTON_TYPE_NONE;
1489 wv->help = Qnil;
1490 first_wv = wv;
1492 items = FRAME_MENU_BAR_ITEMS (f);
1493 for (i = 0; i < XVECTOR (items)->size; i += 4)
1495 Lisp_Object string;
1497 string = XVECTOR (items)->contents[i + 1];
1498 if (NILP (string))
1499 break;
1501 wv = xmalloc_widget_value ();
1502 wv->name = (char *) SDATA (string);
1503 wv->value = 0;
1504 wv->enabled = 1;
1505 wv->button_type = BUTTON_TYPE_NONE;
1506 wv->help = Qnil;
1507 /* This prevents lwlib from assuming this
1508 menu item is really supposed to be empty. */
1509 /* The EMACS_INT cast avoids a warning.
1510 This value just has to be different from small integers. */
1511 wv->call_data = (void *) (EMACS_INT) (-1);
1513 if (prev_wv)
1514 prev_wv->next = wv;
1515 else
1516 first_wv->contents = wv;
1517 prev_wv = wv;
1520 /* Forget what we thought we knew about what is in the
1521 detailed contents of the menu bar menus.
1522 Changing the top level always destroys the contents. */
1523 f->menu_bar_items_used = 0;
1526 /* Create or update the menu bar widget. */
1528 BLOCK_INPUT;
1530 /* Non-null value to indicate menubar has already been "created". */
1531 f->output_data.mac->menubar_widget = 1;
1533 mac_fill_menubar (first_wv->contents, deep_p);
1535 free_menubar_widget_value_tree (first_wv);
1537 UNBLOCK_INPUT;
1540 /* Get rid of the menu bar of frame F, and free its storage.
1541 This is used when deleting a frame, and when turning off the menu bar. */
1543 void
1544 free_frame_menubar (f)
1545 FRAME_PTR f;
1547 f->output_data.mac->menubar_widget = 0;
1551 /* The item selected in the popup menu. */
1552 int menu_item_selection;
1554 /* Mac_menu_show actually displays a menu using the panes and items in
1555 menu_items and returns the value selected from it; we assume input
1556 is blocked by the caller. */
1558 /* F is the frame the menu is for.
1559 X and Y are the frame-relative specified position,
1560 relative to the inside upper left corner of the frame F.
1561 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1562 KEYMAPS is 1 if this menu was specified with keymaps;
1563 in that case, we return a list containing the chosen item's value
1564 and perhaps also the pane's prefix.
1565 TITLE is the specified menu title.
1566 ERROR is a place to store an error message string in case of failure.
1567 (We return nil on failure, but the value doesn't actually matter.) */
1569 static Lisp_Object
1570 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1571 FRAME_PTR f;
1572 int x;
1573 int y;
1574 int for_click;
1575 int keymaps;
1576 Lisp_Object title;
1577 char **error;
1579 int i;
1580 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1581 widget_value **submenu_stack
1582 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1583 Lisp_Object *subprefix_stack
1584 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1585 int submenu_depth = 0;
1587 int first_pane;
1589 *error = NULL;
1591 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1593 *error = "Empty menu";
1594 return Qnil;
1597 /* Create a tree of widget_value objects
1598 representing the panes and their items. */
1599 wv = xmalloc_widget_value ();
1600 wv->name = "menu";
1601 wv->value = 0;
1602 wv->enabled = 1;
1603 wv->button_type = BUTTON_TYPE_NONE;
1604 wv->help = Qnil;
1605 first_wv = wv;
1606 first_pane = 1;
1608 /* Loop over all panes and items, filling in the tree. */
1609 i = 0;
1610 while (i < menu_items_used)
1612 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1614 submenu_stack[submenu_depth++] = save_wv;
1615 save_wv = prev_wv;
1616 prev_wv = 0;
1617 first_pane = 1;
1618 i++;
1620 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1622 prev_wv = save_wv;
1623 save_wv = submenu_stack[--submenu_depth];
1624 first_pane = 0;
1625 i++;
1627 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1628 && submenu_depth != 0)
1629 i += MENU_ITEMS_PANE_LENGTH;
1630 /* Ignore a nil in the item list.
1631 It's meaningful only for dialog boxes. */
1632 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1633 i += 1;
1634 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1636 /* Create a new pane. */
1637 Lisp_Object pane_name, prefix;
1638 char *pane_string;
1640 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1641 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1643 #ifndef HAVE_MULTILINGUAL_MENU
1644 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1646 pane_name = ENCODE_MENU_STRING (pane_name);
1647 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1649 #endif
1650 pane_string = (NILP (pane_name)
1651 ? "" : (char *) SDATA (pane_name));
1652 /* If there is just one top-level pane, put all its items directly
1653 under the top-level menu. */
1654 if (menu_items_n_panes == 1)
1655 pane_string = "";
1657 /* If the pane has a meaningful name,
1658 make the pane a top-level menu item
1659 with its items as a submenu beneath it. */
1660 if (!keymaps && strcmp (pane_string, ""))
1662 wv = xmalloc_widget_value ();
1663 if (save_wv)
1664 save_wv->next = wv;
1665 else
1666 first_wv->contents = wv;
1667 wv->name = pane_string;
1668 if (keymaps && !NILP (prefix))
1669 wv->name++;
1670 wv->value = 0;
1671 wv->enabled = 1;
1672 wv->button_type = BUTTON_TYPE_NONE;
1673 wv->help = Qnil;
1674 save_wv = wv;
1675 prev_wv = 0;
1677 else if (first_pane)
1679 save_wv = wv;
1680 prev_wv = 0;
1682 first_pane = 0;
1683 i += MENU_ITEMS_PANE_LENGTH;
1685 else
1687 /* Create a new item within current pane. */
1688 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1689 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1690 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1691 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1692 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1693 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1694 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1695 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1697 #ifndef HAVE_MULTILINGUAL_MENU
1698 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1700 item_name = ENCODE_MENU_STRING (item_name);
1701 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1704 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1706 descrip = ENCODE_MENU_STRING (descrip);
1707 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1709 #endif /* not HAVE_MULTILINGUAL_MENU */
1711 wv = xmalloc_widget_value ();
1712 if (prev_wv)
1713 prev_wv->next = wv;
1714 else
1715 save_wv->contents = wv;
1716 wv->name = (char *) SDATA (item_name);
1717 if (!NILP (descrip))
1718 wv->key = (char *) SDATA (descrip);
1719 wv->value = 0;
1720 /* Use the contents index as call_data, since we are
1721 restricted to 16-bits. */
1722 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1723 wv->enabled = !NILP (enable);
1725 if (NILP (type))
1726 wv->button_type = BUTTON_TYPE_NONE;
1727 else if (EQ (type, QCtoggle))
1728 wv->button_type = BUTTON_TYPE_TOGGLE;
1729 else if (EQ (type, QCradio))
1730 wv->button_type = BUTTON_TYPE_RADIO;
1731 else
1732 abort ();
1734 wv->selected = !NILP (selected);
1736 if (! STRINGP (help))
1737 help = Qnil;
1739 wv->help = help;
1741 prev_wv = wv;
1743 i += MENU_ITEMS_ITEM_LENGTH;
1747 /* Deal with the title, if it is non-nil. */
1748 if (!NILP (title))
1750 widget_value *wv_title = xmalloc_widget_value ();
1751 widget_value *wv_sep = xmalloc_widget_value ();
1753 /* Maybe replace this separator with a bitmap or owner-draw item
1754 so that it looks better. Having two separators looks odd. */
1755 wv_sep->name = "--";
1756 wv_sep->next = first_wv->contents;
1757 wv_sep->help = Qnil;
1759 #ifndef HAVE_MULTILINGUAL_MENU
1760 if (STRING_MULTIBYTE (title))
1761 title = ENCODE_MENU_STRING (title);
1762 #endif
1764 wv_title->name = (char *) SDATA (title);
1765 wv_title->enabled = FALSE;
1766 wv_title->title = TRUE;
1767 wv_title->button_type = BUTTON_TYPE_NONE;
1768 wv_title->help = Qnil;
1769 wv_title->next = wv_sep;
1770 first_wv->contents = wv_title;
1773 /* No selection has been chosen yet. */
1774 menu_item_selection = 0;
1776 /* Actually create and show the menu until popped down. */
1777 create_and_show_popup_menu (f, first_wv, x, y, for_click);
1779 /* Free the widget_value objects we used to specify the contents. */
1780 free_menubar_widget_value_tree (first_wv);
1782 /* Find the selected item, and its pane, to return
1783 the proper value. */
1784 if (menu_item_selection != 0)
1786 Lisp_Object prefix, entry;
1788 prefix = entry = Qnil;
1789 i = 0;
1790 while (i < menu_items_used)
1792 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1794 subprefix_stack[submenu_depth++] = prefix;
1795 prefix = entry;
1796 i++;
1798 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1800 prefix = subprefix_stack[--submenu_depth];
1801 i++;
1803 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1805 prefix
1806 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1807 i += MENU_ITEMS_PANE_LENGTH;
1809 /* Ignore a nil in the item list.
1810 It's meaningful only for dialog boxes. */
1811 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1812 i += 1;
1813 else
1815 entry
1816 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
1817 if (menu_item_selection == i)
1819 if (keymaps != 0)
1821 int j;
1823 entry = Fcons (entry, Qnil);
1824 if (!NILP (prefix))
1825 entry = Fcons (prefix, entry);
1826 for (j = submenu_depth - 1; j >= 0; j--)
1827 if (!NILP (subprefix_stack[j]))
1828 entry = Fcons (subprefix_stack[j], entry);
1830 return entry;
1832 i += MENU_ITEMS_ITEM_LENGTH;
1836 else if (!for_click)
1837 /* Make "Cancel" equivalent to C-g. */
1838 Fsignal (Qquit, Qnil);
1840 return Qnil;
1844 #ifdef HAVE_DIALOGS
1845 /* Construct native Mac OS dialog based on widget_value tree. */
1847 static char * button_names [] = {
1848 "button1", "button2", "button3", "button4", "button5",
1849 "button6", "button7", "button8", "button9", "button10" };
1851 static Lisp_Object
1852 mac_dialog_show (f, keymaps, title, header, error_name)
1853 FRAME_PTR f;
1854 int keymaps;
1855 Lisp_Object title, header;
1856 char **error_name;
1858 int i, nb_buttons=0;
1859 char dialog_name[6];
1861 widget_value *wv, *first_wv = 0, *prev_wv = 0;
1863 /* Number of elements seen so far, before boundary. */
1864 int left_count = 0;
1865 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
1866 int boundary_seen = 0;
1868 *error_name = NULL;
1870 if (menu_items_n_panes > 1)
1872 *error_name = "Multiple panes in dialog box";
1873 return Qnil;
1876 /* Create a tree of widget_value objects
1877 representing the text label and buttons. */
1879 Lisp_Object pane_name, prefix;
1880 char *pane_string;
1881 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
1882 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
1883 pane_string = (NILP (pane_name)
1884 ? "" : (char *) SDATA (pane_name));
1885 prev_wv = xmalloc_widget_value ();
1886 prev_wv->value = pane_string;
1887 if (keymaps && !NILP (prefix))
1888 prev_wv->name++;
1889 prev_wv->enabled = 1;
1890 prev_wv->name = "message";
1891 prev_wv->help = Qnil;
1892 first_wv = prev_wv;
1894 /* Loop over all panes and items, filling in the tree. */
1895 i = MENU_ITEMS_PANE_LENGTH;
1896 while (i < menu_items_used)
1899 /* Create a new item within current pane. */
1900 Lisp_Object item_name, enable, descrip;
1901 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
1902 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
1903 descrip
1904 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
1906 if (NILP (item_name))
1908 free_menubar_widget_value_tree (first_wv);
1909 *error_name = "Submenu in dialog items";
1910 return Qnil;
1912 if (EQ (item_name, Qquote))
1914 /* This is the boundary between left-side elts
1915 and right-side elts. Stop incrementing right_count. */
1916 boundary_seen = 1;
1917 i++;
1918 continue;
1920 if (nb_buttons >= 9)
1922 free_menubar_widget_value_tree (first_wv);
1923 *error_name = "Too many dialog items";
1924 return Qnil;
1927 wv = xmalloc_widget_value ();
1928 prev_wv->next = wv;
1929 wv->name = (char *) button_names[nb_buttons];
1930 if (!NILP (descrip))
1931 wv->key = (char *) SDATA (descrip);
1932 wv->value = (char *) SDATA (item_name);
1933 wv->call_data = (void *) i;
1934 /* menu item is identified by its index in menu_items table */
1935 wv->enabled = !NILP (enable);
1936 wv->help = Qnil;
1937 prev_wv = wv;
1939 if (! boundary_seen)
1940 left_count++;
1942 nb_buttons++;
1943 i += MENU_ITEMS_ITEM_LENGTH;
1946 /* If the boundary was not specified,
1947 by default put half on the left and half on the right. */
1948 if (! boundary_seen)
1949 left_count = nb_buttons - nb_buttons / 2;
1951 wv = xmalloc_widget_value ();
1952 wv->name = dialog_name;
1953 wv->help = Qnil;
1955 /* Frame title: 'Q' = Question, 'I' = Information.
1956 Can also have 'E' = Error if, one day, we want
1957 a popup for errors. */
1958 if (NILP(header))
1959 dialog_name[0] = 'Q';
1960 else
1961 dialog_name[0] = 'I';
1963 /* Dialog boxes use a really stupid name encoding
1964 which specifies how many buttons to use
1965 and how many buttons are on the right. */
1966 dialog_name[1] = '0' + nb_buttons;
1967 dialog_name[2] = 'B';
1968 dialog_name[3] = 'R';
1969 /* Number of buttons to put on the right. */
1970 dialog_name[4] = '0' + nb_buttons - left_count;
1971 dialog_name[5] = 0;
1972 wv->contents = first_wv;
1973 first_wv = wv;
1976 /* No selection has been chosen yet. */
1977 menu_item_selection = 0;
1979 /* Force a redisplay before showing the dialog. If a frame is created
1980 just before showing the dialog, its contents may not have been fully
1981 drawn. */
1982 Fredisplay (Qt);
1984 /* Actually create the dialog. */
1985 #if TARGET_API_MAC_CARBON
1986 create_and_show_dialog (f, first_wv);
1987 #else
1988 menu_item_selection = mac_dialog (first_wv);
1989 #endif
1991 /* Free the widget_value objects we used to specify the contents. */
1992 free_menubar_widget_value_tree (first_wv);
1994 /* Find the selected item, and its pane, to return
1995 the proper value. */
1996 if (menu_item_selection != 0)
1998 Lisp_Object prefix;
2000 prefix = Qnil;
2001 i = 0;
2002 while (i < menu_items_used)
2004 Lisp_Object entry;
2006 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2008 prefix
2009 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2010 i += MENU_ITEMS_PANE_LENGTH;
2012 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2014 /* This is the boundary between left-side elts and
2015 right-side elts. */
2016 ++i;
2018 else
2020 entry
2021 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2022 if (menu_item_selection == i)
2024 if (keymaps != 0)
2026 entry = Fcons (entry, Qnil);
2027 if (!NILP (prefix))
2028 entry = Fcons (prefix, entry);
2030 return entry;
2032 i += MENU_ITEMS_ITEM_LENGTH;
2036 else
2037 /* Make "Cancel" equivalent to C-g. */
2038 Fsignal (Qquit, Qnil);
2040 return Qnil;
2042 #endif /* HAVE_DIALOGS */
2045 /* Is this item a separator? */
2047 name_is_separator (name)
2048 const char *name;
2050 const char *start = name;
2052 /* Check if name string consists of only dashes ('-'). */
2053 while (*name == '-') name++;
2054 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2055 or "--deep-shadow". We don't implement them yet, se we just treat
2056 them like normal separators. */
2057 return (*name == '\0' || start + 2 == name);
2059 #endif /* HAVE_MENUS */
2061 /* Detect if a menu is currently active. */
2064 popup_activated ()
2066 return popup_activated_flag;
2069 /* The following is used by delayed window autoselection. */
2071 DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_p, 0, 0, 0,
2072 doc: /* Return t if a menu or popup dialog is active. */)
2075 #if TARGET_API_MAC_CARBON
2076 return (popup_activated ()) ? Qt : Qnil;
2077 #else
2078 /* Always return Qnil since menu selection functions do not return
2079 until a selection has been made or cancelled. */
2080 return Qnil;
2081 #endif
2084 void
2085 syms_of_macmenu ()
2087 staticpro (&menu_items);
2088 menu_items = Qnil;
2090 Qdebug_on_next_call = intern ("debug-on-next-call");
2091 staticpro (&Qdebug_on_next_call);
2093 defsubr (&Sx_popup_menu);
2094 defsubr (&Smenu_or_popup_active_p);
2095 #ifdef HAVE_MENUS
2096 defsubr (&Sx_popup_dialog);
2097 #endif
2100 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2101 (do not change this comment) */