(enable-local-variables): Doc fix.
[emacs.git] / src / macmenu.c
blobfccbbe6402cb1fce82fa52ef79cb7d1623f01515
1 /* Menu support for GNU Emacs on Mac OS.
2 Copyright (C) 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 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 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* Contributed by Andrew Choi (akochoi@mac.com). */
24 #include <config.h>
26 #include <stdio.h>
28 #include "lisp.h"
29 #include "termhooks.h"
30 #include "keyboard.h"
31 #include "keymap.h"
32 #include "frame.h"
33 #include "window.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "charset.h"
37 #include "coding.h"
39 #if !TARGET_API_MAC_CARBON
40 #include <MacTypes.h>
41 #include <Menus.h>
42 #include <QuickDraw.h>
43 #include <ToolUtils.h>
44 #include <Fonts.h>
45 #include <Controls.h>
46 #include <Windows.h>
47 #include <Events.h>
48 #if defined (__MRC__) || (__MSL__ >= 0x6000)
49 #include <ControlDefinitions.h>
50 #endif
51 #endif /* not TARGET_API_MAC_CARBON */
53 /* This may include sys/types.h, and that somehow loses
54 if this is not done before the other system files. */
55 #include "macterm.h"
57 /* Load sys/types.h if not already loaded.
58 In some systems loading it twice is suicidal. */
59 #ifndef makedev
60 #include <sys/types.h>
61 #endif
63 #include "dispextern.h"
65 #define POPUP_SUBMENU_ID 235
66 #define MIN_POPUP_SUBMENU_ID 512
67 #define MIN_MENU_ID 256
68 #define MIN_SUBMENU_ID 1
70 #define DIALOG_WINDOW_RESOURCE 130
72 #define HAVE_DIALOGS 1
74 #undef HAVE_MULTILINGUAL_MENU
75 #undef HAVE_DIALOGS /* TODO: Implement native dialogs. */
77 /******************************************************************/
78 /* Definitions copied from lwlib.h */
80 typedef void * XtPointer;
82 enum button_type
84 BUTTON_TYPE_NONE,
85 BUTTON_TYPE_TOGGLE,
86 BUTTON_TYPE_RADIO
89 /* This structure is based on the one in ../lwlib/lwlib.h, modified
90 for Mac OS. */
91 typedef struct _widget_value
93 /* name of widget */
94 Lisp_Object lname;
95 char* name;
96 /* value (meaning depend on widget type) */
97 char* value;
98 /* keyboard equivalent. no implications for XtTranslations */
99 Lisp_Object lkey;
100 char* key;
101 /* Help string or nil if none.
102 GC finds this string through the frame's menu_bar_vector
103 or through menu_items. */
104 Lisp_Object help;
105 /* true if enabled */
106 Boolean enabled;
107 /* true if selected */
108 Boolean selected;
109 /* The type of a button. */
110 enum button_type button_type;
111 /* true if menu title */
112 Boolean title;
113 #if 0
114 /* true if was edited (maintained by get_value) */
115 Boolean edited;
116 /* true if has changed (maintained by lw library) */
117 change_type change;
118 /* true if this widget itself has changed,
119 but not counting the other widgets found in the `next' field. */
120 change_type this_one_change;
121 #endif
122 /* Contents of the sub-widgets, also selected slot for checkbox */
123 struct _widget_value* contents;
124 /* data passed to callback */
125 XtPointer call_data;
126 /* next one in the list */
127 struct _widget_value* next;
128 #if 0
129 /* slot for the toolkit dependent part. Always initialize to NULL. */
130 void* toolkit_data;
131 /* tell us if we should free the toolkit data slot when freeing the
132 widget_value itself. */
133 Boolean free_toolkit_data;
135 /* we resource the widget_value structures; this points to the next
136 one on the free list if this one has been deallocated.
138 struct _widget_value *free_list;
139 #endif
140 } widget_value;
142 /* Assumed by other routines to zero area returned. */
143 #define malloc_widget_value() (void *)memset (xmalloc (sizeof (widget_value)),\
144 0, (sizeof (widget_value)))
145 #define free_widget_value(wv) xfree (wv)
147 /******************************************************************/
149 #ifndef TRUE
150 #define TRUE 1
151 #define FALSE 0
152 #endif /* no TRUE */
154 Lisp_Object Vmenu_updating_frame;
156 Lisp_Object Qdebug_on_next_call;
158 extern Lisp_Object Qmenu_bar, Qmac_apple_event;
160 extern Lisp_Object QCtoggle, QCradio;
162 extern Lisp_Object Voverriding_local_map;
163 extern Lisp_Object Voverriding_local_map_menu_flag;
165 extern Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map;
167 extern Lisp_Object Qmenu_bar_update_hook;
169 void set_frame_menubar P_ ((FRAME_PTR, int, int));
171 #if TARGET_API_MAC_CARBON
172 #define ENCODE_MENU_STRING(str) ENCODE_UTF_8 (str)
173 #else
174 #define ENCODE_MENU_STRING(str) ENCODE_SYSTEM (str)
175 #endif
177 static void push_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
178 Lisp_Object, Lisp_Object, Lisp_Object,
179 Lisp_Object, Lisp_Object));
180 #ifdef HAVE_DIALOGS
181 static Lisp_Object mac_dialog_show P_ ((FRAME_PTR, int, Lisp_Object,
182 Lisp_Object, char **));
183 #endif
184 static Lisp_Object mac_menu_show P_ ((struct frame *, int, int, int, int,
185 Lisp_Object, char **));
186 static void keymap_panes P_ ((Lisp_Object *, int, int));
187 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
188 int, int));
189 static void list_of_panes P_ ((Lisp_Object));
190 static void list_of_items P_ ((Lisp_Object));
192 static int fill_menu P_ ((MenuHandle, widget_value *, int));
193 static void fill_menubar P_ ((widget_value *, int));
194 static void dispose_menus P_ ((int));
197 /* This holds a Lisp vector that holds the results of decoding
198 the keymaps or alist-of-alists that specify a menu.
200 It describes the panes and items within the panes.
202 Each pane is described by 3 elements in the vector:
203 t, the pane name, the pane's prefix key.
204 Then follow the pane's items, with 5 elements per item:
205 the item string, the enable flag, the item's value,
206 the definition, and the equivalent keyboard key's description string.
208 In some cases, multiple levels of menus may be described.
209 A single vector slot containing nil indicates the start of a submenu.
210 A single vector slot containing lambda indicates the end of a submenu.
211 The submenu follows a menu item which is the way to reach the submenu.
213 A single vector slot containing quote indicates that the
214 following items should appear on the right of a dialog box.
216 Using a Lisp vector to hold this information while we decode it
217 takes care of protecting all the data from GC. */
219 #define MENU_ITEMS_PANE_NAME 1
220 #define MENU_ITEMS_PANE_PREFIX 2
221 #define MENU_ITEMS_PANE_LENGTH 3
223 enum menu_item_idx
225 MENU_ITEMS_ITEM_NAME = 0,
226 MENU_ITEMS_ITEM_ENABLE,
227 MENU_ITEMS_ITEM_VALUE,
228 MENU_ITEMS_ITEM_EQUIV_KEY,
229 MENU_ITEMS_ITEM_DEFINITION,
230 MENU_ITEMS_ITEM_TYPE,
231 MENU_ITEMS_ITEM_SELECTED,
232 MENU_ITEMS_ITEM_HELP,
233 MENU_ITEMS_ITEM_LENGTH
236 static Lisp_Object menu_items;
238 /* Number of slots currently allocated in menu_items. */
239 static int menu_items_allocated;
241 /* This is the index in menu_items of the first empty slot. */
242 static int menu_items_used;
244 /* The number of panes currently recorded in menu_items,
245 excluding those within submenus. */
246 static int menu_items_n_panes;
248 /* Current depth within submenus. */
249 static int menu_items_submenu_depth;
251 /* This is set nonzero after the user activates the menu bar, and set
252 to zero again after the menu bars are redisplayed by prepare_menu_bar.
253 While it is nonzero, all calls to set_frame_menubar go deep.
255 I don't understand why this is needed, but it does seem to be
256 needed on Motif, according to Marcus Daniels <marcus@sysc.pdx.edu>. */
258 int pending_menu_activation;
260 /* Initialize the menu_items structure if we haven't already done so.
261 Also mark it as currently empty. */
263 static void
264 init_menu_items ()
266 if (NILP (menu_items))
268 menu_items_allocated = 60;
269 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
272 menu_items_used = 0;
273 menu_items_n_panes = 0;
274 menu_items_submenu_depth = 0;
277 /* Call at the end of generating the data in menu_items. */
279 static void
280 finish_menu_items ()
284 /* Call when finished using the data for the current menu
285 in menu_items. */
287 static void
288 discard_menu_items ()
290 /* Free the structure if it is especially large.
291 Otherwise, hold on to it, to save time. */
292 if (menu_items_allocated > 200)
294 menu_items = Qnil;
295 menu_items_allocated = 0;
299 /* Make the menu_items vector twice as large. */
301 static void
302 grow_menu_items ()
304 Lisp_Object old;
305 int old_size = menu_items_allocated;
306 old = menu_items;
308 menu_items_allocated *= 2;
309 menu_items = Fmake_vector (make_number (menu_items_allocated), Qnil);
310 bcopy (XVECTOR (old)->contents, XVECTOR (menu_items)->contents,
311 old_size * sizeof (Lisp_Object));
314 /* Begin a submenu. */
316 static void
317 push_submenu_start ()
319 if (menu_items_used + 1 > menu_items_allocated)
320 grow_menu_items ();
322 XVECTOR (menu_items)->contents[menu_items_used++] = Qnil;
323 menu_items_submenu_depth++;
326 /* End a submenu. */
328 static void
329 push_submenu_end ()
331 if (menu_items_used + 1 > menu_items_allocated)
332 grow_menu_items ();
334 XVECTOR (menu_items)->contents[menu_items_used++] = Qlambda;
335 menu_items_submenu_depth--;
338 /* Indicate boundary between left and right. */
340 static void
341 push_left_right_boundary ()
343 if (menu_items_used + 1 > menu_items_allocated)
344 grow_menu_items ();
346 XVECTOR (menu_items)->contents[menu_items_used++] = Qquote;
349 /* Start a new menu pane in menu_items.
350 NAME is the pane name. PREFIX_VEC is a prefix key for this pane. */
352 static void
353 push_menu_pane (name, prefix_vec)
354 Lisp_Object name, prefix_vec;
356 if (menu_items_used + MENU_ITEMS_PANE_LENGTH > menu_items_allocated)
357 grow_menu_items ();
359 if (menu_items_submenu_depth == 0)
360 menu_items_n_panes++;
361 XVECTOR (menu_items)->contents[menu_items_used++] = Qt;
362 XVECTOR (menu_items)->contents[menu_items_used++] = name;
363 XVECTOR (menu_items)->contents[menu_items_used++] = prefix_vec;
366 /* Push one menu item into the current pane. NAME is the string to
367 display. ENABLE if non-nil means this item can be selected. KEY
368 is the key generated by choosing this item, or nil if this item
369 doesn't really have a definition. DEF is the definition of this
370 item. EQUIV is the textual description of the keyboard equivalent
371 for this item (or nil if none). TYPE is the type of this menu
372 item, one of nil, `toggle' or `radio'. */
374 static void
375 push_menu_item (name, enable, key, def, equiv, type, selected, help)
376 Lisp_Object name, enable, key, def, equiv, type, selected, help;
378 if (menu_items_used + MENU_ITEMS_ITEM_LENGTH > menu_items_allocated)
379 grow_menu_items ();
381 XVECTOR (menu_items)->contents[menu_items_used++] = name;
382 XVECTOR (menu_items)->contents[menu_items_used++] = enable;
383 XVECTOR (menu_items)->contents[menu_items_used++] = key;
384 XVECTOR (menu_items)->contents[menu_items_used++] = equiv;
385 XVECTOR (menu_items)->contents[menu_items_used++] = def;
386 XVECTOR (menu_items)->contents[menu_items_used++] = type;
387 XVECTOR (menu_items)->contents[menu_items_used++] = selected;
388 XVECTOR (menu_items)->contents[menu_items_used++] = help;
391 /* Look through KEYMAPS, a vector of keymaps that is NMAPS long,
392 and generate menu panes for them in menu_items.
393 If NOTREAL is nonzero,
394 don't bother really computing whether an item is enabled. */
396 static void
397 keymap_panes (keymaps, nmaps, notreal)
398 Lisp_Object *keymaps;
399 int nmaps;
400 int notreal;
402 int mapno;
404 init_menu_items ();
406 /* Loop over the given keymaps, making a pane for each map.
407 But don't make a pane that is empty--ignore that map instead.
408 P is the number of panes we have made so far. */
409 for (mapno = 0; mapno < nmaps; mapno++)
410 single_keymap_panes (keymaps[mapno],
411 Fkeymap_prompt (keymaps[mapno]), Qnil, notreal, 10);
413 finish_menu_items ();
416 /* Args passed between single_keymap_panes and single_menu_item. */
417 struct skp
419 Lisp_Object pending_maps;
420 int maxdepth, notreal;
423 static void single_menu_item P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
424 void *));
426 /* This is a recursive subroutine of keymap_panes.
427 It handles one keymap, KEYMAP.
428 The other arguments are passed along
429 or point to local variables of the previous function.
430 If NOTREAL is nonzero, only check for equivalent key bindings, don't
431 evaluate expressions in menu items and don't make any menu.
433 If we encounter submenus deeper than MAXDEPTH levels, ignore them. */
435 static void
436 single_keymap_panes (keymap, pane_name, prefix, notreal, maxdepth)
437 Lisp_Object keymap;
438 Lisp_Object pane_name;
439 Lisp_Object prefix;
440 int notreal;
441 int maxdepth;
443 struct skp skp;
444 struct gcpro gcpro1;
446 skp.pending_maps = Qnil;
447 skp.maxdepth = maxdepth;
448 skp.notreal = notreal;
450 if (maxdepth <= 0)
451 return;
453 push_menu_pane (pane_name, prefix);
455 GCPRO1 (skp.pending_maps);
456 map_keymap (keymap, single_menu_item, Qnil, &skp, 1);
457 UNGCPRO;
459 /* Process now any submenus which want to be panes at this level. */
460 while (CONSP (skp.pending_maps))
462 Lisp_Object elt, eltcdr, string;
463 elt = XCAR (skp.pending_maps);
464 eltcdr = XCDR (elt);
465 string = XCAR (eltcdr);
466 /* We no longer discard the @ from the beginning of the string here.
467 Instead, we do this in mac_menu_show. */
468 single_keymap_panes (Fcar (elt), string,
469 XCDR (eltcdr), notreal, maxdepth - 1);
470 skp.pending_maps = XCDR (skp.pending_maps);
474 /* This is a subroutine of single_keymap_panes that handles one
475 keymap entry.
476 KEY is a key in a keymap and ITEM is its binding.
477 SKP->PENDING_MAPS_PTR is a list of keymaps waiting to be made into
478 separate panes.
479 If SKP->NOTREAL is nonzero, only check for equivalent key bindings, don't
480 evaluate expressions in menu items and don't make any menu.
481 If we encounter submenus deeper than SKP->MAXDEPTH levels, ignore them. */
483 static void
484 single_menu_item (key, item, dummy, skp_v)
485 Lisp_Object key, item, dummy;
486 void *skp_v;
488 Lisp_Object map, item_string, enabled;
489 struct gcpro gcpro1, gcpro2;
490 int res;
491 struct skp *skp = skp_v;
493 /* Parse the menu item and leave the result in item_properties. */
494 GCPRO2 (key, item);
495 res = parse_menu_item (item, skp->notreal, 0);
496 UNGCPRO;
497 if (!res)
498 return; /* Not a menu item. */
500 map = XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP];
502 if (skp->notreal)
504 /* We don't want to make a menu, just traverse the keymaps to
505 precompute equivalent key bindings. */
506 if (!NILP (map))
507 single_keymap_panes (map, Qnil, key, 1, skp->maxdepth - 1);
508 return;
511 enabled = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE];
512 item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME];
514 if (!NILP (map) && SREF (item_string, 0) == '@')
516 if (!NILP (enabled))
517 /* An enabled separate pane. Remember this to handle it later. */
518 skp->pending_maps = Fcons (Fcons (map, Fcons (item_string, key)),
519 skp->pending_maps);
520 return;
523 push_menu_item (item_string, enabled, key,
524 XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF],
525 XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ],
526 XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE],
527 XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED],
528 XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]);
530 /* Display a submenu using the toolkit. */
531 if (! (NILP (map) || NILP (enabled)))
533 push_submenu_start ();
534 single_keymap_panes (map, Qnil, key, 0, skp->maxdepth - 1);
535 push_submenu_end ();
539 /* Push all the panes and items of a menu described by the
540 alist-of-alists MENU.
541 This handles old-fashioned calls to x-popup-menu. */
543 static void
544 list_of_panes (menu)
545 Lisp_Object menu;
547 Lisp_Object tail;
549 init_menu_items ();
551 for (tail = menu; CONSP (tail); tail = XCDR (tail))
553 Lisp_Object elt, pane_name, pane_data;
554 elt = XCAR (tail);
555 pane_name = Fcar (elt);
556 CHECK_STRING (pane_name);
557 push_menu_pane (ENCODE_MENU_STRING (pane_name), Qnil);
558 pane_data = Fcdr (elt);
559 CHECK_CONS (pane_data);
560 list_of_items (pane_data);
563 finish_menu_items ();
566 /* Push the items in a single pane defined by the alist PANE. */
568 static void
569 list_of_items (pane)
570 Lisp_Object pane;
572 Lisp_Object tail, item, item1;
574 for (tail = pane; CONSP (tail); tail = XCDR (tail))
576 item = XCAR (tail);
577 if (STRINGP (item))
578 push_menu_item (ENCODE_MENU_STRING (item), Qnil, Qnil, Qt,
579 Qnil, Qnil, Qnil, Qnil);
580 else if (CONSP (item))
582 item1 = XCAR (item);
583 CHECK_STRING (item1);
584 push_menu_item (ENCODE_MENU_STRING (item1), Qt, XCDR (item),
585 Qt, Qnil, Qnil, Qnil, Qnil);
587 else
588 push_left_right_boundary ();
593 static Lisp_Object
594 cleanup_popup_menu (arg)
595 Lisp_Object arg;
597 discard_menu_items ();
600 DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
601 doc: /* Pop up a deck-of-cards menu and return user's selection.
602 POSITION is a position specification. This is either a mouse button event
603 or a list ((XOFFSET YOFFSET) WINDOW)
604 where XOFFSET and YOFFSET are positions in pixels from the top left
605 corner of WINDOW. (WINDOW may be a window or a frame object.)
606 This controls the position of the top left of the menu as a whole.
607 If POSITION is t, it means to use the current mouse position.
609 MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
610 The menu items come from key bindings that have a menu string as well as
611 a definition; actually, the "definition" in such a key binding looks like
612 \(STRING . REAL-DEFINITION). To give the menu a title, put a string into
613 the keymap as a top-level element.
615 If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
616 Otherwise, REAL-DEFINITION should be a valid key binding definition.
618 You can also use a list of keymaps as MENU.
619 Then each keymap makes a separate pane.
621 When MENU is a keymap or a list of keymaps, the return value is the
622 list of events corresponding to the user's choice. Note that
623 `x-popup-menu' does not actually execute the command bound to that
624 sequence of events.
626 Alternatively, you can specify a menu of multiple panes
627 with a list of the form (TITLE PANE1 PANE2...),
628 where each pane is a list of form (TITLE ITEM1 ITEM2...).
629 Each ITEM is normally a cons cell (STRING . VALUE);
630 but a string can appear as an item--that makes a nonselectable line
631 in the menu.
632 With this form of menu, the return value is VALUE from the chosen item.
634 If POSITION is nil, don't display the menu at all, just precalculate the
635 cached information about equivalent key sequences.
637 If the user gets rid of the menu without making a valid choice, for
638 instance by clicking the mouse away from a valid choice or by typing
639 keyboard input, then this normally results in a quit and
640 `x-popup-menu' does not return. But if POSITION is a mouse button
641 event (indicating that the user invoked the menu with the mouse) then
642 no quit occurs and `x-popup-menu' returns nil. */)
643 (position, menu)
644 Lisp_Object position, menu;
646 Lisp_Object keymap, tem;
647 int xpos = 0, ypos = 0;
648 Lisp_Object title;
649 char *error_name = NULL;
650 Lisp_Object selection;
651 FRAME_PTR f = NULL;
652 Lisp_Object x, y, window;
653 int keymaps = 0;
654 int for_click = 0;
655 int specpdl_count = SPECPDL_INDEX ();
656 struct gcpro gcpro1;
658 #ifdef HAVE_MENUS
659 if (! NILP (position))
661 check_mac ();
663 /* Decode the first argument: find the window and the coordinates. */
664 if (EQ (position, Qt)
665 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
666 || EQ (XCAR (position), Qtool_bar)
667 || EQ (XCAR (position), Qmac_apple_event))))
669 /* Use the mouse's current position. */
670 FRAME_PTR new_f = SELECTED_FRAME ();
671 Lisp_Object bar_window;
672 enum scroll_bar_part part;
673 unsigned long time;
675 if (mouse_position_hook)
676 (*mouse_position_hook) (&new_f, 1, &bar_window,
677 &part, &x, &y, &time);
678 if (new_f != 0)
679 XSETFRAME (window, new_f);
680 else
682 window = selected_window;
683 XSETFASTINT (x, 0);
684 XSETFASTINT (y, 0);
687 else
689 tem = Fcar (position);
690 if (CONSP (tem))
692 window = Fcar (Fcdr (position));
693 x = XCAR (tem);
694 y = Fcar (XCDR (tem));
696 else
698 for_click = 1;
699 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
700 window = Fcar (tem); /* POSN_WINDOW (tem) */
701 tem = Fcar (Fcdr (Fcdr (tem))); /* POSN_WINDOW_POSN (tem) */
702 x = Fcar (tem);
703 y = Fcdr (tem);
707 CHECK_NUMBER (x);
708 CHECK_NUMBER (y);
710 /* Decode where to put the menu. */
712 if (FRAMEP (window))
714 f = XFRAME (window);
715 xpos = 0;
716 ypos = 0;
718 else if (WINDOWP (window))
720 CHECK_LIVE_WINDOW (window);
721 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
723 xpos = WINDOW_LEFT_EDGE_X (XWINDOW (window));
724 ypos = WINDOW_TOP_EDGE_Y (XWINDOW (window));
726 else
727 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
728 but I don't want to make one now. */
729 CHECK_WINDOW (window);
731 xpos += XINT (x);
732 ypos += XINT (y);
734 XSETFRAME (Vmenu_updating_frame, f);
736 else
737 Vmenu_updating_frame = Qnil;
738 #endif /* HAVE_MENUS */
740 title = Qnil;
741 GCPRO1 (title);
743 /* Decode the menu items from what was specified. */
745 keymap = get_keymap (menu, 0, 0);
746 if (CONSP (keymap))
748 /* We were given a keymap. Extract menu info from the keymap. */
749 Lisp_Object prompt;
751 /* Extract the detailed info to make one pane. */
752 keymap_panes (&menu, 1, NILP (position));
754 /* Search for a string appearing directly as an element of the keymap.
755 That string is the title of the menu. */
756 prompt = Fkeymap_prompt (keymap);
757 if (NILP (title) && !NILP (prompt))
758 title = prompt;
760 /* Make that be the pane title of the first pane. */
761 if (!NILP (prompt) && menu_items_n_panes >= 0)
762 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = prompt;
764 keymaps = 1;
766 else if (CONSP (menu) && KEYMAPP (XCAR (menu)))
768 /* We were given a list of keymaps. */
769 int nmaps = XFASTINT (Flength (menu));
770 Lisp_Object *maps
771 = (Lisp_Object *) alloca (nmaps * sizeof (Lisp_Object));
772 int i;
774 title = Qnil;
776 /* The first keymap that has a prompt string
777 supplies the menu title. */
778 for (tem = menu, i = 0; CONSP (tem); tem = XCDR (tem))
780 Lisp_Object prompt;
782 maps[i++] = keymap = get_keymap (XCAR (tem), 1, 0);
784 prompt = Fkeymap_prompt (keymap);
785 if (NILP (title) && !NILP (prompt))
786 title = prompt;
789 /* Extract the detailed info to make one pane. */
790 keymap_panes (maps, nmaps, NILP (position));
792 /* Make the title be the pane title of the first pane. */
793 if (!NILP (title) && menu_items_n_panes >= 0)
794 XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME] = title;
796 keymaps = 1;
798 else
800 /* We were given an old-fashioned menu. */
801 title = Fcar (menu);
802 CHECK_STRING (title);
804 list_of_panes (Fcdr (menu));
806 keymaps = 0;
809 if (NILP (position))
811 discard_menu_items ();
812 UNGCPRO;
813 return Qnil;
816 #ifdef HAVE_MENUS
817 /* Display them in a menu. */
818 record_unwind_protect (cleanup_popup_menu, Qnil);
819 BLOCK_INPUT;
821 selection = mac_menu_show (f, xpos, ypos, for_click,
822 keymaps, title, &error_name);
823 UNBLOCK_INPUT;
824 unbind_to (specpdl_count, Qnil);
826 UNGCPRO;
827 #endif /* HAVE_MENUS */
829 if (error_name) error (error_name);
830 return selection;
833 #ifdef HAVE_MENUS
835 DEFUN ("x-popup-dialog", Fx_popup_dialog, Sx_popup_dialog, 2, 3, 0,
836 doc: /* Pop up a dialog box and return user's selection.
837 POSITION specifies which frame to use.
838 This is normally a mouse button event or a window or frame.
839 If POSITION is t, it means to use the frame the mouse is on.
840 The dialog box appears in the middle of the specified frame.
842 CONTENTS specifies the alternatives to display in the dialog box.
843 It is a list of the form (DIALOG ITEM1 ITEM2...).
844 Each ITEM is a cons cell (STRING . VALUE).
845 The return value is VALUE from the chosen item.
847 An ITEM may also be just a string--that makes a nonselectable item.
848 An ITEM may also be nil--that means to put all preceding items
849 on the left of the dialog box and all following items on the right.
850 \(By default, approximately half appear on each side.)
852 If HEADER is non-nil, the frame title for the box is "Information",
853 otherwise it is "Question".
855 If the user gets rid of the dialog box without making a valid choice,
856 for instance using the window manager, then this produces a quit and
857 `x-popup-dialog' does not return. */)
858 (position, contents, header)
859 Lisp_Object position, contents, header;
861 FRAME_PTR f = NULL;
862 Lisp_Object window;
864 check_mac ();
866 /* Decode the first argument: find the window or frame to use. */
867 if (EQ (position, Qt)
868 || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
869 || EQ (XCAR (position), Qtool_bar)
870 || EQ (XCAR (position), Qmac_apple_event))))
872 #if 0 /* Using the frame the mouse is on may not be right. */
873 /* Use the mouse's current position. */
874 FRAME_PTR new_f = SELECTED_FRAME ();
875 Lisp_Object bar_window;
876 enum scroll_bar_part part;
877 unsigned long time;
878 Lisp_Object x, y;
880 (*mouse_position_hook) (&new_f, 1, &bar_window, &part, &x, &y, &time);
882 if (new_f != 0)
883 XSETFRAME (window, new_f);
884 else
885 window = selected_window;
886 #endif
887 window = selected_window;
889 else if (CONSP (position))
891 Lisp_Object tem;
892 tem = Fcar (position);
893 if (CONSP (tem))
894 window = Fcar (Fcdr (position));
895 else
897 tem = Fcar (Fcdr (position)); /* EVENT_START (position) */
898 window = Fcar (tem); /* POSN_WINDOW (tem) */
901 else if (WINDOWP (position) || FRAMEP (position))
902 window = position;
903 else
904 window = Qnil;
906 /* Decode where to put the menu. */
908 if (FRAMEP (window))
909 f = XFRAME (window);
910 else if (WINDOWP (window))
912 CHECK_LIVE_WINDOW (window);
913 f = XFRAME (WINDOW_FRAME (XWINDOW (window)));
915 else
916 /* ??? Not really clean; should be CHECK_WINDOW_OR_FRAME,
917 but I don't want to make one now. */
918 CHECK_WINDOW (window);
920 #ifndef HAVE_DIALOGS
921 /* Display a menu with these alternatives
922 in the middle of frame F. */
924 Lisp_Object x, y, frame, newpos;
925 XSETFRAME (frame, f);
926 XSETINT (x, x_pixel_width (f) / 2);
927 XSETINT (y, x_pixel_height (f) / 2);
928 newpos = Fcons (Fcons (x, Fcons (y, Qnil)), Fcons (frame, Qnil));
930 return Fx_popup_menu (newpos,
931 Fcons (Fcar (contents), Fcons (contents, Qnil)));
933 #else /* HAVE_DIALOGS */
935 Lisp_Object title;
936 char *error_name;
937 Lisp_Object selection;
938 int specpdl_count = SPECPDL_INDEX ();
940 /* Decode the dialog items from what was specified. */
941 title = Fcar (contents);
942 CHECK_STRING (title);
944 list_of_panes (Fcons (contents, Qnil));
946 /* Display them in a dialog box. */
947 record_unwind_protect (cleanup_popup_menu, Qnil);
948 BLOCK_INPUT;
949 selection = mac_dialog_show (f, 0, title, header, &error_name);
950 UNBLOCK_INPUT;
951 unbind_to (specpdl_count, Qnil);
953 if (error_name) error (error_name);
954 return selection;
956 #endif /* HAVE_DIALOGS */
959 /* Activate the menu bar of frame F.
960 This is called from keyboard.c when it gets the
961 MENU_BAR_ACTIVATE_EVENT out of the Emacs event queue.
963 To activate the menu bar, we use the button-press event location
964 that was saved in saved_menu_event_location.
966 But first we recompute the menu bar contents (the whole tree).
968 The reason for saving the button event until here, instead of
969 passing it to the toolkit right away, is that we can safely
970 execute Lisp code. */
972 void
973 x_activate_menubar (f)
974 FRAME_PTR f;
976 SInt32 menu_choice;
977 extern Point saved_menu_event_location;
979 set_frame_menubar (f, 0, 1);
980 BLOCK_INPUT;
982 menu_choice = MenuSelect (saved_menu_event_location);
983 do_menu_choice (menu_choice);
985 UNBLOCK_INPUT;
988 /* This callback is called from the menu bar pulldown menu
989 when the user makes a selection.
990 Figure out what the user chose
991 and put the appropriate events into the keyboard buffer. */
993 void
994 menubar_selection_callback (FRAME_PTR f, int client_data)
996 Lisp_Object prefix, entry;
997 Lisp_Object vector;
998 Lisp_Object *subprefix_stack;
999 int submenu_depth = 0;
1000 int i;
1002 if (!f)
1003 return;
1004 entry = Qnil;
1005 subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object));
1006 vector = f->menu_bar_vector;
1007 prefix = Qnil;
1008 i = 0;
1009 while (i < f->menu_bar_items_used)
1011 if (EQ (XVECTOR (vector)->contents[i], Qnil))
1013 subprefix_stack[submenu_depth++] = prefix;
1014 prefix = entry;
1015 i++;
1017 else if (EQ (XVECTOR (vector)->contents[i], Qlambda))
1019 prefix = subprefix_stack[--submenu_depth];
1020 i++;
1022 else if (EQ (XVECTOR (vector)->contents[i], Qt))
1024 prefix = XVECTOR (vector)->contents[i + MENU_ITEMS_PANE_PREFIX];
1025 i += MENU_ITEMS_PANE_LENGTH;
1027 else
1029 entry = XVECTOR (vector)->contents[i + MENU_ITEMS_ITEM_VALUE];
1030 /* The EMACS_INT cast avoids a warning. There's no problem
1031 as long as pointers have enough bits to hold small integers. */
1032 if ((int) (EMACS_INT) client_data == i)
1034 int j;
1035 struct input_event buf;
1036 Lisp_Object frame;
1037 EVENT_INIT (buf);
1039 XSETFRAME (frame, f);
1040 buf.kind = MENU_BAR_EVENT;
1041 buf.frame_or_window = frame;
1042 buf.arg = frame;
1043 kbd_buffer_store_event (&buf);
1045 for (j = 0; j < submenu_depth; j++)
1046 if (!NILP (subprefix_stack[j]))
1048 buf.kind = MENU_BAR_EVENT;
1049 buf.frame_or_window = frame;
1050 buf.arg = subprefix_stack[j];
1051 kbd_buffer_store_event (&buf);
1054 if (!NILP (prefix))
1056 buf.kind = MENU_BAR_EVENT;
1057 buf.frame_or_window = frame;
1058 buf.arg = prefix;
1059 kbd_buffer_store_event (&buf);
1062 buf.kind = MENU_BAR_EVENT;
1063 buf.frame_or_window = frame;
1064 buf.arg = entry;
1065 kbd_buffer_store_event (&buf);
1067 f->output_data.mac->menubar_active = 0;
1068 return;
1070 i += MENU_ITEMS_ITEM_LENGTH;
1073 f->output_data.mac->menubar_active = 0;
1076 /* Allocate a widget_value, blocking input. */
1078 widget_value *
1079 xmalloc_widget_value ()
1081 widget_value *value;
1083 BLOCK_INPUT;
1084 value = malloc_widget_value ();
1085 UNBLOCK_INPUT;
1087 return value;
1090 /* This recursively calls free_widget_value on the tree of widgets.
1091 It must free all data that was malloc'ed for these widget_values.
1092 In Emacs, many slots are pointers into the data of Lisp_Strings, and
1093 must be left alone. */
1095 void
1096 free_menubar_widget_value_tree (wv)
1097 widget_value *wv;
1099 if (! wv) return;
1101 wv->name = wv->value = wv->key = (char *) 0xDEADBEEF;
1103 if (wv->contents && (wv->contents != (widget_value*)1))
1105 free_menubar_widget_value_tree (wv->contents);
1106 wv->contents = (widget_value *) 0xDEADBEEF;
1108 if (wv->next)
1110 free_menubar_widget_value_tree (wv->next);
1111 wv->next = (widget_value *) 0xDEADBEEF;
1113 BLOCK_INPUT;
1114 free_widget_value (wv);
1115 UNBLOCK_INPUT;
1118 /* Set up data in menu_items for a menu bar item
1119 whose event type is ITEM_KEY (with string ITEM_NAME)
1120 and whose contents come from the list of keymaps MAPS. */
1122 static int
1123 parse_single_submenu (item_key, item_name, maps)
1124 Lisp_Object item_key, item_name, maps;
1126 Lisp_Object length;
1127 int len;
1128 Lisp_Object *mapvec;
1129 int i;
1130 int top_level_items = 0;
1132 length = Flength (maps);
1133 len = XINT (length);
1135 /* Convert the list MAPS into a vector MAPVEC. */
1136 mapvec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
1137 for (i = 0; i < len; i++)
1139 mapvec[i] = Fcar (maps);
1140 maps = Fcdr (maps);
1143 /* Loop over the given keymaps, making a pane for each map.
1144 But don't make a pane that is empty--ignore that map instead. */
1145 for (i = 0; i < len; i++)
1147 if (!KEYMAPP (mapvec[i]))
1149 /* Here we have a command at top level in the menu bar
1150 as opposed to a submenu. */
1151 top_level_items = 1;
1152 push_menu_pane (Qnil, Qnil);
1153 push_menu_item (item_name, Qt, item_key, mapvec[i],
1154 Qnil, Qnil, Qnil, Qnil);
1156 else
1158 Lisp_Object prompt;
1159 prompt = Fkeymap_prompt (mapvec[i]);
1160 single_keymap_panes (mapvec[i],
1161 !NILP (prompt) ? prompt : item_name,
1162 item_key, 0, 10);
1166 return top_level_items;
1169 /* Create a tree of widget_value objects
1170 representing the panes and items
1171 in menu_items starting at index START, up to index END. */
1173 static widget_value *
1174 digest_single_submenu (start, end, top_level_items)
1175 int start, end, top_level_items;
1177 widget_value *wv, *prev_wv, *save_wv, *first_wv;
1178 int i;
1179 int submenu_depth = 0;
1180 widget_value **submenu_stack;
1182 submenu_stack
1183 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1184 wv = xmalloc_widget_value ();
1185 wv->name = "menu";
1186 wv->value = 0;
1187 wv->enabled = 1;
1188 wv->button_type = BUTTON_TYPE_NONE;
1189 wv->help = Qnil;
1190 first_wv = wv;
1191 save_wv = 0;
1192 prev_wv = 0;
1194 /* Loop over all panes and items made by the preceding call
1195 to parse_single_submenu and construct a tree of widget_value objects.
1196 Ignore the panes and items used by previous calls to
1197 digest_single_submenu, even though those are also in menu_items. */
1198 i = start;
1199 while (i < end)
1201 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1203 submenu_stack[submenu_depth++] = save_wv;
1204 save_wv = prev_wv;
1205 prev_wv = 0;
1206 i++;
1208 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1210 prev_wv = save_wv;
1211 save_wv = submenu_stack[--submenu_depth];
1212 i++;
1214 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1215 && submenu_depth != 0)
1216 i += MENU_ITEMS_PANE_LENGTH;
1217 /* Ignore a nil in the item list.
1218 It's meaningful only for dialog boxes. */
1219 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1220 i += 1;
1221 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1223 /* Create a new pane. */
1224 Lisp_Object pane_name, prefix;
1225 char *pane_string;
1227 pane_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_NAME];
1228 prefix = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
1230 #ifndef HAVE_MULTILINGUAL_MENU
1231 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1233 pane_name = ENCODE_MENU_STRING (pane_name);
1234 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1236 #endif
1237 pane_string = (NILP (pane_name)
1238 ? "" : (char *) SDATA (pane_name));
1239 /* If there is just one top-level pane, put all its items directly
1240 under the top-level menu. */
1241 if (menu_items_n_panes == 1)
1242 pane_string = "";
1244 /* If the pane has a meaningful name,
1245 make the pane a top-level menu item
1246 with its items as a submenu beneath it. */
1247 if (strcmp (pane_string, ""))
1249 wv = xmalloc_widget_value ();
1250 if (save_wv)
1251 save_wv->next = wv;
1252 else
1253 first_wv->contents = wv;
1254 wv->lname = pane_name;
1255 /* Set value to 1 so update_submenu_strings can handle '@' */
1256 wv->value = (char *)1;
1257 wv->enabled = 1;
1258 wv->button_type = BUTTON_TYPE_NONE;
1259 wv->help = Qnil;
1261 save_wv = wv;
1262 prev_wv = 0;
1263 i += MENU_ITEMS_PANE_LENGTH;
1265 else
1267 /* Create a new item within current pane. */
1268 Lisp_Object item_name, enable, descrip, def, type, selected;
1269 Lisp_Object help;
1271 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1272 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1273 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1274 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1275 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1276 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1277 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1279 #ifndef HAVE_MULTILINGUAL_MENU
1280 if (STRING_MULTIBYTE (item_name))
1282 item_name = ENCODE_MENU_STRING (item_name);
1283 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1286 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1288 descrip = ENCODE_MENU_STRING (descrip);
1289 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1291 #endif /* not HAVE_MULTILINGUAL_MENU */
1293 wv = xmalloc_widget_value ();
1294 if (prev_wv)
1295 prev_wv->next = wv;
1296 else
1297 save_wv->contents = wv;
1299 wv->lname = item_name;
1300 if (!NILP (descrip))
1301 wv->lkey = descrip;
1302 wv->value = 0;
1303 /* The EMACS_INT cast avoids a warning. There's no problem
1304 as long as pointers have enough bits to hold small integers. */
1305 wv->call_data = (!NILP (def) ? (void *) (EMACS_INT) i : 0);
1306 wv->enabled = !NILP (enable);
1308 if (NILP (type))
1309 wv->button_type = BUTTON_TYPE_NONE;
1310 else if (EQ (type, QCradio))
1311 wv->button_type = BUTTON_TYPE_RADIO;
1312 else if (EQ (type, QCtoggle))
1313 wv->button_type = BUTTON_TYPE_TOGGLE;
1314 else
1315 abort ();
1317 wv->selected = !NILP (selected);
1318 if (! STRINGP (help))
1319 help = Qnil;
1321 wv->help = help;
1323 prev_wv = wv;
1325 i += MENU_ITEMS_ITEM_LENGTH;
1329 /* If we have just one "menu item"
1330 that was originally a button, return it by itself. */
1331 if (top_level_items && first_wv->contents && first_wv->contents->next == 0)
1333 wv = first_wv->contents;
1334 free_widget_value (first_wv);
1335 return wv;
1338 return first_wv;
1341 /* Walk through the widget_value tree starting at FIRST_WV and update
1342 the char * pointers from the corresponding lisp values.
1343 We do this after building the whole tree, since GC may happen while the
1344 tree is constructed, and small strings are relocated. So we must wait
1345 until no GC can happen before storing pointers into lisp values. */
1346 static void
1347 update_submenu_strings (first_wv)
1348 widget_value *first_wv;
1350 widget_value *wv;
1352 for (wv = first_wv; wv; wv = wv->next)
1354 if (STRINGP (wv->lname))
1356 wv->name = SDATA (wv->lname);
1358 /* Ignore the @ that means "separate pane".
1359 This is a kludge, but this isn't worth more time. */
1360 if (wv->value == (char *)1)
1362 if (wv->name[0] == '@')
1363 wv->name++;
1364 wv->value = 0;
1368 if (STRINGP (wv->lkey))
1369 wv->key = SDATA (wv->lkey);
1371 if (wv->contents)
1372 update_submenu_strings (wv->contents);
1377 /* Event handler function that pops down a menu on C-g. We can only pop
1378 down menus if CancelMenuTracking is present (OSX 10.3 or later). */
1380 #ifdef HAVE_CANCELMENUTRACKING
1381 static pascal OSStatus
1382 menu_quit_handler (nextHandler, theEvent, userData)
1383 EventHandlerCallRef nextHandler;
1384 EventRef theEvent;
1385 void* userData;
1387 UInt32 keyCode;
1388 UInt32 keyModifiers;
1389 extern int mac_quit_char_modifiers;
1390 extern int mac_quit_char_keycode;
1392 GetEventParameter (theEvent, kEventParamKeyCode,
1393 typeUInt32, NULL, sizeof(UInt32), NULL, &keyCode);
1395 GetEventParameter (theEvent, kEventParamKeyModifiers,
1396 typeUInt32, NULL, sizeof(UInt32),
1397 NULL, &keyModifiers);
1399 if (keyCode == mac_quit_char_keycode
1400 && keyModifiers == mac_quit_char_modifiers)
1402 MenuRef menu = userData != 0
1403 ? (MenuRef)userData : AcquireRootMenu ();
1405 CancelMenuTracking (menu, true, 0);
1406 if (!userData) ReleaseMenu (menu);
1407 return noErr;
1410 return CallNextEventHandler (nextHandler, theEvent);
1412 #endif /* HAVE_CANCELMENUTRACKING */
1414 /* Add event handler for MENU_HANDLE so we can detect C-g.
1415 If MENU_HANDLE is NULL, install handler for all menus in the menu bar.
1416 If CancelMenuTracking isn't available, do nothing. */
1418 static void
1419 install_menu_quit_handler (MenuHandle menu_handle)
1421 #ifdef HAVE_CANCELMENUTRACKING
1422 EventTypeSpec typesList[] = { { kEventClassKeyboard, kEventRawKeyDown } };
1423 int i = MIN_MENU_ID;
1424 MenuHandle menu = menu_handle ? menu_handle : GetMenuHandle (i);
1426 while (menu != NULL)
1428 InstallMenuEventHandler (menu, menu_quit_handler,
1429 GetEventTypeCount (typesList),
1430 typesList, menu_handle, NULL);
1431 if (menu_handle) break;
1432 menu = GetMenuHandle (++i);
1435 i = menu_handle ? MIN_POPUP_SUBMENU_ID : MIN_SUBMENU_ID;
1436 menu = GetMenuHandle (i);
1437 while (menu != NULL)
1439 InstallMenuEventHandler (menu, menu_quit_handler,
1440 GetEventTypeCount (typesList),
1441 typesList, menu_handle, NULL);
1442 menu = GetMenuHandle (++i);
1444 #endif /* HAVE_CANCELMENUTRACKING */
1447 /* Set the contents of the menubar widgets of frame F.
1448 The argument FIRST_TIME is currently ignored;
1449 it is set the first time this is called, from initialize_frame_menubar. */
1451 void
1452 set_frame_menubar (f, first_time, deep_p)
1453 FRAME_PTR f;
1454 int first_time;
1455 int deep_p;
1457 int menubar_widget = f->output_data.mac->menubar_widget;
1458 Lisp_Object items;
1459 widget_value *wv, *first_wv, *prev_wv = 0;
1460 int i, last_i = 0;
1461 int *submenu_start, *submenu_end;
1462 int *submenu_top_level_items, *submenu_n_panes;
1464 /* We must not change the menubar when actually in use. */
1465 if (f->output_data.mac->menubar_active)
1466 return;
1468 XSETFRAME (Vmenu_updating_frame, f);
1470 if (! menubar_widget)
1471 deep_p = 1;
1472 else if (pending_menu_activation && !deep_p)
1473 deep_p = 1;
1475 if (deep_p)
1477 /* Make a widget-value tree representing the entire menu trees. */
1479 struct buffer *prev = current_buffer;
1480 Lisp_Object buffer;
1481 int specpdl_count = SPECPDL_INDEX ();
1482 int previous_menu_items_used = f->menu_bar_items_used;
1483 Lisp_Object *previous_items
1484 = (Lisp_Object *) alloca (previous_menu_items_used
1485 * sizeof (Lisp_Object));
1487 /* If we are making a new widget, its contents are empty,
1488 do always reinitialize them. */
1489 if (! menubar_widget)
1490 previous_menu_items_used = 0;
1492 buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer;
1493 specbind (Qinhibit_quit, Qt);
1494 /* Don't let the debugger step into this code
1495 because it is not reentrant. */
1496 specbind (Qdebug_on_next_call, Qnil);
1498 record_unwind_save_match_data ();
1499 if (NILP (Voverriding_local_map_menu_flag))
1501 specbind (Qoverriding_terminal_local_map, Qnil);
1502 specbind (Qoverriding_local_map, Qnil);
1505 set_buffer_internal_1 (XBUFFER (buffer));
1507 /* Run the Lucid hook. */
1508 safe_run_hooks (Qactivate_menubar_hook);
1510 /* If it has changed current-menubar from previous value,
1511 really recompute the menubar from the value. */
1512 if (! NILP (Vlucid_menu_bar_dirty_flag))
1513 call0 (Qrecompute_lucid_menubar);
1514 safe_run_hooks (Qmenu_bar_update_hook);
1515 FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f));
1517 items = FRAME_MENU_BAR_ITEMS (f);
1519 /* Save the frame's previous menu bar contents data. */
1520 if (previous_menu_items_used)
1521 bcopy (XVECTOR (f->menu_bar_vector)->contents, previous_items,
1522 previous_menu_items_used * sizeof (Lisp_Object));
1524 /* Fill in menu_items with the current menu bar contents.
1525 This can evaluate Lisp code. */
1526 menu_items = f->menu_bar_vector;
1527 menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0;
1528 submenu_start = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1529 submenu_end = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1530 submenu_n_panes = (int *) alloca (XVECTOR (items)->size * sizeof (int));
1531 submenu_top_level_items
1532 = (int *) alloca (XVECTOR (items)->size * sizeof (int *));
1533 init_menu_items ();
1534 for (i = 0; i < XVECTOR (items)->size; i += 4)
1536 Lisp_Object key, string, maps;
1538 last_i = i;
1540 key = XVECTOR (items)->contents[i];
1541 string = XVECTOR (items)->contents[i + 1];
1542 maps = XVECTOR (items)->contents[i + 2];
1543 if (NILP (string))
1544 break;
1546 submenu_start[i] = menu_items_used;
1548 menu_items_n_panes = 0;
1549 submenu_top_level_items[i]
1550 = parse_single_submenu (key, string, maps);
1551 submenu_n_panes[i] = menu_items_n_panes;
1553 submenu_end[i] = menu_items_used;
1556 finish_menu_items ();
1558 /* Convert menu_items into widget_value trees
1559 to display the menu. This cannot evaluate Lisp code. */
1561 wv = xmalloc_widget_value ();
1562 wv->name = "menubar";
1563 wv->value = 0;
1564 wv->enabled = 1;
1565 wv->button_type = BUTTON_TYPE_NONE;
1566 wv->help = Qnil;
1567 first_wv = wv;
1569 for (i = 0; i < last_i; i += 4)
1571 menu_items_n_panes = submenu_n_panes[i];
1572 wv = digest_single_submenu (submenu_start[i], submenu_end[i],
1573 submenu_top_level_items[i]);
1574 if (prev_wv)
1575 prev_wv->next = wv;
1576 else
1577 first_wv->contents = wv;
1578 /* Don't set wv->name here; GC during the loop might relocate it. */
1579 wv->enabled = 1;
1580 wv->button_type = BUTTON_TYPE_NONE;
1581 prev_wv = wv;
1584 set_buffer_internal_1 (prev);
1585 unbind_to (specpdl_count, Qnil);
1587 /* If there has been no change in the Lisp-level contents
1588 of the menu bar, skip redisplaying it. Just exit. */
1590 for (i = 0; i < previous_menu_items_used; i++)
1591 if (menu_items_used == i
1592 || (!EQ (previous_items[i], XVECTOR (menu_items)->contents[i])))
1593 break;
1594 if (i == menu_items_used && i == previous_menu_items_used && i != 0)
1596 free_menubar_widget_value_tree (first_wv);
1597 discard_menu_items ();
1599 return;
1602 /* Now GC cannot happen during the lifetime of the widget_value,
1603 so it's safe to store data from a Lisp_String. */
1604 wv = first_wv->contents;
1605 for (i = 0; i < XVECTOR (items)->size; i += 4)
1607 Lisp_Object string;
1608 string = XVECTOR (items)->contents[i + 1];
1609 if (NILP (string))
1610 break;
1611 wv->name = (char *) SDATA (string);
1612 update_submenu_strings (wv->contents);
1613 wv = wv->next;
1616 f->menu_bar_vector = menu_items;
1617 f->menu_bar_items_used = menu_items_used;
1618 discard_menu_items ();
1620 else
1622 /* Make a widget-value tree containing
1623 just the top level menu bar strings. */
1625 wv = xmalloc_widget_value ();
1626 wv->name = "menubar";
1627 wv->value = 0;
1628 wv->enabled = 1;
1629 wv->button_type = BUTTON_TYPE_NONE;
1630 wv->help = Qnil;
1631 first_wv = wv;
1633 items = FRAME_MENU_BAR_ITEMS (f);
1634 for (i = 0; i < XVECTOR (items)->size; i += 4)
1636 Lisp_Object string;
1638 string = XVECTOR (items)->contents[i + 1];
1639 if (NILP (string))
1640 break;
1642 wv = xmalloc_widget_value ();
1643 wv->name = (char *) SDATA (string);
1644 wv->value = 0;
1645 wv->enabled = 1;
1646 wv->button_type = BUTTON_TYPE_NONE;
1647 wv->help = Qnil;
1648 /* This prevents lwlib from assuming this
1649 menu item is really supposed to be empty. */
1650 /* The EMACS_INT cast avoids a warning.
1651 This value just has to be different from small integers. */
1652 wv->call_data = (void *) (EMACS_INT) (-1);
1654 if (prev_wv)
1655 prev_wv->next = wv;
1656 else
1657 first_wv->contents = wv;
1658 prev_wv = wv;
1661 /* Forget what we thought we knew about what is in the
1662 detailed contents of the menu bar menus.
1663 Changing the top level always destroys the contents. */
1664 f->menu_bar_items_used = 0;
1667 /* Create or update the menu bar widget. */
1669 BLOCK_INPUT;
1671 /* Non-null value to indicate menubar has already been "created". */
1672 f->output_data.mac->menubar_widget = 1;
1674 fill_menubar (first_wv->contents, deep_p);
1676 /* Add event handler so we can detect C-g. */
1677 install_menu_quit_handler (NULL);
1678 free_menubar_widget_value_tree (first_wv);
1680 UNBLOCK_INPUT;
1683 /* Get rid of the menu bar of frame F, and free its storage.
1684 This is used when deleting a frame, and when turning off the menu bar. */
1686 void
1687 free_frame_menubar (f)
1688 FRAME_PTR f;
1690 f->output_data.mac->menubar_widget = 0;
1694 static Lisp_Object
1695 pop_down_menu (arg)
1696 Lisp_Object arg;
1698 struct Lisp_Save_Value *p = XSAVE_VALUE (arg);
1699 FRAME_PTR f = p->pointer;
1700 MenuHandle menu = GetMenuHandle (POPUP_SUBMENU_ID);
1702 BLOCK_INPUT;
1704 /* Must reset this manually because the button release event is not
1705 passed to Emacs event loop. */
1706 FRAME_MAC_DISPLAY_INFO (f)->grabbed = 0;
1708 /* delete all menus */
1709 dispose_menus (MIN_POPUP_SUBMENU_ID);
1710 DeleteMenu (POPUP_SUBMENU_ID);
1711 DisposeMenu (menu);
1713 UNBLOCK_INPUT;
1715 return Qnil;
1718 /* Mac_menu_show actually displays a menu using the panes and items in
1719 menu_items and returns the value selected from it; we assume input
1720 is blocked by the caller. */
1722 /* F is the frame the menu is for.
1723 X and Y are the frame-relative specified position,
1724 relative to the inside upper left corner of the frame F.
1725 FOR_CLICK is nonzero if this menu was invoked for a mouse click.
1726 KEYMAPS is 1 if this menu was specified with keymaps;
1727 in that case, we return a list containing the chosen item's value
1728 and perhaps also the pane's prefix.
1729 TITLE is the specified menu title.
1730 ERROR is a place to store an error message string in case of failure.
1731 (We return nil on failure, but the value doesn't actually matter.) */
1733 static Lisp_Object
1734 mac_menu_show (f, x, y, for_click, keymaps, title, error)
1735 FRAME_PTR f;
1736 int x;
1737 int y;
1738 int for_click;
1739 int keymaps;
1740 Lisp_Object title;
1741 char **error;
1743 int i;
1744 UInt32 refcon;
1745 int menu_item_choice;
1746 int menu_item_selection;
1747 MenuHandle menu;
1748 Point pos;
1749 widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
1750 widget_value **submenu_stack
1751 = (widget_value **) alloca (menu_items_used * sizeof (widget_value *));
1752 Lisp_Object *subprefix_stack
1753 = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object));
1754 int submenu_depth = 0;
1756 int first_pane;
1757 int specpdl_count = SPECPDL_INDEX ();
1759 *error = NULL;
1761 if (menu_items_used <= MENU_ITEMS_PANE_LENGTH)
1763 *error = "Empty menu";
1764 return Qnil;
1767 /* Create a tree of widget_value objects
1768 representing the panes and their items. */
1769 wv = xmalloc_widget_value ();
1770 wv->name = "menu";
1771 wv->value = 0;
1772 wv->enabled = 1;
1773 wv->button_type = BUTTON_TYPE_NONE;
1774 wv->help = Qnil;
1775 first_wv = wv;
1776 first_pane = 1;
1778 /* Loop over all panes and items, filling in the tree. */
1779 i = 0;
1780 while (i < menu_items_used)
1782 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1784 submenu_stack[submenu_depth++] = save_wv;
1785 save_wv = prev_wv;
1786 prev_wv = 0;
1787 first_pane = 1;
1788 i++;
1790 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
1792 prev_wv = save_wv;
1793 save_wv = submenu_stack[--submenu_depth];
1794 first_pane = 0;
1795 i++;
1797 else if (EQ (XVECTOR (menu_items)->contents[i], Qt)
1798 && submenu_depth != 0)
1799 i += MENU_ITEMS_PANE_LENGTH;
1800 /* Ignore a nil in the item list.
1801 It's meaningful only for dialog boxes. */
1802 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
1803 i += 1;
1804 else if (EQ (XVECTOR (menu_items)->contents[i], Qt))
1806 /* Create a new pane. */
1807 Lisp_Object pane_name, prefix;
1808 char *pane_string;
1810 pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
1811 prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
1813 #ifndef HAVE_MULTILINGUAL_MENU
1814 if (STRINGP (pane_name) && STRING_MULTIBYTE (pane_name))
1816 pane_name = ENCODE_MENU_STRING (pane_name);
1817 AREF (menu_items, i + MENU_ITEMS_PANE_NAME) = pane_name;
1819 #endif
1820 pane_string = (NILP (pane_name)
1821 ? "" : (char *) SDATA (pane_name));
1822 /* If there is just one top-level pane, put all its items directly
1823 under the top-level menu. */
1824 if (menu_items_n_panes == 1)
1825 pane_string = "";
1827 /* If the pane has a meaningful name,
1828 make the pane a top-level menu item
1829 with its items as a submenu beneath it. */
1830 if (!keymaps && strcmp (pane_string, ""))
1832 wv = xmalloc_widget_value ();
1833 if (save_wv)
1834 save_wv->next = wv;
1835 else
1836 first_wv->contents = wv;
1837 wv->name = pane_string;
1838 if (keymaps && !NILP (prefix))
1839 wv->name++;
1840 wv->value = 0;
1841 wv->enabled = 1;
1842 wv->button_type = BUTTON_TYPE_NONE;
1843 wv->help = Qnil;
1844 save_wv = wv;
1845 prev_wv = 0;
1847 else if (first_pane)
1849 save_wv = wv;
1850 prev_wv = 0;
1852 first_pane = 0;
1853 i += MENU_ITEMS_PANE_LENGTH;
1855 else
1857 /* Create a new item within current pane. */
1858 Lisp_Object item_name, enable, descrip, def, type, selected, help;
1859 item_name = AREF (menu_items, i + MENU_ITEMS_ITEM_NAME);
1860 enable = AREF (menu_items, i + MENU_ITEMS_ITEM_ENABLE);
1861 descrip = AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY);
1862 def = AREF (menu_items, i + MENU_ITEMS_ITEM_DEFINITION);
1863 type = AREF (menu_items, i + MENU_ITEMS_ITEM_TYPE);
1864 selected = AREF (menu_items, i + MENU_ITEMS_ITEM_SELECTED);
1865 help = AREF (menu_items, i + MENU_ITEMS_ITEM_HELP);
1867 #ifndef HAVE_MULTILINGUAL_MENU
1868 if (STRINGP (item_name) && STRING_MULTIBYTE (item_name))
1870 item_name = ENCODE_MENU_STRING (item_name);
1871 AREF (menu_items, i + MENU_ITEMS_ITEM_NAME) = item_name;
1874 if (STRINGP (descrip) && STRING_MULTIBYTE (descrip))
1876 descrip = ENCODE_MENU_STRING (descrip);
1877 AREF (menu_items, i + MENU_ITEMS_ITEM_EQUIV_KEY) = descrip;
1879 #endif /* not HAVE_MULTILINGUAL_MENU */
1881 wv = xmalloc_widget_value ();
1882 if (prev_wv)
1883 prev_wv->next = wv;
1884 else
1885 save_wv->contents = wv;
1886 wv->name = (char *) SDATA (item_name);
1887 if (!NILP (descrip))
1888 wv->key = (char *) SDATA (descrip);
1889 wv->value = 0;
1890 /* Use the contents index as call_data, since we are
1891 restricted to 16-bits. */
1892 wv->call_data = !NILP (def) ? (void *) (EMACS_INT) i : 0;
1893 wv->enabled = !NILP (enable);
1895 if (NILP (type))
1896 wv->button_type = BUTTON_TYPE_NONE;
1897 else if (EQ (type, QCtoggle))
1898 wv->button_type = BUTTON_TYPE_TOGGLE;
1899 else if (EQ (type, QCradio))
1900 wv->button_type = BUTTON_TYPE_RADIO;
1901 else
1902 abort ();
1904 wv->selected = !NILP (selected);
1906 if (! STRINGP (help))
1907 help = Qnil;
1909 wv->help = help;
1911 prev_wv = wv;
1913 i += MENU_ITEMS_ITEM_LENGTH;
1917 /* Deal with the title, if it is non-nil. */
1918 if (!NILP (title))
1920 widget_value *wv_title = xmalloc_widget_value ();
1921 widget_value *wv_sep = xmalloc_widget_value ();
1923 /* Maybe replace this separator with a bitmap or owner-draw item
1924 so that it looks better. Having two separators looks odd. */
1925 wv_sep->name = "--";
1926 wv_sep->next = first_wv->contents;
1927 wv_sep->help = Qnil;
1929 #ifndef HAVE_MULTILINGUAL_MENU
1930 if (STRING_MULTIBYTE (title))
1931 title = ENCODE_MENU_STRING (title);
1932 #endif
1934 wv_title->name = (char *) SDATA (title);
1935 wv_title->enabled = FALSE;
1936 wv_title->title = TRUE;
1937 wv_title->button_type = BUTTON_TYPE_NONE;
1938 wv_title->help = Qnil;
1939 wv_title->next = wv_sep;
1940 first_wv->contents = wv_title;
1943 /* Actually create the menu. */
1944 menu = NewMenu (POPUP_SUBMENU_ID, "\p");
1945 InsertMenu (menu, -1);
1946 fill_menu (menu, first_wv->contents, MIN_POPUP_SUBMENU_ID);
1948 /* Free the widget_value objects we used to specify the
1949 contents. */
1950 free_menubar_widget_value_tree (first_wv);
1952 /* Adjust coordinates to be root-window-relative. */
1953 pos.h = x;
1954 pos.v = y;
1956 SetPortWindowPort (FRAME_MAC_WINDOW (f));
1957 LocalToGlobal (&pos);
1959 /* No selection has been chosen yet. */
1960 menu_item_choice = 0;
1961 menu_item_selection = 0;
1963 record_unwind_protect (pop_down_menu, make_save_value (f, 0));
1965 /* Add event handler so we can detect C-g. */
1966 install_menu_quit_handler (menu);
1968 /* Display the menu. */
1969 menu_item_choice = PopUpMenuSelect (menu, pos.v, pos.h, 0);
1970 menu_item_selection = LoWord (menu_item_choice);
1972 /* Get the refcon to find the correct item */
1973 if (menu_item_selection)
1975 MenuHandle sel_menu = GetMenuHandle (HiWord (menu_item_choice));
1976 if (sel_menu) {
1977 GetMenuItemRefCon (sel_menu, menu_item_selection, &refcon);
1980 else if (! for_click)
1981 /* Make "Cancel" equivalent to C-g unless this menu was popped up by
1982 a mouse press. */
1983 Fsignal (Qquit, Qnil);
1985 /* Find the selected item, and its pane, to return
1986 the proper value. */
1987 if (menu_item_selection != 0)
1989 Lisp_Object prefix, entry;
1991 prefix = entry = Qnil;
1992 i = 0;
1993 while (i < menu_items_used)
1995 if (EQ (XVECTOR (menu_items)->contents[i], Qnil))
1997 subprefix_stack[submenu_depth++] = prefix;
1998 prefix = entry;
1999 i++;
2001 else if (EQ (XVECTOR (menu_items)->contents[i], Qlambda))
2003 prefix = subprefix_stack[--submenu_depth];
2004 i++;
2006 else 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 /* Ignore a nil in the item list.
2013 It's meaningful only for dialog boxes. */
2014 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2015 i += 1;
2016 else
2018 entry
2019 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2020 if ((int) (EMACS_INT) refcon == i)
2022 if (keymaps != 0)
2024 int j;
2026 entry = Fcons (entry, Qnil);
2027 if (!NILP (prefix))
2028 entry = Fcons (prefix, entry);
2029 for (j = submenu_depth - 1; j >= 0; j--)
2030 if (!NILP (subprefix_stack[j]))
2031 entry = Fcons (subprefix_stack[j], entry);
2033 return entry;
2035 i += MENU_ITEMS_ITEM_LENGTH;
2039 else if (!for_click)
2040 /* Make "Cancel" equivalent to C-g. */
2041 Fsignal (Qquit, Qnil);
2043 unbind_to (specpdl_count, Qnil);
2045 return Qnil;
2049 #ifdef HAVE_DIALOGS
2050 /* Construct native Mac OS menubar based on widget_value tree. */
2052 static int
2053 mac_dialog (widget_value *wv)
2055 char *dialog_name;
2056 char *prompt;
2057 char **button_labels;
2058 UInt32 *ref_cons;
2059 int nb_buttons;
2060 int left_count;
2061 int i;
2062 int dialog_width;
2063 Rect rect;
2064 WindowPtr window_ptr;
2065 ControlHandle ch;
2066 int left;
2067 EventRecord event_record;
2068 SInt16 part_code;
2069 int control_part_code;
2070 Point mouse;
2072 dialog_name = wv->name;
2073 nb_buttons = dialog_name[1] - '0';
2074 left_count = nb_buttons - (dialog_name[4] - '0');
2075 button_labels = (char **) alloca (sizeof (char *) * nb_buttons);
2076 ref_cons = (UInt32 *) alloca (sizeof (UInt32) * nb_buttons);
2078 wv = wv->contents;
2079 prompt = (char *) alloca (strlen (wv->value) + 1);
2080 strcpy (prompt, wv->value);
2081 c2pstr (prompt);
2083 wv = wv->next;
2084 for (i = 0; i < nb_buttons; i++)
2086 button_labels[i] = wv->value;
2087 button_labels[i] = (char *) alloca (strlen (wv->value) + 1);
2088 strcpy (button_labels[i], wv->value);
2089 c2pstr (button_labels[i]);
2090 ref_cons[i] = (UInt32) wv->call_data;
2091 wv = wv->next;
2094 window_ptr = GetNewCWindow (DIALOG_WINDOW_RESOURCE, NULL, (WindowPtr) -1);
2096 SetPortWindowPort (window_ptr);
2098 TextFont (0);
2099 /* Left and right margins in the dialog are 13 pixels each.*/
2100 dialog_width = 14;
2101 /* Calculate width of dialog box: 8 pixels on each side of the text
2102 label in each button, 12 pixels between buttons. */
2103 for (i = 0; i < nb_buttons; i++)
2104 dialog_width += StringWidth (button_labels[i]) + 16 + 12;
2106 if (left_count != 0 && nb_buttons - left_count != 0)
2107 dialog_width += 12;
2109 dialog_width = max (dialog_width, StringWidth (prompt) + 26);
2111 SizeWindow (window_ptr, dialog_width, 78, 0);
2112 ShowWindow (window_ptr);
2114 SetPortWindowPort (window_ptr);
2116 TextFont (0);
2118 MoveTo (13, 29);
2119 DrawString (prompt);
2121 left = 13;
2122 for (i = 0; i < nb_buttons; i++)
2124 int button_width = StringWidth (button_labels[i]) + 16;
2125 SetRect (&rect, left, 45, left + button_width, 65);
2126 ch = NewControl (window_ptr, &rect, button_labels[i], 1, 0, 0, 0,
2127 kControlPushButtonProc, ref_cons[i]);
2128 left += button_width + 12;
2129 if (i == left_count - 1)
2130 left += 12;
2133 i = 0;
2134 while (!i)
2136 if (WaitNextEvent (mDownMask, &event_record, 10, NULL))
2137 if (event_record.what == mouseDown)
2139 part_code = FindWindow (event_record.where, &window_ptr);
2140 if (part_code == inContent)
2142 mouse = event_record.where;
2143 GlobalToLocal (&mouse);
2144 control_part_code = FindControl (mouse, window_ptr, &ch);
2145 if (control_part_code == kControlButtonPart)
2146 if (TrackControl (ch, mouse, NULL))
2147 i = GetControlReference (ch);
2152 DisposeWindow (window_ptr);
2154 return i;
2157 static char * button_names [] = {
2158 "button1", "button2", "button3", "button4", "button5",
2159 "button6", "button7", "button8", "button9", "button10" };
2161 static Lisp_Object
2162 mac_dialog_show (f, keymaps, title, header, error_name)
2163 FRAME_PTR f;
2164 int keymaps;
2165 Lisp_Object title, header;
2166 char **error_name;
2168 int i, nb_buttons=0;
2169 char dialog_name[6];
2170 int menu_item_selection;
2172 widget_value *wv, *first_wv = 0, *prev_wv = 0;
2174 /* Number of elements seen so far, before boundary. */
2175 int left_count = 0;
2176 /* 1 means we've seen the boundary between left-hand elts and right-hand. */
2177 int boundary_seen = 0;
2179 *error_name = NULL;
2181 if (menu_items_n_panes > 1)
2183 *error_name = "Multiple panes in dialog box";
2184 return Qnil;
2187 /* Create a tree of widget_value objects
2188 representing the text label and buttons. */
2190 Lisp_Object pane_name, prefix;
2191 char *pane_string;
2192 pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME];
2193 prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX];
2194 pane_string = (NILP (pane_name)
2195 ? "" : (char *) SDATA (pane_name));
2196 prev_wv = xmalloc_widget_value ();
2197 prev_wv->value = pane_string;
2198 if (keymaps && !NILP (prefix))
2199 prev_wv->name++;
2200 prev_wv->enabled = 1;
2201 prev_wv->name = "message";
2202 prev_wv->help = Qnil;
2203 first_wv = prev_wv;
2205 /* Loop over all panes and items, filling in the tree. */
2206 i = MENU_ITEMS_PANE_LENGTH;
2207 while (i < menu_items_used)
2210 /* Create a new item within current pane. */
2211 Lisp_Object item_name, enable, descrip;
2212 item_name = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_NAME];
2213 enable = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_ENABLE];
2214 descrip
2215 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_EQUIV_KEY];
2217 if (NILP (item_name))
2219 free_menubar_widget_value_tree (first_wv);
2220 *error_name = "Submenu in dialog items";
2221 return Qnil;
2223 if (EQ (item_name, Qquote))
2225 /* This is the boundary between left-side elts
2226 and right-side elts. Stop incrementing right_count. */
2227 boundary_seen = 1;
2228 i++;
2229 continue;
2231 if (nb_buttons >= 9)
2233 free_menubar_widget_value_tree (first_wv);
2234 *error_name = "Too many dialog items";
2235 return Qnil;
2238 wv = xmalloc_widget_value ();
2239 prev_wv->next = wv;
2240 wv->name = (char *) button_names[nb_buttons];
2241 if (!NILP (descrip))
2242 wv->key = (char *) SDATA (descrip);
2243 wv->value = (char *) SDATA (item_name);
2244 wv->call_data = (void *) i;
2245 /* menu item is identified by its index in menu_items table */
2246 wv->enabled = !NILP (enable);
2247 wv->help = Qnil;
2248 prev_wv = wv;
2250 if (! boundary_seen)
2251 left_count++;
2253 nb_buttons++;
2254 i += MENU_ITEMS_ITEM_LENGTH;
2257 /* If the boundary was not specified,
2258 by default put half on the left and half on the right. */
2259 if (! boundary_seen)
2260 left_count = nb_buttons - nb_buttons / 2;
2262 wv = xmalloc_widget_value ();
2263 wv->name = dialog_name;
2264 wv->help = Qnil;
2266 /* Frame title: 'Q' = Question, 'I' = Information.
2267 Can also have 'E' = Error if, one day, we want
2268 a popup for errors. */
2269 if (NILP(header))
2270 dialog_name[0] = 'Q';
2271 else
2272 dialog_name[0] = 'I';
2274 /* Dialog boxes use a really stupid name encoding
2275 which specifies how many buttons to use
2276 and how many buttons are on the right. */
2277 dialog_name[1] = '0' + nb_buttons;
2278 dialog_name[2] = 'B';
2279 dialog_name[3] = 'R';
2280 /* Number of buttons to put on the right. */
2281 dialog_name[4] = '0' + nb_buttons - left_count;
2282 dialog_name[5] = 0;
2283 wv->contents = first_wv;
2284 first_wv = wv;
2287 /* Actually create the dialog. */
2288 #ifdef HAVE_DIALOGS
2289 menu_item_selection = mac_dialog (first_wv);
2290 #else
2291 menu_item_selection = 0;
2292 #endif
2294 /* Free the widget_value objects we used to specify the contents. */
2295 free_menubar_widget_value_tree (first_wv);
2297 /* Find the selected item, and its pane, to return
2298 the proper value. */
2299 if (menu_item_selection != 0)
2301 Lisp_Object prefix;
2303 prefix = Qnil;
2304 i = 0;
2305 while (i < menu_items_used)
2307 Lisp_Object entry;
2309 if (EQ (XVECTOR (menu_items)->contents[i], Qt))
2311 prefix
2312 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_PANE_PREFIX];
2313 i += MENU_ITEMS_PANE_LENGTH;
2315 else if (EQ (XVECTOR (menu_items)->contents[i], Qquote))
2317 /* This is the boundary between left-side elts and
2318 right-side elts. */
2319 ++i;
2321 else
2323 entry
2324 = XVECTOR (menu_items)->contents[i + MENU_ITEMS_ITEM_VALUE];
2325 if (menu_item_selection == i)
2327 if (keymaps != 0)
2329 entry = Fcons (entry, Qnil);
2330 if (!NILP (prefix))
2331 entry = Fcons (prefix, entry);
2333 return entry;
2335 i += MENU_ITEMS_ITEM_LENGTH;
2339 else
2340 /* Make "Cancel" equivalent to C-g. */
2341 Fsignal (Qquit, Qnil);
2343 return Qnil;
2345 #endif /* HAVE_DIALOGS */
2348 /* Is this item a separator? */
2349 static int
2350 name_is_separator (name)
2351 char *name;
2353 char *start = name;
2355 /* Check if name string consists of only dashes ('-'). */
2356 while (*name == '-') name++;
2357 /* Separators can also be of the form "--:TripleSuperMegaEtched"
2358 or "--deep-shadow". We don't implement them yet, se we just treat
2359 them like normal separators. */
2360 return (*name == '\0' || start + 2 == name);
2363 static void
2364 add_menu_item (menu, pos, wv)
2365 MenuHandle menu;
2366 int pos;
2367 widget_value *wv;
2369 #if TARGET_API_MAC_CARBON
2370 CFStringRef item_name;
2371 #else
2372 Str255 item_name;
2373 #endif
2375 if (name_is_separator (wv->name))
2376 AppendMenu (menu, "\p-");
2377 else
2379 AppendMenu (menu, "\pX");
2381 #if TARGET_API_MAC_CARBON
2382 item_name = cfstring_create_with_utf8_cstring (wv->name);
2384 if (wv->key != NULL)
2386 CFStringRef name, key;
2388 name = item_name;
2389 key = cfstring_create_with_utf8_cstring (wv->key);
2390 item_name = CFStringCreateWithFormat (NULL, NULL, CFSTR ("%@ %@"),
2391 name, key);
2392 CFRelease (name);
2393 CFRelease (key);
2396 SetMenuItemTextWithCFString (menu, pos, item_name);
2397 CFRelease (item_name);
2399 if (wv->enabled)
2400 EnableMenuItem (menu, pos);
2401 else
2402 DisableMenuItem (menu, pos);
2403 #else /* ! TARGET_API_MAC_CARBON */
2404 item_name[sizeof (item_name) - 1] = '\0';
2405 strncpy (item_name, wv->name, sizeof (item_name) - 1);
2406 if (wv->key != NULL)
2408 int len = strlen (item_name);
2410 strncpy (item_name + len, " ", sizeof (item_name) - 1 - len);
2411 len = strlen (item_name);
2412 strncpy (item_name + len, wv->key, sizeof (item_name) - 1 - len);
2414 c2pstr (item_name);
2415 SetMenuItemText (menu, pos, item_name);
2417 if (wv->enabled)
2418 EnableItem (menu, pos);
2419 else
2420 DisableItem (menu, pos);
2421 #endif /* ! TARGET_API_MAC_CARBON */
2423 /* Draw radio buttons and tickboxes. */
2424 if (wv->selected && (wv->button_type == BUTTON_TYPE_TOGGLE ||
2425 wv->button_type == BUTTON_TYPE_RADIO))
2426 SetItemMark (menu, pos, checkMark);
2427 else
2428 SetItemMark (menu, pos, noMark);
2430 SetMenuItemRefCon (menu, pos, (UInt32) wv->call_data);
2434 /* Construct native Mac OS menu based on widget_value tree. */
2436 static int
2437 fill_menu (menu, wv, submenu_id)
2438 MenuHandle menu;
2439 widget_value *wv;
2440 int submenu_id;
2442 int pos;
2444 for (pos = 1; wv != NULL; wv = wv->next, pos++)
2446 add_menu_item (menu, pos, wv);
2447 if (wv->contents)
2449 MenuHandle submenu = NewMenu (submenu_id, "\pX");
2451 InsertMenu (submenu, -1);
2452 SetMenuItemHierarchicalID (menu, pos, submenu_id);
2453 submenu_id = fill_menu (submenu, wv->contents, submenu_id + 1);
2457 return submenu_id;
2460 /* Construct native Mac OS menubar based on widget_value tree. */
2462 static void
2463 fill_menubar (wv, deep_p)
2464 widget_value *wv;
2465 int deep_p;
2467 int id, submenu_id;
2468 MenuHandle menu;
2469 Str255 title;
2470 #if !TARGET_API_MAC_CARBON
2471 int title_changed_p = 0;
2472 #endif
2474 /* Clean up the menu bar when filled by the entire menu trees. */
2475 if (deep_p)
2477 dispose_menus (MIN_MENU_ID);
2478 dispose_menus (MIN_SUBMENU_ID);
2479 #if !TARGET_API_MAC_CARBON
2480 title_changed_p = 1;
2481 #endif
2484 /* Fill menu bar titles and submenus. Reuse the existing menu bar
2485 titles as much as possible to minimize redraw (if !deep_p). */
2486 submenu_id = MIN_SUBMENU_ID;
2487 for (id = MIN_MENU_ID; wv != NULL; wv = wv->next, id++)
2489 strncpy (title, wv->name, 255);
2490 title[255] = '\0';
2491 c2pstr (title);
2493 menu = GetMenuHandle (id);
2494 if (menu)
2496 #if TARGET_API_MAC_CARBON
2497 Str255 old_title;
2499 GetMenuTitle (menu, old_title);
2500 if (!EqualString (title, old_title, false, false))
2501 SetMenuTitle (menu, title);
2502 #else /* !TARGET_API_MAC_CARBON */
2503 if (!EqualString (title, (*menu)->menuData, false, false))
2505 DeleteMenu (id);
2506 DisposeMenu (menu);
2507 menu = NewMenu (id, title);
2508 InsertMenu (menu, GetMenuHandle (id + 1) ? id + 1 : 0);
2509 title_changed_p = 1;
2511 #endif /* !TARGET_API_MAC_CARBON */
2513 else
2515 menu = NewMenu (id, title);
2516 InsertMenu (menu, 0);
2517 #if !TARGET_API_MAC_CARBON
2518 title_changed_p = 1;
2519 #endif
2522 if (wv->contents)
2523 submenu_id = fill_menu (menu, wv->contents, submenu_id);
2526 if (GetMenuHandle (id))
2528 dispose_menus (id);
2529 #if !TARGET_API_MAC_CARBON
2530 title_changed_p = 1;
2531 #endif
2534 #if !TARGET_API_MAC_CARBON
2535 if (title_changed_p)
2536 InvalMenuBar ();
2537 #endif
2540 static void
2541 dispose_menus (id)
2542 int id;
2544 MenuHandle menu;
2546 while ((menu = GetMenuHandle (id)) != NULL)
2548 DeleteMenu (id);
2549 DisposeMenu (menu);
2550 id++;
2554 #endif /* HAVE_MENUS */
2556 void
2557 syms_of_macmenu ()
2559 staticpro (&menu_items);
2560 menu_items = Qnil;
2562 Qdebug_on_next_call = intern ("debug-on-next-call");
2563 staticpro (&Qdebug_on_next_call);
2565 DEFVAR_LISP ("menu-updating-frame", &Vmenu_updating_frame,
2566 doc: /* Frame for which we are updating a menu.
2567 The enable predicate for a menu command should check this variable. */);
2568 Vmenu_updating_frame = Qnil;
2570 defsubr (&Sx_popup_menu);
2571 #ifdef HAVE_MENUS
2572 defsubr (&Sx_popup_dialog);
2573 #endif
2576 /* arch-tag: 40b2c6c7-b8a9-4a49-b930-1b2707184cce
2577 (do not change this comment) */